[代码]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