paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-07 01:57:57 +02:00
Code Issues Packages Projects Releases Wiki Activity

Gtk2: Implemented AllocateHwnd and DeallocateHwnd. Patch by Alexander (Rouse_) Bagel. issue #40721

Browse Source
This commit is contained in:
Željan Rikalo 2024-01-24 18:00:33 +01:00
parent d967c8782c
commit 92e31d445e
3 changed files with 39 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
lcl/interfacebase.pp
View File

@ -181,6 +181,16 @@ type
end;
TWidgetSetClass = class of TWidgetSet;
{ TMessageDispatcher }
TMessageDispatcher = class
private
FMethod: TLCLWndMethod;
public
constructor Create(AMethod: TLCLWndMethod);
procedure Dispatch(var message); override;
end;
function GetDefaultLCLWidgetType: TLCLPlatform;
function GetLCLWidgetTypeName: string;

3
lcl/interfaces/gtk2/gtk2int.pas
View File

@ -165,6 +165,9 @@ type
procedure DestroyEmptySubmenu(Sender: TObject);
procedure DestroyConnectedWidget(Widget: PGtkWidget;
CheckIfDestroying: boolean);
function AllocateHWnd(Method: TLCLWndMethod): HWND; override;
procedure DeallocateHWnd(Wnd: HWND); override;
// clipboard
procedure SetClipboardWidget(TargetWidget: PGtkWidget);

26
lcl/interfaces/gtk2/gtk2widgetset.inc
View File

@ -4980,6 +4980,32 @@ begin
end;
end;
function TGtk2WidgetSet.AllocateHWnd(Method: TLCLWndMethod): HWND;
var
Widget: PGtkWidget;
WidgetInfo: PWidgetInfo;
begin
Widget := GTKAPIWidget_New;
Result := THandle({%H-}PtrUInt(Widget));
if Result = 0 then Exit;
WidgetInfo := GetOrCreateWidgetInfo(Widget);
WidgetInfo^.CoreWidget := PGTKAPIWidget(Widget)^.Client;
WidgetInfo^.LCLObject := TMessageDispatcher.Create(Method);
end;
procedure TGtk2WidgetSet.DeallocateHWnd(Wnd: HWND);
var
Widget: PGtkWidget;
WidgetInfo: PWidgetInfo;
begin
Widget := {%H-}PGtkWidget(Wnd);
if WidgetIsDestroyingHandle(Widget) then Exit;
WidgetInfo := GetWidgetInfo(Widget);
if Assigned(WidgetInfo) then
FreeAndNil(WidgetInfo^.LCLObject);
DestroyConnectedWidget(Widget, True);
end;
function TGtk2WidgetSet.GetCompStyle(Sender : TObject) : Longint;
begin
Result := csNone;