[fpc-pascal] How to use a window message queue in a call?

[Anthony Walter]

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;
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.freepascal.org/pipermail/fpc-pascal/attachments/20100127/7fe8e4ee/attachment.html>