Pure API Window

Pure API Window

 

program APIWindow;

uses
  SysUtils,
  Windows,
  Messages;

const
  WinClassName = 'MingClass';
  StrOut = 'Ming TextOut';

function MyWinProc(
         hWindow: HWND;
         aMessage: UINT;
         WParam: WPARAM;
         LParam: LPARAM): LRESULT; stdcall; export;
var
  dc: HDC;
  ps: TPaintStruct;
  rect: TRect;
begin
  MyWinProc := 0;
  case aMessage of
  WM_PAINT:
    begin
      dc := BeginPaint(hWindow,ps);
      GetClientRect(hWindow,rect);
      DrawText(dc,StrOut,Length(StrOut),rect,DT_SINGLELINE or DT_CENTER or DT_VCENTER);
      //TextOut(dc,0,0,StrOut,Length(StrOut));
      EndPaint(hWindow,ps);
    end;
  WM_LBUTTONDOWN:
    begin
      dc := GetDC(hWindow);//GetDC(0);
      TextOut(dc,0,0,'Left Button Down',Length('Left Button Down'));
      ReleaseDC(hWindow,dc);
      //ReleaseDC(0,dc);
    end;
  WM_CLOSE:
    if ID_YES = MessageBox(0,'Are you sure exit ?','Propmt info',MB_YESNO) then
    begin
      DestroyWindow(hWindow);
    end;
  WM_DESTROY:
    begin
      PostQuitMessage(0);
    end;
  else
    Result := DefWindowProc(hWindow,aMessage,WParam,LParam);
  end;
end;

function WinRegister: Boolean;
var
  wndClass: TWndClass;
  hInstance: Cardinal;
begin
  hInstance := GetModuleHandle(0);
  //
  wndClass.style := CS_VREDRAW or CS_HREDRAW;
  wndClass.lpfnWndProc := TFNWndProc(@MyWinProc); //Callback function
  wndClass.cbClsExtra := 0;
  wndClass.cbWndExtra := 0;
  wndClass.hInstance := hInstance;//Same as System.MainInstance;
  wndClass.hIcon := LoadIcon(0,IDI_INFORMATION);
  wndClass.hCursor := LoadCursor(0,IDC_CROSS);
  wndClass.hbrBackground := HBRUSH(GetStockObject(BLACK_BRUSH));
  wndClass.lpszMenuName := nil;
  wndClass.lpszClassName := WinClassName;
  //
  Result := Windows.RegisterClass(wndClass) <> 0;
end;

function WinCreate: HWND;
var
  hWindow: HWND;
  hInstance: Cardinal;
begin
  hInstance := GetModuleHandle(0);
  hWindow := CreateWindow(
            WinClassName
            ,'Pure Api Window'
            ,WS_OVERLAPPEDWINDOW or WS_SIZEBOX or WS_MAXIMIZEBOX
            ,cw_UseDefault
            ,cw_UseDefault
            ,600
            ,400
            ,0
            ,0
            ,hInstance//System.MainInstance
            ,nil);
  if hWindow <> 0 then
  begin
    ShowWindow(hWindow,SW_SHOWNORMAL);
    UpdateWindow(hWindow);
  end;
  Result := hWindow;
end;

var
  aMsg: TMsg;
  hWindow: HWND;
begin
  if not WinRegister then
  begin
    MessageBox(0,'Register class failed',nil,0);
    exit;
  end;
  //
  hWindow := WinCreate;
  if hWindow = 0 then
  begin
    MessageBox(0,'Create window failed',nil,0);
    exit;
  end;  
  //
  while(GetMessage(aMsg,0,0,0)) do
  begin
    TranslateMessage(aMsg);
    DispatchMessage(aMsg);
  end;
  Halt(aMsg.wParam);
end.

A new one

program aWindow;

uses
  Windows,
  Messages;

{$R *.RES}

var
  wClass: TWndClass;
  msg: TMsg;

function WindowProc(hWnd,msg,wParam,lParam:Integer):integer;stdcall;
begin
  if msg = WM_DESTROY then PostQuitMessage(0);
  Result := DefWindowProc(hWnd,msg,wParam,lParam);
end;

begin
  wClass.lpszClassName := 'MingClass';
  wClass.lpfnWndProc   := @WindowProc;
  wClass.hInstance     := HInstance;
  wClass.hbrBackground := 1;
  RegisterClass(wClass);
  CreateWindowEx(0,wClass.lpszClassName,'Ming Caption',WS_OVERLAPPEDWINDOW or WS_VISIBLE,
      100,100,340,220,0,0,HInstance,nil);
  while GetMessage(msg,0,0,0) do
  begin
    TranslateMessage(msg);
    DispatchMessage(msg);
  end;
end.