2009. február 17., kedd

Create a form using Win API only


Problem/Question/Abstract:

How can I create a form without using the Forms unit?

Answer:

program InputAPI;

uses
  Windows, Messages;

var
  WinClass: TWndClassA;
  Inst, Handle, Button1, Button2: Integer;
  Msg: TMsg;
  hFont: Integer;

  { Custom WindowProc function }

function WindowProc(hWnd, uMsg, wParam, lParam: Integer): Integer; stdcall;
begin
  Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
  { Checks for messages }
  if uMsg = WM_DESTROY then
    Halt;
end;

begin
  { Register Custom WndClass }
  Inst := hInstance;
  with WinClass do
  begin
    style := CS_CLASSDC or CS_PARENTDC;
    lpfnWndProc := @WindowProc;
    hInstance := Inst;
    hbrBackground := color_btnface + 1;
    lpszClassname := 'Test';
    hCursor := LoadCursor(0, IDC_ARROW);
  end;
  RegisterClass(WinClass);
  { Create Main Window }
  Handle := CreateWindowEx(WS_EX_WINDOWEDGE or WS_EX_CONTROLPARENT, 'Test',
    'TestWindow', WS_VISIBLE or WS_CAPTION or WS_SYSMENU, 300, 200, 300, 100,
    0, 0, Inst, nil);
  { Create a button }
  Button1 := CreateWindow('Button', 'Ok', WS_VISIBLE or WS_CHILD or WS_TABSTOP or
    BS_PUSHLIKE or BS_TEXT, 50, 20, 75, 25, handle, 0, Inst, nil);
  Button2 := CreateWindow('Button', 'Cancel', WS_VISIBLE or WS_CHILD or WS_TABSTOP or
    BS_PUSHLIKE or BS_TEXT, 150, 20, 75, 25, handle, 0, Inst, nil);
  { Create Font Handle }
  hFont := CreateFont(-15, 0, 0, 0, 400, 0, 0, 0, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS,
    CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH or FF_DONTCARE,
    'MS Sans Serif');
  { Change fonts }
  if hFont <> 0 then
  begin
    SendMessage(Button1, WM_SETFONT, hFont, 0);
    SendMessage(Button2, WM_SETFONT, hFont, 0);
  end;
  SetFocus(Button1);
  UpdateWindow(Handle);
  { Message Loop }
  while (GetMessage(Msg, 0, 0, 0)) do
    if not IsDialogMessage(handle, msg) then
    begin
      TranslateMessage(msg);
      DispatchMessage(msg);
    end;
end.

Nincsenek megjegyzések:

Megjegyzés küldése