Recent

Author Topic: Error message after "Halt"  (Read 3276 times)

tintinux

  • Sr. Member
  • ****
  • Posts: 311
    • Gestinux
Error message after "Halt"
« on: August 27, 2013, 10:37:05 am »
Hi

In Lazarus 1.0.12 (and previous releases), with Windows GTK widgetset, after any TBitBtn is clicked, and then the  program is ended by 'Halt', we get an error message.

ThemesServices.ThemesAvailable is called in win32wsbuttons.pp when calling BitBtnWndProc, but at this time ThemesServices is nil.

To avoid this, I suggest the following small change :

Code: [Select]
Function BitBtnWndProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam;
    LParam: Windows.LParam): LResult; stdcall;
var
  Info: PWin32WindowInfo;
  Control: TWinControl;
  ButtonImageList: BUTTON_IMAGELIST;
  ImageList: HIMAGELIST;
  LMessage: TLMessage;
  TS : TThemeServices ;
begin
  Info := GetWin32WindowInfo(Window);
  if (Info = nil) or (Info^.WinControl = nil) then
  begin
    Result := CallDefaultWindowProc(Window, Msg, WParam, LParam);
    Exit;
  end
  else
    Control := Info^.WinControl;

  case Msg of
    WM_DESTROY:
      begin
        TS := ThemeServices ;
        if Assigned(TS) then
        begin
          if TS.ThemesAvailable and
             (Windows.SendMessage(Window, BCM_GETIMAGELIST, 0, Windows.LPARAM(@ButtonImageList)) <> 0) then
          begin
            // delete and destroy button imagelist
            if ButtonImageList.himl <> 0 then
            begin
              ImageList:=ButtonImageList.himl;
              ButtonImageList.himl:=0;
              Windows.SendMessage(Window, BCM_SETIMAGELIST, 0, Windows.LPARAM(@ButtonImageList));
              ImageList_Destroy(ImageList);
            end;
          end;
          Result := WindowProc(Window, Msg, WParam, LParam);
        end ;
      end;
    WM_GETFONT:
      begin
        Result := LResult(Control.Font.Reference.Handle);
      end;
    WM_UPDATEUISTATE:
      begin
        Result := WindowProc(Window, Msg, WParam, LParam);
        DrawBitBtnImage(TBitBtn(Control), TBitBtn(Control).Caption);
      end;
    WM_PAINT,
    WM_ERASEBKGND:
      begin
        if not Control.DoubleBuffered then
        begin
          LMessage.msg := Msg;
          LMessage.wParam := WParam;
          LMessage.lParam := LParam;
          LMessage.Result := 0;
          Result := DeliverMessage(Control, LMessage);
        end
        else
          Result := WindowProc(Window, Msg, WParam, LParam);
      end;
    WM_PRINTCLIENT:
      Result := CallDefaultWindowProc(Window, Msg, WParam, LParam);
    else
      Result := WindowProc(Window, Msg, WParam, LParam);
  end;
end;

From where I am, I have no access to svn (port is blocked  :o).
If someone wants to update for me, he is welcome !

Regards,

« Last Edit: August 27, 2013, 10:46:12 am by tintinux »
Initiator of gestinux, open-source, multi-database and multilingual accounting and billing software made with LAZARUS.

You can help to develop, to make and improve translations, and to provide examples of legal charts and reports from more countries.

BigChimp

  • Hero Member
  • *****
  • Posts: 5740
  • Add to the wiki - it's free ;)
    • FPCUp, PaperTiger scanning and other open source projects
Re: Error message after "Halt"
« Reply #1 on: August 27, 2013, 10:59:33 am »
FYI, there's a git mirror as well:
http://wiki.lazarus.freepascal.org/Creating_A_Patch#Creating_a_patch_using_Git
and
http://wiki.lazarus.freepascal.org/git_mirrors#Replicated_Lazarus_mirror

Finally, FPC/Lazarus SVN uses port 80 (the http protocol)- do they do deep packet inspection then so they can block svn http traffic through port 80 while permitting other http traffic?
Want quicker answers to your questions? Read http://wiki.lazarus.freepascal.org/Lazarus_Faq#What_is_the_correct_way_to_ask_questions_in_the_forum.3F

Open source including papertiger OCR/PDF scanning:
https://bitbucket.org/reiniero

Lazarus trunk+FPC trunk x86, Windows x64 unless otherwise specified

tintinux

  • Sr. Member
  • ****
  • Posts: 311
    • Gestinux
Re: Error message after "Halt"
« Reply #2 on: August 27, 2013, 01:22:47 pm »
Hi

May be the svn urls are blocked, not the port. And the git protocol is blocked too.
If none can do it before, I will perform the update when I will be back home with time available for this.

Regards
Initiator of gestinux, open-source, multi-database and multilingual accounting and billing software made with LAZARUS.

You can help to develop, to make and improve translations, and to provide examples of legal charts and reports from more countries.