<<深入核心VCL架构剖析>>笔记(1)

Windows:事件驱动机制.

事件转换为消息,再分派给应用程序.

每个应用程序都有一个消息队列(Message Queue),当事件发生时执行环境会把属于本应用程序的的消息分派到消息队列里,应用程序从消息队列里取出并处理.

创建原生Windows程序

创建原生Windows程序需要使用如下record:

TMSG定义如下:

TMsg = tagMSG;

tagMSG = record
  hwnd: HWND;
  message: UINT;
  wParam: WPARAM;
  lParam: LPARAM;
  time: DWORD;
  pt: TPoint;
end;

 

WNDCLASS 定义如下:

WNDCLASS = WNDCLASSW;

WNDCLASSW = tagWNDCLASSW;

tagWNDCLASSW = record
  style: UINT;
  lpfnWndProc: TFNWndProc;
  cbClsExtra: Integer;
  cbWndExtra: Integer;
  hInstance: HINST;
  hIcon: HICON;
  hCursor: HCURSOR;
  hbrBackground: HBRUSH;
  lpszMenuName: PWideChar;
  lpszClassName: PWideChar;
end;

 

消息处理回调函数:

function WindowProc(Window:Hwnd;AMessage: UNIT)

 

需要使用的API函数:

1.注册窗口类:

function RegisterClass(const lpWndClass: TWndClass): ATOM; stdcall;

2.创建窗体

function CreateWindow(lpClassName: PWideChar; lpWindowName: PWideChar;
  dwStyle: DWORD; X, Y, nWidth, nHeight: Integer; hWndParent: HWND;
  hMenu: HMENU; hInstance: HINST; lpParam: Pointer): HWND;

具体代码如下

CreateWindowprogram Project1;

uses
  Winapi.Windows,Winapi.Messages,System.SysUtils;

const
  APPNAME = 'ObjectPascalHello';

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

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

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

function WinRegister: Boolean;
var
  WindowClass: WNDCLASS;
begin
  with WindowClass do
  begin
    style := CS_VREDRAW or CS_HREDRAW;
    lpfnWndProc := TFNWndProc(@WindowProc) ;
    cbClsExtra := 0;
    cbWndExtra := 0;
    hInstance := System.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,'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;

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,'Create window failed',nil,MB_OK);
    Exit;
  end;

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

  Halt(AMessage.wParam);

end.

退出流程:

TForm.Close---->TApplication.Terminate---->PostQuitMessage---->WM_QUIT

一般主窗口关闭时会发出WM_DESTROY,而WM_DESTROY会调用PostQuitMessage:

窗口关闭---->WM_DESTROY---->PostQuitMessage---->WM_QUIT

应用程序不用处理的消息需用DefWindowProc将消息传递给操作系统,由操作系统来处理这个消息

使用OOP方式实现原生程序:

program Project1;

uses
  Winapi.Windows,Winapi.Messages;

const
  APPNAME = 'ObjectPascalHello';


type
  TMyWindow = class(TObject)
  private
    WindowClass: WNDCLASS;
    hWindow: HWND;
    AMessage: TMsg;
    FWindowProcedure: TFNWndProc;
    FApplicationName: string;

    function WinRegister: Boolean;
    procedure CreateMyWindow;
  public
    constructor Create;
    destructor Destroy;override;
    procedure WinCreate;
    procedure Run;

    property ApplicationName: string read FApplicationName write FApplicationName;
    property WindowProcedure: TFNWndProc read FWindowProcedure write FWindowProcedure;
  end;

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

  case AMessage of
    WM_PAINT:
    begin
      dc := BeginPaint(Window,ps);
      try
        GetClientRect(Window,r);
        DrawText(dc,'使用TMyWindow类封装的Window程序.',-1,r,DT_CENTER or DT_SINGLELINE or DT_VCENTER);
      finally
        EndPaint(Window,ps)
      end;
    end;
    WM_LBUTTONDBLCLK:
    begin
      MessageBox(0,'','',MB_OK);
    end;
    WM_DESTROY:
    begin
      PostQuitMessage(0);
    end;
  end;

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

var
  MyWindow: TMyWindow;

{ TMyWindow }

constructor TMyWindow.Create;
begin
  FWindowProcedure := @WindowProc;
  FApplicationName := APPNAME;
end;

procedure TMyWindow.CreateMyWindow;
begin
  hWindow := CreateWindow(PChar(FApplicationName),'MyWindow',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;

end;

destructor TMyWindow.Destroy;
begin

  inherited;
end;

procedure TMyWindow.Run;
begin
  while GetMessage(AMessage,0,0,0) do
  begin
    TranslateMessage(AMessage);// 翻译消息
    DispatchMessage(AMessage); // 分派消息
  end;

  Halt(AMessage.wParam);
end;

procedure TMyWindow.WinCreate;
begin
  if WinRegister then
  begin
    CreateMyWindow;
  end;
end;

function TMyWindow.WinRegister: Boolean;
begin
  with WindowClass do
  begin
    //当垂直长度改变或移动窗口时，重画整个窗口
    //当水平长度改变或移动窗口时，重画整个窗口
    style := CS_VREDRAW or CS_HREDRAW;
    //设置消息回调函数
    lpfnWndProc := FWindowProcedure ;
    cbClsExtra := 0;
    cbWndExtra := 0;
    hInstance := System.MainInstance;
    hIcon := LoadIcon(0,IDI_APPLICATION);
    hCursor := LoadCursor(0,IDC_ARROW);
    hbrBackground := GetStockObject(WHITE_BRUSH){COLOR_WINDOW} ;
    lpszMenuName := nil;
    lpszClassName := PChar(FApplicationName);
  end;

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

begin
  MyWindow := TMyWindow.Create;
  MyWindow.WinCreate;
  SetWindowText(MyWindow.hWindow,'面向对象方式设计窗口');
  try
    MyWindow.Run;
  finally
    MyWindow.Free;
    MyWindow := nil;
  end;

end.