~ Object Pascal 写的（不使用 vcl ）windows应用程序 ~

我们也许已经习惯了使用了VCL，也许我们自己尝试写过不使用VCL的windows程序，但之于我，似乎从来没有像下面这样写的清晰明了。嗯，下面的代码来自李维，由我部分注释。

{ ************************************************* }
{ Object Pascal 写的不使用VCL的 Windows 程序        }
{ 程序名： ObjectPascalWinHello                     }
{ 一个很好的示例，理解Pascal & Windows 程序设计     }
{ ************************************************* }

program ObjectPascalWinHello;

uses
  Windows, Messages, SysUtils;
 
const
  AppName = 'ObjectPascalHello';

function WindowProc(Window: HWnd; AMessage: UINT; wParam: WPARAM;
		lParam: LPARAM): LRESULT; stdcall; export;
var
  dc: HDC;
  ps: TPaintStruct;
  r: TRect;
begin
  WindowProc := 0;

  case AMessage of 
    WM_PAINT: begin
		dc := BeginPaint(Window, ps);
		GetClientRect(Window, r);
		DrawText(dc, '使用Object Pascal撰写的Native Window程序', -1, r,
			DT_SINGLELINE or DT_CENTER or  DT_VCENTER);
		EndPaint(Window, ps);
		exit;
	      end;
    WM_DESTROY: begin
		  PostQuitMessage(0);
		  exit;
		end;
  end;

  WindowProc := DefWindowProc(Window, AMessage, wParam, lParam);
end;

{ Register the window class }

function WinRegister: Boolean;
var
  WindowClass: WndClass;
begin
  WindowClass.Style := cs_hRedraw or cs_vRedraw;
  WindowClass.lpfnWndProc := TFNWNDProc(@WindowProc);
  WindowClass.cbClsExtra := 0;
  WindowClass.cbWndExtra := 0;
  WindowClass.hInstance := System.MainInstance;
  WindowClass.hIcon := LoadIcon(0, idi_Application);
  WindowClass.hCursor := LoadCursor(0, idc_Arrow);
  WindowClass.hbrBackground := GetStockObject(WHITE_BRUSH);
  WindowClass.lpszMenuName := nil;
  WindowClass.lpszClassName := AppName;

  Result := (RegisterClass(WindowClass) <> 0);
end;

{ Create the Window Class }
function WinCreate: HWnd;
var
  hWindow: HWnd;
begin
  hWindow := CreateWindow(AppName, 'Hello world object pascal program', 
	ws_OverlappedWindow, cw_UseDefault, cw_UseDefault, 
	cw_UseDefault, cw_UseDefault, 0, 0, System.MainInstance, nil);
  
  if hWindow <> 0 then 
  begin
    ShowWindow(hWindow, CmdShow);
    ShowWindow(hWindow, SW_SHOW);
    UpdateWindow(hWindow);
  end;

  result := hWindow;
end;

//------------- Main -------------------
var
  AMessage :TMsg;
  hWindow: HWnd;

begin
  if not WinRegister then //注册窗口
  begin
    MessageBox(0, 'Register failed', nil, MB_OK);
    exit;
  end;
  hWindow := WinCreate;//创建窗口
  if longint(hWindow) = 0 then
  begin
    MessageBox(0, 'WinCreate failed', nil, mb_OK);
    exit;
  end;

  while GetMessage(AMessage, 0, 0, 0) do //进入消息循环
  begin
    TranslateMessage(AMessage);
    DispatchMessage(AMessage);
  end;
  Halt(AMessage.wParam);
end.
  

这个示例清晰展示了windows平台下程序设计的要求。