File: gtk2windows.pas

package info (click to toggle)
lazarus 4.0%2Bdfsg-3
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 275,760 kB
  • sloc: pascal: 2,341,904; xml: 509,420; makefile: 348,726; cpp: 93,608; sh: 3,387; java: 609; perl: 297; sql: 222; ansic: 137
file content (57 lines) | stat: -rw-r--r-- 1,339 bytes parent folder | download | duplicates (6)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
unit gtk2windows;

{$mode objfpc}{$H+}

interface

{$ifdef Windows}
uses
  Windows;
  
  function GetWin32AppHandle: THandle; // Beware LCLType.THandle <> Windows.THandle
{$endif}
implementation

{$ifdef Windows}
const
  ClsName: array[0..6] of char = 'Window'#0;
  PrivateAppHandle: THandle = 0;

function GetWin32AppHandle: THandle;
var
  WindowClass: WndClass;
begin
  if PrivateAppHandle=0 then begin
    // register class
    with WindowClass do
    begin
      Style := CS_DBLCLKS{CS_HRedraw or CS_VRedraw};
      LPFnWndProc := @Windows.DefWindowProc;
      CbClsExtra := 0;
      CbWndExtra := 0;
      hInstance := System.HInstance;
      hIcon := Windows.LoadIcon(0, IDI_APPLICATION);
      hCursor := Windows.LoadCursor(0, IDC_ARROW);
      hbrBackground := 0; {GetSysColorBrush(Color_BtnFace);}
      LPSzMenuName := Nil;
      LPSzClassName := @ClsName;
    end;
    if Windows.RegisterClass(@WindowClass) <> 0 then begin
      PrivateAppHandle := CreateWindow(@ClsName, nil,
        WS_POPUP or WS_CLIPSIBLINGS or WS_SYSMENU or WS_MINIMIZEBOX,
        0, 0, 0, 0, HWND(nil), HMENU(nil), HInstance, nil);
    end;
  end;
  result := PrivateAppHandle;
end;


finalization
  if PrivateAppHandle <> 0 then begin
    DestroyWindow(PrivateAppHandle);
    Windows.UnregisterClass(@ClsName, System.HInstance);
  end;

{$endif}
end.