1 unit gtk2windows;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 {$ifdef Windows}
8 uses
9 Windows;
10
GetWin32AppHandlenull11 function GetWin32AppHandle: THandle; // Beware LCLType.THandle <> Windows.THandle
12 {$endif}
13 implementation
14
15 {$ifdef Windows}
16 const
17 ClsName: array[0..6] of char = 'Window'#0;
18 PrivateAppHandle: THandle = 0;
19
GetWin32AppHandlenull20 function GetWin32AppHandle: THandle;
21 var
22 WindowClass: WndClass;
23 begin
24 if PrivateAppHandle=0 then begin
25 // register class
26 with WindowClass do
27 begin
28 Style := CS_DBLCLKS{CS_HRedraw or CS_VRedraw};
29 LPFnWndProc := @Windows.DefWindowProc;
30 CbClsExtra := 0;
31 CbWndExtra := 0;
32 hInstance := System.HInstance;
33 hIcon := Windows.LoadIcon(0, IDI_APPLICATION);
34 hCursor := Windows.LoadCursor(0, IDC_ARROW);
35 hbrBackground := 0; {GetSysColorBrush(Color_BtnFace);}
36 LPSzMenuName := Nil;
37 LPSzClassName := @ClsName;
38 end;
39 if Windows.RegisterClass(@WindowClass) <> 0 then begin
40 PrivateAppHandle := CreateWindow(@ClsName, nil,
41 WS_POPUP or WS_CLIPSIBLINGS or WS_SYSMENU or WS_MINIMIZEBOX,
42 0, 0, 0, 0, HWND(nil), HMENU(nil), HInstance, nil);
43 end;
44 end;
45 result := PrivateAppHandle;
46 end;
47
48
49 finalization
50 if PrivateAppHandle <> 0 then begin
51 DestroyWindow(PrivateAppHandle);
52 Windows.UnregisterClass(@ClsName, System.HInstance);
53 end;
54
55 {$endif}
56 end.
57
58