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).
This commit is contained in:
Bad Sector 2022-02-07 01:51:48 +02:00 committed by Maxim Ganetsky
parent deea0b1e74
commit 8f08573815
14 changed files with 71 additions and 39 deletions

View File

@ -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

View File

@ -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)

View File

@ -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}

View File

@ -40,6 +40,9 @@ interface
implementation
uses
LazUtilities;
{$ifdef gtk1}
{$I gtk1extra.inc}
{$endif}

View File

@ -92,6 +92,9 @@ var
implementation
uses
LazUtilities;
type
TLogFontAndName = record
LogFont: TLogFont;

View File

@ -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}

View File

@ -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);

View File

@ -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);

View File

@ -791,7 +791,7 @@ implementation
uses
{$IFDEF StaticXinerama} Xinerama, {$ENDIF}
dynlibs, GtkWSPrivate, URIParser, GtkInt;
dynlibs, GtkWSPrivate, URIParser, GtkInt, LazUtilities;
const
KCINFO_FLAG_SHIFT = $01;

View File

@ -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;

View File

@ -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

View File

@ -249,7 +249,7 @@ type
implementation
uses
SysUtils,
SysUtils, LazUtilities,
GtkProc, GtkInt, GtkGlobals,
GtkWSControls;

View File

@ -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;

View File

@ -306,7 +306,7 @@ procedure WidgetSetSelLength(const Widget: PGtkWidget; NewLength: integer);
implementation
uses
GtkWSControls;
GtkWSControls, LazUtilities;
const
StaticBorderShadowMap: array[TStaticBorderStyle] of TGtkShadowType =