As Michael Van Canneyt says, you cannot use a method as a window message
handler. This assumed implicit Self variable will most likely break the
return pointer on the stack.
Here is my code for a user defined window class. Note, window messages are
processed through TObject.Dispatch
threadvar
CreationWindow: TBaseWindow;
function BaseWindowProc(Wnd: HWND; uMsg: Cardinal; wParam: LongInt; lParam:
LongInt): Integer; stdcall;
var
BaseWindow: TBaseWindow;
Msg: TMessage;
begin
if CreationWindow <> nil then
begin
BaseWindow := CreationWindow;
BaseWindow.FHandle := Wnd;
SetWindowLong(Wnd, GWL_USERDATA, Integer(BaseWindow));
CreationWindow := nil;
end
else
BaseWindow := TBaseWindow(GetWindowLong(Wnd, GWL_USERDATA));
Result := -1;
if BaseWindow <> nil then
try
Msg.Msg := uMsg;
Msg.wParam := wParam;
Msg.lParam := lParam;
Msg.Result := -1;
BaseWindow.Dispatch(Msg);
Result := Msg.Result;
if Msg.Msg = WM_DESTROY then
BaseWindow.FHandle := 0;
except
on E: Exception do
MessageBox(0, PChar(E.ClassName + ': ' + E.Message), 'Error',
MB_ICONERROR or MB_OK or MB_TASKMODAL);
end
else
Result := DefWindowProc(Wnd, uMsg, wParam, lParam);
end;
constructor TBaseWindow.Create(Parent: HWND = 0; Style: Cardinal = 0;
ExStyle: Cardinal = 0);
var
WindowClass: string;
WindowName: string;
Info: TCreateInfo;
begin
inherited Create;
WindowClass := ClassName + IntToStr(HInstance);
FillChar(Info, SizeOf(Info), #0);
Info.Parent := Parent;
Info.Style := Style;
Info.ExStyle := ExStyle;
CreateInfo(Info);
if not GetClassInfo(SysInit.HInstance, PChar(WindowClass), Info.WndClass)
then
begin
with Info.WndClass do
begin
lpfnWndProc := @BaseWindowProc;
lpszClassName := PChar(WindowClass);
hInstance := SysInit.HInstance;
Windows.RegisterClass(Info.WndClass);
end;
end;
CreationWindow := Self;
try
with Info do
CreateWindowEx(ExStyle, PChar(WindowClass), PChar(WindowName),
Style,
X, Y, W, H, Parent, 0, 0, nil);
except
CreationWindow := nil;
end;
if FHandle = 0 then
RaiseLastWin32Error;
end;
_______________________________________________
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
