[代码]Object Pascal实现Windows标准窗体

基本完全Copy李维大师的《Inside VCL》书中的代码(P18-P20)，手敲调试绝对好过简单的下载复制。

只有出错才能提高，我相信。

没有使用VCL Framework，纯粹Win API调用，带来的是仅有44KB的文件大小。

其实Windows窗体程序的流程也很简单：

1. 定义窗体类——窗体类名为 AppName = 'ET_PureObjectPascalWindow'
2. 注册窗体类——function WinRegister: Boolean;
3. 创建窗体——function WinCreate: HWND;
4. 窗体消息循环

   while GetMessage(AMessage, 0, 0, 0) do begin
       TranslateMessage(AMessage);
       DispatchMessage(AMessage)
   end;

5. 处理窗体消息——function WindowProc(Window: HWND; AMessage: UINT; WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall; export;
6. 直到程序结束

代码如下:

program TestWinAPI;

uses
  Windows, Messages, SysUtils;

const
  AppName = 'ET_PureObjectPascalWindow';

function WindowProc(Window: HWND; AMessage: UINT; WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall; export;
var
  dc: HDC;
  ps: TPaintStruct;
  r: TRect;
begin
  Result := 0;

  case AMessage of
    WM_PAINT: begin
        dc := BeginPaint(Window, ps);
        GetClientRect(Window, r);
        DrawText(dc, '纯粹使用Object Pascal写的Native Windows程序，有够拉风吧！', -1, r, DT_SINGLELINE or DT_CENTER or DT_VCENTER);
        EndPaint(Window, ps);
      end;

    WM_DESTROY: begin
        PostQuitMessage(0);
      end;

  else
    Result := DefWindowProc(Window, AMessage, WParam, LParam);
  end;

end;

function WinRegister: Boolean;
var
  WindowClass: WNDCLASS;
begin
  with WindowClass do begin
    style := CS_HREDRAW or CS_VREDRAW;
    lpfnWndProc := TFNWndProc(@WindowProc);
    cbClsExtra := 0;
    cbWndExtra := 0;
    hInstance := MainInstance;
    hIcon := LoadIcon(0, IDI_APPLICATION);
    hCursor := LoadCursor(0, IDC_ARROW);
    hbrBackground := GetStockObject(WHITE_BRUSH);
    lpszMenuName := nil;
    lpszClassName := AppName;
  end;

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

function WinCreate: HWND;
var
  hWindow: HWND;
begin
  hWindow := CreateWindow(AppName, '爱生活，爱拉风', WS_OVERLAPPEDWINDOW,
    CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT,
    0, 0, MainInstance, nil);

  if hWindow <> 0 then begin
    ShowWindow(hWindow, CmdShow);
    ShowWindow(hWindow, SW_SHOW);
    UpdateWindow(hWindow);
  end;

  Result := hWindow;
end;

var
  AMessage: TMsg;
  hWindow: HWND;

begin
  if not WinRegister then begin
    MessageBox(0, 'WinRegister 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.

Technorati 标签: Delphi,Object Pascal,Windows API