WinAPI window class

[Brainer]

Hello.

I was bored and just put up together a class for creating a window using Windows API. Notice that the window procedure is a member of the class.

STILL WIP

unit UWindow;

interface

uses
  Windows, Messages;

type
  { .: TWindow :. }
  TWindow = class sealed(TObject)
  private
    { Private declarations }
    FWidth: Cardinal;
    FHeight: Cardinal;

    WndProcPtr: Pointer;
    WndHandle: HWND;
    h_Instance: HINST;

    function WndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM;
      lParam: LPARAM): LRESULT; stdcall;
    function WinMain(hInstance: HINST; hPrevInstance: HINST;
      lpCmdLine: PChar; nCmdShow: Integer): Integer; stdcall;

    function CreateWnd(): Boolean;
    function FreeWnd(): Boolean;
    procedure SetWndParams(const Index: Integer; const Value: Cardinal);
  public
    { Public declarations }
    constructor Create();
    destructor Destroy(); override;

    function Run(): Integer;

    property Width: Cardinal index 0 read FWidth write SetWndParams;
    property Height: Cardinal index 1 read FHeight write SetWndParams;
  end;

implementation

type
  { .: TMethodToProc :. }
  TMethodToProc = packed record
    popEax: Byte;
    pushSelf: record
      opcode: Byte;
      Self: Pointer;
    end;
    pushEax: Byte;
    jump: record
      opcode: Byte;
      modRm: Byte;
      pTarget: ^Pointer;
      target: Pointer;
    end;
  end;

{ .: MethodToProcedure :. }
function MethodToProcedure(self: TObject; methodAddr: Pointer): Pointer;
var
  mtp: ^TMethodToProc absolute Result;
begin
  New(mtp);
  with mtp^ do
  begin
    popEax := $58;
    pushSelf.opcode := $68;
    pushSelf.Self := Self;
    pushEax := $50;
    jump.opcode := $FF;
    jump.modRm := $25;
    jump.pTarget := @jump.target;
    jump.target := methodAddr;
  end;
end;

{ TWindow }

constructor TWindow.Create;
begin
  inherited Create();

  WndProcPtr := MethodToProcedure(Self, @TWindow.WndProc);
  h_Instance := GetModuleHandle(nil);
  FWidth := 800;
  FHeight := 600;
end;

function TWindow.CreateWnd: Boolean;
var
  WndClass: TWndClass;
  dwStyle, dwExStyle: DWORD;
begin
  Result := False;

  ZeroMemory(@WndClass, SizeOf(WndClass));
  FreeWnd();

  with WndClass do
  begin
    style := CS_HREDRAW or CS_VREDRAW or CS_OWNDC;
    lpfnWndProc := WndProcPtr;
    hInstance := h_Instance;
    hCursor := LoadCursor(0, IDC_ARROW);
    lpszClassName := 'BrainerWindow';
  end;

  if (Windows.RegisterClass(WndClass) = 0) then
    exit;

  dwStyle := WS_OVERLAPPEDWINDOW or WS_CLIPCHILDREN or WS_CLIPSIBLINGS;
  dwExStyle := WS_EX_APPWINDOW or WS_EX_WINDOWEDGE;

  WndHandle := CreateWindowEx(dwExStyle, 'BrainerWindow', '', dwStyle, 0, 0,
    FWidth, FHeight, 0, 0, h_Instance, nil);

  if (WndHandle = 0) then
    exit;

  ShowWindow(WndHandle, SW_SHOW);
  SetForegroundWindow(WndHandle);
  SetFocus(WndHandle);

  Result := True;
end;

destructor TWindow.Destroy;
begin
  Dispose(WndProcPtr);

  inherited;
end;

function TWindow.FreeWnd: Boolean;
begin
  Result := False;

  if ((WndHandle <> 0) and (not DestroyWindow(WndHandle))) then
  begin
    WndHandle := 0;
    exit;
  end;

  if (not Windows.UnregisterClass('BrainerWindow', h_Instance)) then
  begin
    h_Instance := 0;
    exit;
  end;

  Result := True;
end;

function TWindow.Run: Integer;
begin
  Result := -1;

  if (not CreateWnd()) then
    exit;
  Result := WinMain(h_Instance, hPrevInst, CmdLine, CmdShow);
end;

procedure TWindow.SetWndParams(const Index: Integer; const Value: Cardinal);
var
  Changed: Boolean;
begin
  Changed := False;
  case Index of
    0:  Changed := (FWidth <> Value);
    1:  Changed := (FHeight <> Value);
  end;

  if (Changed) then
    SetWindowPos(WndHandle, 0, 0, 0, FWidth, FHeight, SWP_NOREDRAW);
end;

function TWindow.WinMain(hInstance, hPrevInstance: HINST; lpCmdLine: PChar;
  nCmdShow: Integer): Integer;
var
  IsDone: Boolean;
  Msg: TMsg;
begin
  IsDone := False;

  while (not IsDone) do
    if (PeekMessage(msg, 0, 0, 0, PM_REMOVE)) then
    begin
      if (msg.message = WM_QUIT) then
        IsDone := True
      else
      begin
        TranslateMessage(msg);
        DispatchMessage(msg);
      end;
    end;
  FreeWnd();

  Result := Msg.wParam;
end;

function TWindow.WndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM;
  lParam: LPARAM): LRESULT;
begin
  case (Msg) of
    WM_CLOSE:
      begin
        PostQuitMessage(0);
        Result := 0;
      end;
    WM_SIZE:
      begin
        FWidth := LoWord(lParam);
        FHeight := HiWord(lParam);
        Result := 0;
      end;
  else
    Result := DefWindowProc(hWnd, Msg, WParam, LParam);
  end;
end;

end.

[arthurprs]

Clever, generating a function on the fly

[Ñuño Martínez]

Nice. I remember I did something like this in C++ for Windows 3.11 a long time ago.

I think it should raise some exceptions (and define its own Exception class) instead of just "exit". I hope I can remember this post when I start the Allegro.pas 4.5 version because I'll need it for sure.

[JSoftware]

What's wrong with the good old SetWindowLong with GWL_USERDATA trick? I realize that you save one function, but in the reliability section it certainly takes a hit

Nice hack though

[Brainer]

What's wrong with the good old SetWindowLong with GWL_USERDATA trick?

Nothing - I just wanted it done like that. The purpose was to show that there are different ways of doing the same thing. Of course, the above is a rough sketch, still waiting for improvements. I just wanted to show you a concept you could possibly use to build your own class.

[chronozphere]

LOL, that's quite clever indeed. I know this problem. WndProc can be hard to use when you're writing OOP code. This is the hakish solution. Nice one.