From 8f08573815b4af5edd7b01df828e7980e9c62617 Mon Sep 17 00:00:00 2001 From: Bad Sector Date: Mon, 7 Feb 2022 01:51:48 +0200 Subject: [PATCH] Fix Gtk 1.2 LCL backend. There are still some minor glitches, but the IDE and most examples i tried seem to work fine. Some examples didn't work but that seemed to be mainly a Gtk 1.2 limitation (e.g. no rotating fonts). --- .../include/gtk/delphicompat.inc | 20 +++++++++-------- ide/mainbar.pas | 4 ++-- lcl/interfaces/gtk/gtkdef.pp | 2 +- lcl/interfaces/gtk/gtkextra.pp | 3 +++ lcl/interfaces/gtk/gtkfontcache.pas | 3 +++ lcl/interfaces/gtk/gtkint.pp | 3 ++- lcl/interfaces/gtk/gtkpagecontrol.inc | 5 +++++ lcl/interfaces/gtk/gtkproc.inc | 22 +++++++++---------- lcl/interfaces/gtk/gtkproc.pp | 2 +- lcl/interfaces/gtk/gtkwinapi.inc | 16 ++++++++++++-- lcl/interfaces/gtk/gtkwsbuttons.pp | 7 +++--- lcl/interfaces/gtk/gtkwscomctrls.pp | 2 +- lcl/interfaces/gtk/gtkwsforms.pp | 19 +++++++++++----- lcl/interfaces/gtk/gtkwsstdctrls.pp | 2 +- 14 files changed, 71 insertions(+), 39 deletions(-) diff --git a/components/lclextensions/include/gtk/delphicompat.inc b/components/lclextensions/include/gtk/delphicompat.inc index 44af53caff..dcfe29f7bb 100644 --- a/components/lclextensions/include/gtk/delphicompat.inc +++ b/components/lclextensions/include/gtk/delphicompat.inc @@ -204,7 +204,7 @@ type TTimerRecord = record Control: TControl; Notify: TTimerNotify; - Id: LongWord; + Id: UINT_PTR; TimerHandle: guint; end; PTimerRecord = ^TTimerRecord; @@ -217,9 +217,9 @@ type public constructor Create; destructor Destroy; override; - function Add(hWnd: THandle; ID: LongWord; NotifyFunc: TTimerNotify; WinControl: TControl):PTimerRecord; - function GetTimerInfo(Handle: hWnd; idEvent:LongWord; out TimerInfo: TTimerRecord):Boolean; - function GetTimerInfoPtr(Handle: hWnd; idEvent:LongWord): PTimerRecord; + function Add(hWnd: THandle; ID: UINT_PTR; NotifyFunc: TTimerNotify; WinControl: TControl):PTimerRecord; + function GetTimerInfo(Handle: hWnd; idEvent:UINT_PTR; out TimerInfo: TTimerRecord):Boolean; + function GetTimerInfoPtr(Handle: hWnd; idEvent:UINT_PTR): PTimerRecord; end; var @@ -244,7 +244,7 @@ begin inherited Destroy; end; -function TTimerList.Add(hWnd: THandle; ID: LongWord; NotifyFunc: TTimerNotify; WinControl: TControl):PTimerRecord; +function TTimerList.Add(hWnd: THandle; ID: UINT_PTR; NotifyFunc: TTimerNotify; WinControl: TControl):PTimerRecord; var AID: QWord; ATimerRec: TTimerRecord; @@ -263,13 +263,13 @@ begin end; end; -function TTimerList.GetTimerInfo(Handle: hWnd; idEvent: LongWord; out +function TTimerList.GetTimerInfo(Handle: hWnd; idEvent: UINT_PTR; out TimerInfo: TTimerRecord): Boolean; begin Result:= FList.GetData(MakeQWord(Handle,idEvent),TimerInfo); end; -function TTimerList.GetTimerInfoPtr(Handle: hWnd; idEvent: LongWord +function TTimerList.GetTimerInfoPtr(Handle: hWnd; idEvent: UINT_PTR ): PTimerRecord; begin Result := FList.GetDataPtr(MakeQWord(Handle,idEvent)); @@ -300,7 +300,7 @@ begin end; end; -function SetTimer(hWnd:THandle; nIDEvent:LongWord; uElapse:LongWord; lpTimerFunc:TTimerNotify):LongWord; +function SetTimer(hWnd:THandle; nIDEvent:UINT_PTR; uElapse:LongWord; lpTimerFunc:TTimerNotify):UINT_PTR; var TimerInfo: PTimerRecord; Control: TControl; @@ -313,13 +313,15 @@ begin Control := nil; TimerInfo := FTimerList.Add(hWnd, nIDEvent, lpTimerFunc, Control); TimerInfo^.TimerHandle := gtk_timeout_add(uElapse, @gtkTimerCB, TimerInfo); + Result:=nIDEvent; //DebugLn('SetTimer HWnd: %d ID: %d TimerHandle: %d',[hWnd,nIDEvent,TimerInfo^.TimerHandle]); end; -function KillTimer(hWnd:THandle; nIDEvent: LongWord):Boolean; +function KillTimer(hWnd:THandle; nIDEvent: UINT_PTR):Boolean; var TimerInfo: PTimerRecord; begin + Result:=True; TimerInfo := FTimerList.GetTimerInfoPtr(hWnd,nIDEvent); if TimerInfo <> nil then begin diff --git a/ide/mainbar.pas b/ide/mainbar.pas index e95781e664..95277d9c83 100644 --- a/ide/mainbar.pas +++ b/ide/mainbar.pas @@ -513,7 +513,7 @@ begin end; function TMainIDEBar.CalcNonClientHeight: Integer; -{$IF DEFINED(LCLWin32) OR DEFINED(LCLGtk2) OR DEFINED(LCLQt) OR DEFINED(LCLQt5)} +{$IF DEFINED(LCLWin32) OR DEFINED(LCLGtk) OR DEFINED(LCLGtk2) OR DEFINED(LCLQt) OR DEFINED(LCLQt5)} var WindowRect, WindowClientRect: TRect; {$ENDIF} @@ -534,7 +534,7 @@ begin if not Showing then Exit(0); - {$IF DEFINED(LCLWin32) OR DEFINED(LCLGtk2) OR DEFINED(LCLQt) OR DEFINED(LCLQt5)} + {$IF DEFINED(LCLWin32) OR DEFINED(LCLGtk) OR DEFINED(LCLGtk2) OR DEFINED(LCLQt) OR DEFINED(LCLQt5)} //Gtk2 + Win32 + Qt //retrieve real main menu height because // - Win32: multi-line is possible (SM_CYMENU reflects only single line) diff --git a/lcl/interfaces/gtk/gtkdef.pp b/lcl/interfaces/gtk/gtkdef.pp index a148635b9f..0c6c082483 100644 --- a/lcl/interfaces/gtk/gtkdef.pp +++ b/lcl/interfaces/gtk/gtkdef.pp @@ -613,7 +613,7 @@ implementation uses // until all code is transfered to objects, these circles are needed; - gtkint, gtkproc, GtkFontCache, GTKWinApiWindow; + gtkint, gtkproc, GtkFontCache, GTKWinApiWindow, LazUtilities; {$IFOpt R+}{$Define RangeChecksOn}{$Endif} diff --git a/lcl/interfaces/gtk/gtkextra.pp b/lcl/interfaces/gtk/gtkextra.pp index 9f2ebf8cde..ad112f1f0d 100644 --- a/lcl/interfaces/gtk/gtkextra.pp +++ b/lcl/interfaces/gtk/gtkextra.pp @@ -40,6 +40,9 @@ interface implementation +uses + LazUtilities; + {$ifdef gtk1} {$I gtk1extra.inc} {$endif} diff --git a/lcl/interfaces/gtk/gtkfontcache.pas b/lcl/interfaces/gtk/gtkfontcache.pas index fbdb4889da..15a74984fb 100644 --- a/lcl/interfaces/gtk/gtkfontcache.pas +++ b/lcl/interfaces/gtk/gtkfontcache.pas @@ -92,6 +92,9 @@ var implementation +uses + LazUtilities; + type TLogFontAndName = record LogFont: TLogFont; diff --git a/lcl/interfaces/gtk/gtkint.pp b/lcl/interfaces/gtk/gtkint.pp index 25823d42cf..cbb64c7439 100644 --- a/lcl/interfaces/gtk/gtkint.pp +++ b/lcl/interfaces/gtk/gtkint.pp @@ -355,7 +355,8 @@ uses GtkThemes, Buttons, StdCtrls, PairSplitter, GTKWinApiWindow, ComCtrls, Calendar, Spin, - ExtCtrls, FileCtrl, LResources, gtkglobals; + ExtCtrls, FileCtrl, LResources, gtkglobals, + LazUtilities; {$I gtklistsl.inc} {$I gtkfiledialogutils.inc} diff --git a/lcl/interfaces/gtk/gtkpagecontrol.inc b/lcl/interfaces/gtk/gtkpagecontrol.inc index 2d95f03c85..3a5962f84a 100644 --- a/lcl/interfaces/gtk/gtkpagecontrol.inc +++ b/lcl/interfaces/gtk/gtkpagecontrol.inc @@ -271,6 +271,11 @@ begin // remove the dummy page (a gtk_notebook needs at least one page) RemoveDummyNotebookPage(PGtkNotebook(TabControlWidget)); + // unrealize the page widget if it is already realized as Gtk 1.2 will try to + // deref PageWidget->window for realized widgets when the latter are added to + // a container without checking if the pointer is not null + if GTK_WIDGET_REALIZED(PageWidget) then + gtk_widget_unrealize(PageWidget); // insert the page gtk_notebook_insert_page_menu(PGtkNotebook(TabControlWidget), PageWidget, TabWidget, MenuWidget, AIndex); diff --git a/lcl/interfaces/gtk/gtkproc.inc b/lcl/interfaces/gtk/gtkproc.inc index a747ac2f19..1bdce1c981 100644 --- a/lcl/interfaces/gtk/gtkproc.inc +++ b/lcl/interfaces/gtk/gtkproc.inc @@ -1601,7 +1601,7 @@ var begin if DC=0 then ; if not (cfColorAllocated in GDIColor^.ColorFlags) then begin - RGBColor := ColorToRGB(GDIColor^.ColorRef); + RGBColor := ColorToRGB(TColor(GDIColor^.ColorRef)); With GDIColor^.Color do begin Red := gushort(GetRValue(RGBColor)) shl 8; @@ -4528,15 +4528,11 @@ begin // get the tab container and the tab components: pixmap, label and closebtn TabWidget:=gtk_notebook_get_tab_label(PGtkNoteBook(NotebookWidget), PageWidget); - if TabWidget<>nil then begin - TabImageWidget:=gtk_object_get_data(PGtkObject(TabWidget), 'TabImage'); - TabLabelWidget:=gtk_object_get_data(PGtkObject(TabWidget), 'TabLabel'); - TabCloseBtnWidget:=gtk_object_get_data(PGtkObject(TabWidget),'TabCloseBtn'); - end else begin - TabImageWidget:=nil; - TabLabelWidget:=nil; - TabCloseBtnWidget:=nil; - end; + if TabWidget=nil then exit; + + TabImageWidget:=gtk_object_get_data(PGtkObject(TabWidget), 'TabImage'); + TabLabelWidget:=gtk_object_get_data(PGtkObject(TabWidget), 'TabLabel'); + TabCloseBtnWidget:=gtk_object_get_data(PGtkObject(TabWidget),'TabCloseBtn'); // get the menu container and its components: pixmap and label MenuWidget:=gtk_notebook_get_menu_label(PGtkNoteBook(NotebookWidget), @@ -4589,7 +4585,7 @@ begin Result.Y:=0; end; // check if the gdkwindow is the clientwindow of the parent - if gtk_widget_get_parent_window(TheWidget)=TheWindow then begin + if (TheWidget^.Parent<>nil) and (gtk_widget_get_parent_window(TheWidget)=TheWindow) then begin // the widget is using its parent window // -> adjust the coordinates inc(Result.X,TheWidget^.Allocation.X); @@ -8567,7 +8563,7 @@ begin GC := nil; Pixmap := nil; - SysColor := ColorToRGB(Color); + SysColor := ColorToRGB(TColor(Color)); Result.Fill := GDK_Solid; RedGreenBlue(TColor(SysColor), Red, Green, Blue); Result.foreground.Red:=gushort(Red) shl 8 + Red; @@ -9869,6 +9865,8 @@ begin ay:=current_desktop[1]; awidth:=current_desktop[2]; aheight:=current_desktop[3]; + // if an invalid size was given, assume garbage from the window manager + if (awidth < 1) or (aheight < 1) then result := -1; end; if current_desktop <> nil then XFree (current_desktop); diff --git a/lcl/interfaces/gtk/gtkproc.pp b/lcl/interfaces/gtk/gtkproc.pp index b18366ac28..cd2166cc6a 100644 --- a/lcl/interfaces/gtk/gtkproc.pp +++ b/lcl/interfaces/gtk/gtkproc.pp @@ -791,7 +791,7 @@ implementation uses {$IFDEF StaticXinerama} Xinerama, {$ENDIF} - dynlibs, GtkWSPrivate, URIParser, GtkInt; + dynlibs, GtkWSPrivate, URIParser, GtkInt, LazUtilities; const KCINFO_FLAG_SHIFT = $01; diff --git a/lcl/interfaces/gtk/gtkwinapi.inc b/lcl/interfaces/gtk/gtkwinapi.inc index 53907e9108..da37d91be4 100644 --- a/lcl/interfaces/gtk/gtkwinapi.inc +++ b/lcl/interfaces/gtk/gtkwinapi.inc @@ -1864,7 +1864,7 @@ begin {$IFDEF VerboseFonts} DebugLn('[TGtkWidgetSet.CreateFontIndirect] ',DbgS(GdiObject),' ',dbgs(FGDIObjects.Count)); {$ENDIF} - DisposeGDIObject(GdiObject); + ReleaseGDIObject(GdiObject); Result := 0; end else begin @@ -6820,7 +6820,10 @@ begin Rect^.Top := 0;//PaintWidget^.Allocation.Y; Rect^.Right := PaintWidget^.Allocation.Width; Rect^.Bottom := PaintWidget^.Allocation.Height; - end; + end + // ignore the request if the rectangle is invalid + else if (Rect^.Left >= Rect^.Right) or (Rect^.Top >= Rect^.Bottom) then + Exit(True); gdkRect.X := Rect^.Left; gdkRect.Y := Rect^.Top; gdkRect.Width := (Rect^.Right - Rect^.Left); @@ -8066,6 +8069,15 @@ end; ------------------------------------------------------------------------------} function TGtkWidgetSet.ScrollWindowEx(hWnd: HWND; dx, dy: Integer; prcScroll, prcClip: PRect; hrgnUpdate: HRGN; prcUpdate: PRect; flags: UINT): Boolean; begin + // HACK: the full functionality necessary by ScrollWindowEx isn't supported + // but as this is mainly used to update controls, we'll invalidate the full + // window to ensure that the control is up to date (this fixes controls that + // rely on ScrollWindowEx for scrolling part of the content with the irony + // that the idea of using it was to make painting faster but this fix makes + // it slower than if they just repainted themselves) + InvalidateRect(hWnd, nil, False); + // We'll still report this as a failure since, technically speaking, the + // request didn't work Result := False; end; diff --git a/lcl/interfaces/gtk/gtkwsbuttons.pp b/lcl/interfaces/gtk/gtkwsbuttons.pp index 80e5efa257..9d028334bd 100644 --- a/lcl/interfaces/gtk/gtkwsbuttons.pp +++ b/lcl/interfaces/gtk/gtkwsbuttons.pp @@ -287,9 +287,8 @@ var Pixbuf: PGdkPixbuf; Mask: PGdkBitmap; AGlyph: TBitmap; - AIndex, aPPI: Integer; + AIndex: Integer; AEffect: TGraphicsDrawEffect; - aCanvasScaleFactor: Double; ImgResolution: TScaledImageListResolution; begin WidgetInfo := GetWidgetInfo(Pointer(ABitBtn.Handle)); @@ -298,8 +297,8 @@ begin if ABitBtn.CanShowGlyph then begin AGlyph := TBitmap.Create; - AValue.GetImageIndexAndEffect(AButtonState, aPPI, aCanvasScaleFactor, - ImgResolution, AIndex, AEffect); + AValue.GetImageIndexAndEffect(AButtonState, ABitBtn.Font.PixelsPerInch, + ABitBtn.GetCanvasScaleFactor, ImgResolution, AIndex, AEffect); if (AIndex <> -1) and (AValue.Images <> nil) then AValue.Images.GetBitmap(AIndex, AGlyph, AEffect); end diff --git a/lcl/interfaces/gtk/gtkwscomctrls.pp b/lcl/interfaces/gtk/gtkwscomctrls.pp index a24b2abf48..8f13e548b8 100644 --- a/lcl/interfaces/gtk/gtkwscomctrls.pp +++ b/lcl/interfaces/gtk/gtkwscomctrls.pp @@ -249,7 +249,7 @@ type implementation uses - SysUtils, + SysUtils, LazUtilities, GtkProc, GtkInt, GtkGlobals, GtkWSControls; diff --git a/lcl/interfaces/gtk/gtkwsforms.pp b/lcl/interfaces/gtk/gtkwsforms.pp index 17d0de0af5..41e4b137ea 100644 --- a/lcl/interfaces/gtk/gtkwsforms.pp +++ b/lcl/interfaces/gtk/gtkwsforms.pp @@ -281,18 +281,27 @@ begin end; function GtkWSFormUnMapEvent(Widget: PGtkWidget; Event: PGdkEvent; WidgetInfo: PWidgetInfo): gboolean; cdecl; +const + LastSleepTime: QWord = 0; var Message: TLMSize; AForm: TCustomForm; begin + // HACK: sleep for a bit to avoid the race condition where the unmap event is + // sent before the window manager updates the state attribute. We also only + // do that if some time has passed since the last Sleep, otherwise every + // window will cause Sleep to be called by itself. + if GetTickCount64 - LastSleepTime > 100 then begin + Sleep(100); // even 10ms seems to work on my PC so 100ms should be safe + LastSleepTime:=GetTickCount64; + end; + // ignore the unmap signal if the window is not being minimized (e.g. desktop + // switches or windows become shaded) + if not GDK_WINDOW_GET_MINIMIZED(PGdkWindowPrivate(Widget^.Window)) then Exit; + Result := True; FillChar(Message, 0, SizeOf(Message)); AForm := TCustomForm(WidgetInfo^.LCLObject); - - // ignore the unmap signals when we switch desktops - // as this results in irritating behavior when we return to the desktop - if GDK_GET_CURRENT_DESKTOP <> GDK_WINDOW_GET_DESKTOP(PGdkWindowPrivate(Widget^.Window)) then Exit; - Message.Msg := LM_SIZE; Message.SizeType := SIZEICONIC or Size_SourceIsInterface; Message.Width := AForm.Width; diff --git a/lcl/interfaces/gtk/gtkwsstdctrls.pp b/lcl/interfaces/gtk/gtkwsstdctrls.pp index 839463fcd6..1fe77cf783 100644 --- a/lcl/interfaces/gtk/gtkwsstdctrls.pp +++ b/lcl/interfaces/gtk/gtkwsstdctrls.pp @@ -306,7 +306,7 @@ procedure WidgetSetSelLength(const Widget: PGtkWidget; NewLength: integer); implementation uses - GtkWSControls; + GtkWSControls, LazUtilities; const StaticBorderShadowMap: array[TStaticBorderStyle] of TGtkShadowType =