paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-11 05:56:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

Patch from DRIGUS GmbH, implements Allocate/DeallocateHwnd for wince

Browse Source 
git-svn-id: trunk@26852 -
This commit is contained in:
sekelsenmat 2010-07-27 11:24:17 +00:00
parent 07c7749729
commit 8e7181cd43
2 changed files with 88 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

85
lcl/interfaces/wince/wincelclintf.inc
View File

@ -563,4 +563,89 @@ begin
end;
{------------------------------------------------------------------------------
Method: CallbackAllocateHWnd
Params: None
Returns: Nothing
Callback for the AllocateHWnd function
------------------------------------------------------------------------------}
procedure CallbackAllocateHWnd(Ahwnd: HWND; uMsg: UINT; wParam: WParam; lParam: LParam); stdcall;
var
Msg: TLMessage;
PMethod: ^TLCLWndMethod;
begin
FillChar(Msg, SizeOf(Msg), #0);
Msg.msg := uMsg;
Msg.wParam := wParam;
Msg.lParam := lParam;
{------------------------------------------------------------------------------
Here we get the callback WndMethod associated with this window
------------------------------------------------------------------------------}
PMethod := Pointer(Widgetset.GetWindowLong(ahwnd, GWL_USERDATA));
if Assigned(PMethod) then PMethod^(Msg);
Windows.DefWindowProc(ahwnd, uMsg, wParam, lParam);
end;
{------------------------------------------------------------------------------
Method: TWinCEWidgetSet.AllocateHWnd
Params: Method - The callback method for the window. Can be nil
Returns: A window handle
Allocates a non-visible window that can be utilized to receive and send message
On Windows, you must call Windows.DefWindowProc(MyHandle, Msg.msg, Msg.wParam, msg.lParam);
in your callback function, if you provide one at all, of course.
------------------------------------------------------------------------------}
function TWinCEWidgetSet.AllocateHWnd(Method: TLCLWndMethod): HWND;
var
PMethod: ^TLCLWndMethod;
begin
Result := Windows.CreateWindow(@ClsName[0],
'', WS_OVERLAPPED, 0, 0, 0, 0, 0, 0, MainInstance, nil);
{------------------------------------------------------------------------------
SetWindowLong has only space for 1 pointer on each slot, but a method is
referenced as a structure with 2 pointers, so here we allocate memory for
the structure before it can be used to transport data between the callback
and this function
------------------------------------------------------------------------------}
if Assigned(Method) then
begin
Getmem(PMethod, SizeOf(TMethod));
PMethod^ := Method;
Self.SetWindowLong(Result, GWL_USERDATA, PtrInt(PMethod));
end;
Self.SetWindowLong(Result, GWL_WNDPROC, PtrInt(@CallbackAllocateHWnd))
end;
{------------------------------------------------------------------------------
Method: TWinCEWidgetSet.DeallocateHWnd
Params: Wnd - A Window handle, that was created with AllocateHWnd
Returns: Nothing
------------------------------------------------------------------------------}
procedure TWinCEWidgetSet.DeallocateHWnd(Wnd: HWND);
var
PMethod: ^TLCLWndMethod;
begin
PMethod := Pointer(Self.GetWindowLong(Wnd, GWL_USERDATA));
if Wnd <> 0 then Windows.DestroyWindow(Wnd);
{------------------------------------------------------------------------------
This must be done after DestroyWindow, otherwise a Access Violation will
happen when WM_CLOSE message is sent to the callback
This memory is for the TMethod structure allocated on AllocateHWnd
------------------------------------------------------------------------------}
if Assigned(PMethod) then Freemem(PMethod);
end;
//##apiwiz##eps## // Do not remove, no wizard declaration after this line

3
lcl/interfaces/wince/wincelclintfh.inc
View File

@ -34,9 +34,12 @@ function AddPipeEventHandler(AHandle: THandle;
AEventHandler: TPipeEvent; AData: PtrInt): PPipeEventHandler; override;
function AddProcessEventHandler(AHandle: THandle;
AEventHandler: TChildExitEvent; AData: PtrInt): PProcessEventHandler; override;
function AllocateHWnd(Method: TLCLWndMethod): HWND; override;
function CreateStandardCursor(ACursor: SmallInt): hCursor; override;
procedure DeallocateHWnd(Wnd: HWND); override;
function GetAcceleratorString(const AVKey: Byte; const AShiftState: TShiftState): String; override;
function GetControlConstraints(Constraints: TObject): boolean; override;
function GetDeviceSize(DC: HDC; var p: TPoint): boolean; override;