diff options
author | tobigun <tobigun@b956fd51-792f-4845-bead-9b4dfca2ff2c> | 2008-08-06 19:02:56 +0000 |
---|---|---|
committer | tobigun <tobigun@b956fd51-792f-4845-bead-9b4dfca2ff2c> | 2008-08-06 19:02:56 +0000 |
commit | 57247ddc701c856e3bd0811566405ab4ac69e9ff (patch) | |
tree | fb90625caf573a20f65354ade1023ecb396c8456 /Game/Code/lib/other | |
parent | c9f0475aa950753f91fddf36f94d488e554d3757 (diff) | |
download | usdx-57247ddc701c856e3bd0811566405ab4ac69e9ff.tar.gz usdx-57247ddc701c856e3bd0811566405ab4ac69e9ff.tar.xz usdx-57247ddc701c856e3bd0811566405ab4ac69e9ff.zip |
moved AllocateHWnd/DeallocateHWnd from UCommon.pas to WinAllocation.pas. Do NOT use them in USDX code. They are just by the DirWatch and Midi... libs in FPC (Windows).
git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1224 b956fd51-792f-4845-bead-9b4dfca2ff2c
Diffstat (limited to '')
-rw-r--r-- | Game/Code/lib/other/DirWatch.pas | 8 | ||||
-rw-r--r-- | Game/Code/lib/other/WinAllocation.pas | 97 |
2 files changed, 102 insertions, 3 deletions
diff --git a/Game/Code/lib/other/DirWatch.pas b/Game/Code/lib/other/DirWatch.pas index d302cade..9d395840 100644 --- a/Game/Code/lib/other/DirWatch.pas +++ b/Game/Code/lib/other/DirWatch.pas @@ -31,9 +31,11 @@ interface uses Windows, Messages, - SysUtils, - UCommon, - Classes; + Classes, + {$IFDEF FPC} + WinAllocation, + {$ENDIF} + SysUtils; type TNotifyFilters = set of (nfFilename, nfDirname, nfAttrib, diff --git a/Game/Code/lib/other/WinAllocation.pas b/Game/Code/lib/other/WinAllocation.pas new file mode 100644 index 00000000..7c26a0e5 --- /dev/null +++ b/Game/Code/lib/other/WinAllocation.pas @@ -0,0 +1,97 @@ +unit WinAllocation; + +// FPC misses AllocateHWnd and DeallocateHWnd which is used by several +// libraries such as Midi... or DirWatch. +// Since FPC 2.2.2 there are dummies in Classes that just raise RunTime exceptions. +// To avoid those exceptions, include this unit AFTER Classes. +// Maybe the dummies will be replaced by functional routines in the future.WinAllocation +// +// THESE FUNCTIONS ARE ONLY FOR COMPATIBILITY WITH SOME EXTERNAL WIN32 LIBS. +// DO NOT USE THEM IN USDX CODE. +// + +interface + +uses + Classes, + Windows; + +function AllocateHWnd(Method: TWndMethod): HWND; +procedure DeallocateHWnd(hWnd: HWND); + +implementation + +function AllocateHWndCallback(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; +var + Msg: TMessage; + MethodPtr: ^TWndMethod; +begin + FillChar(Msg, SizeOf(Msg), 0); + Msg.msg := uMsg; + Msg.wParam := wParam; + Msg.lParam := lParam; + + MethodPtr := Pointer(GetWindowLongPtr(hwnd, GWL_USERDATA)); + if Assigned(MethodPtr) then + MethodPtr^(Msg); + + Result := DefWindowProc(hwnd, uMsg, wParam, lParam); +end; + +function AllocateHWnd(Method: TWndMethod): HWND; +var + ClassExists: Boolean; + WndClass, OldClass: TWndClass; + MethodPtr: ^TMethod; +begin + Result := 0; + + // setup class-info + FillChar(WndClass, SizeOf(TWndClass), 0); + WndClass.hInstance := HInstance; + // Important: do not enable AllocateHWndCallback before the msg-handler method is assigned, + // otherwise race-conditions might occur + WndClass.lpfnWndProc := @DefWindowProc; + WndClass.lpszClassName:= 'USDXUtilWindowClass'; + + // check if class is already registered + ClassExists := GetClassInfo(HInstance, WndClass.lpszClassName, OldClass); + // create window-class shared by all windows created by AllocateHWnd() + if (not ClassExists) or (@OldClass.lpfnWndProc <> @DefWindowProc) then + begin + if ClassExists then + UnregisterClass(WndClass.lpszClassName, HInstance); + if (RegisterClass(WndClass) = 0) then + Exit; + end; + // create window + Result := CreateWindowEx(WS_EX_TOOLWINDOW, WndClass.lpszClassName, '', + DWORD(WS_POPUP), 0, 0, 0, 0, 0, 0, HInstance, nil); + if (Result = 0) then + Exit; + // assign individual callback procedure to the window + if Assigned(Method) then + begin + // TMethod contains two pointers but we can pass just one as USERDATA + GetMem(MethodPtr, SizeOf(TMethod)); + MethodPtr^ := TMethod(Method); + SetWindowLongPtr(Result, GWL_USERDATA, LONG_PTR(MethodPtr)); + end; + // now enable AllocateHWndCallback for this window + SetWindowLongPtr(Result, GWL_WNDPROC, LONG_PTR(@AllocateHWndCallback)); +end; + +procedure DeallocateHWnd(hWnd: HWND); +var + MethodPtr: ^TMethod; +begin + if (hWnd <> 0) then + begin + MethodPtr := Pointer(GetWindowLongPtr(hWnd, GWL_USERDATA)); + DestroyWindow(hWnd); + if Assigned(MethodPtr) then + FreeMem(MethodPtr); + end; +end; + +end. |