program prog;

uses
  windows,
  messages,
  window in 'window.pas';

{$APPTYPE GUI}

var
  window: TWindow;
  stop: Boolean = false;

begin
  window := TWindow.create("myProg");

  while (not stop) do begin
    sleep(10);
    stop := not window.update();
  end;

  window.free();
end.

unit window;

interface

uses
  windows, messages, sysUtils;

type
  TWindowError = class(Exception);

  TWindow = class(TObject)
  private
    FName: String;
    FHandle: HWnd;
  public
    constructor create(name: String); virtual;
    destructor destroy(); override;
    function update(): boolean;
  end;

implementation

function wndProc(window: HWnd; msgId, wParam, lParam: LongInt): LongInt; stdcall; export;
var
  msg: TMessage;
begin
  msg.msg := msgId;

  case msgId of
    WM_DESTROY: postQuitMessage(0);
  else
    wndProc := DefWindowProc(window, msgId, wParam, lParam);
    exit();
  end;

  result := msg.Result
end;

constructor TWindow.create(name: String);
var
  wndClass: TWndClass;
begin
  FName := name;

  wndClass.style := CS_HREDRAW or CS_VREDRAW;
  wndClass.cbClsExtra := 0;
  wndClass.cbWndExtra := 0;
  wndClass.hInstance := hInstance;
  wndClass.hIcon := loadIcon(0, IDI_INFORMATION);
  wndClass.hCursor := loadCursor(0, IDC_ARROW);
  wndClass.hbrBackground := hBrush(getStockObject(BLACK_BRUSH));
  wndClass.lPszMenuName := nil;
  wndClass.lPszClassName := PWideChar(name);
  wndClass.lpfnWndProc := @wndProc;

  if (registerClass(wndClass) <> 0) then begin
    FHandle := createWindow(
      PWideChar(name),
      PWideChar(name),
      WS_OVERLAPPEDWINDOW,
      CW_USEDEFAULT,
      CW_USEDEFAULT,
      CW_USEDEFAULT,
      CW_USEDEFAULT,
      0,
      0,
      hInstance,
      nil
    );

    if (FHandle <> 0) then begin
      setWindowLong(FHandle, GWL_STYLE, WS_POPUP);
      showWindow(FHandle, SW_MAXIMIZE);
    end
    else TWindowError.create('Не удается создать окно.');
  end
  else
    raise TWindowError.create('Не удается зарегистрировать класс.');
end;

destructor TWindow.destroy();
begin
  destroyWindow(FHandle);

  inherited;
end;

function TWindow.update(): boolean;
var
  msg: TMsg;
begin
  result := true;

  while (peekMessage(msg, FHandle, 0, 0, 0)) do begin
    if (getMessage(msg, FHandle, 0, 0)) then begin
      translateMessage(msg);
      dispatchMessage(msg);

      if (msg.message = WM_DESTROY) then
      exit(false);
    end;
  end;
end;

end.

window.free();

  msg.msg := msgId;

  case msgId of
    WM_DESTROY: postQuitMessage(0);
  else
    result := defWindowProc(window, msgId, wParam, lParam);
  end;