<<深入核心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.