娃娃鸭深入核心VCL架构剖析(李维)笔记

VCL Framework与消息
29、VCL Framework窗口消息

VCL Framework提供的窗口消息封装机制必须解决下面的问题： 1．如何把窗口消息正确分派到发生的窗口和控件中？ 2．窗口消息如何分派给封装控件的VCL封装类？ TWinControl=class(TObject) procedure WndProc(Var Message:TMessage);virtual; end; TEdit=class(TWinControl) procedure WndProc(Var Message:TMessage);override; end; TButton=class(TWinControl) procedure WndProc(Var Message:TMessage);override; end; var aControl:TWinControl; begin ... GetWindowMessage(Message); aControl:=GetTargetControl(Message); aControl.WndProc(Message); ... end;

30、VCL的窗口消息封装机制

在传统的Windows程序设计中，Windows操作系统是调用一般的回调函数的，而所谓一般的回调函数就是指C语言的函数类型。但是在面向对象程序语言中当程序代码调用对象的方法是时，除了目标方法接受的参数之外，调用者(Caller)还需要传递一个额外的隐藏参数，那就是Object Pascal语言的Self或是C++语言的this，也正是因为这个原因，在对象方法之中才能够使用Self来进行存取对象本身的服务，因此VCL Framework要解决的问题就是如何从Windows操作系统调用到对象的方法。也就是说如何把Windows操作系统要调用的一般的C函数类型转换成可调用的VCL Framework中面向对象的方法？ 先撰写一个使用Object Pascal语法的但是符合C函数类型的窗口回调函数让Windows操作系统调用，然后在这个正常的回调函数中先找到目的VCL对象，再主动把Self推入栈中，再推入对象方法的参数，最后再调用对象方法即可让调用回调函数改变成调用对象方法。 function WindowProc(Window:HWND;AMessage:UINT;WParam:WPARAM;LParam:LPARAM):LRESULT;stdcall;export; var ... begin ... control:=FindControl(ControlHandle); push EAX,Self control.WndProc(Message);//wnd是VCL组件重载的虚拟方法，使用来处理窗口消息 ... 在VCL Framework内部有一个重要的回调函数InitWndProc。事实上InitWndProc在执行完了转换的动作之后会调用另外一个VCL　Framework内部重要的函数StdWndProc，再由StdWndProc分派消息给对象方法。 StdWndProc就像窗口回调函数的地位一样，是VCL　Framework中分派消息的枢纽。

31、TObject的消息分派服务

TObject还有最后一个重要的服务，即消息分派服务。 TObject类定义了两个和分派消息相关的方法，虚拟方法Dispatch以及虚拟方法DefaultHandler: TObject=class … procedure Dispatch(var Message); virtual; procedure DefaultHandler(var Message); virtual; … end; 未指明类型的参数Message。是因为TObejct的Dispatch和DefaultHandler是被定义和实现成能够传递任何消息的机制，并不仅限于窗口消息。 在System.pas程序单元中只注明了Disptach和DefaultHandler可以接受任何的数据类型作为参数，惟一的要求是这个数据类型的前两个字节必须是消息ID值，根据这个消息ID在VCL对象的方法窗体中搜寻拥有相同消息ID的方法，然后把这个参数分配给搜寻到的方法（即调用搜寻到拥有相同消息ID的方法）。 在VCL Framework中定义了一个TDispatchMessage记录类型，TDispatchMessage代表了在VCL Framework中通用的消息数据结构： TDispatchMessage=record MsgID:word; end; 在VCL　Framework中任何想要使用VCL自动分派消息机制的消息种类，例如窗口消息或是VCL内部的消息，都必须遵照TDispatchMessage定义的架构。 function WindowProc(Window:Hwnd;AMessage:UINT;wParam:WPARAM;LParam:LPARAM):LRESULT;stdcall;export; 其中Amessage就是代表窗口消息的消息ID，类型是UNIT。 TMessage = packed record Msg: Cardinal; case Integer of 0: ( WParam: Longint; LParam: Longint; Result: Longint); 1: ( WParamLo: Word; WParamHi: Word; LParamLo: Word; LParamHi: Word; ResultLo: Word; ResultHi: Word); end; TObject.Dispatch函数的工作就是目标VCL组件中搜寻处理此消息的事件处理函数，然后调用此事件处理函数。

32、窗口消息分类

消息种类	说明
窗口命令消息（WM_COMMAND）	这个消息属于窗口本身的消息，只是WM_COMMAND可以说是母消息主体，在这个消息的其它参数中，例如wParam参数中还包含了其他的辅助消息。举凡点击菜单、点击按钮等等事件都是由窗口命令消息来代表的，因此WM_COMMOND消息主要是由窗口控件或者UI之类的对象触发的窗口消息。
窗口标准消息（WM_...）	这些消息是属于窗口本身的消息，除了上述的窗口命令消息之外，任何以WM_开头的窗口消息都属于窗口标准消息。
VCL自行触发的消息（VCL_Triggered Message）	这类消息是由VCL自行触发的消息，这种消息是为了结合窗口消息以及VCL组件的事件处理函数。简单地说，这类消息即是窗口消息和VCL组件事件处理函数之间触发的媒介桥梁。
VCL通知消息（Notification Message）	这些消息属于VCL　Framework通知内部状态改变的消息，例如当程序员把VCL组件加入到TForm之中时，VCL　Framework就会触发此种消息。同样地，当移除VCL组件时也会触发此类消息。
VCL自定义消息（Custom Message）	这是VCL Framework允许程序员自行定义的自定义消息。程序员能够定义自定义消息以及触发的处理，其余的工作就由VCL Framework自动分派来完成。

33、调用惯例（Calling Convention）

调用惯例	参数传递顺序	谁负责清除参数	参数是不使用暂存器
register	从左到右	被调用函数	是
pascal	从左到右	被调用函数	否
cdecl	从右到左	调用者	否
stdcall	从右到左	被调用函数	否
safecall	从右到左	被调用函数	否

Delphi默认使用的调用惯例是register，但是许多Win32 API使用调用惯例却是pascal，stdcall和safecall。
窗口回调函数是使用pascal调用惯例，但是VCL组件的事件处理函数却是使用register调用惯例，因此当VCL Framework从窗口回调函数在分派消息到VCL组件的消息处理函数时，也必须把调用惯例从pascal转换到register调用惯例，才能够正确地让程序执行下去。

函数种类	说明	实现方式	调用惯例
Click;dynamic;	VCL Framework中调用VCL控件事件处理函数的中继函数	动态方法	Register
WMXXXXX	VCL Framework中处理特定窗口消息的函数	动态方法	Register
CMXXXX	VCLFramework中处理特定VCL定义的消息的函数	动态方法	Register
Button1Click	所有VCL组件的事件处理函数（Event Handler）	动态方法	Register

34、TApplication类

每一个Delphi的Windows应用程序在主程序中都会引用Forms程序单元，Forms程序单元则会引用Controls程序单元。在Controls程序单元被加载时它的intialization程序区块会被自动地执行，而在initialization程序区块中调用了InitControls函数： unit controls; … initialization NewStyleControls := Lo(GetVersion) >= 4; InitControls; … procedure InitControls; var UserHandle: HMODULE; begin WindowAtomString := Format('Delphi%.8X',[GetCurrentProcessID]); WindowAtom := GlobalAddAtom(PChar(WindowAtomString)); ControlAtomString := Format('ControlOfs%.8X%.8X', [HInstance, GetCurrentThreadID]); ControlAtom := GlobalAddAtom(PChar(ControlAtomString)); RM_GetObjectInstance := RegisterWindowMessage(PChar(ControlAtomString)); CanvasList := TThreadList.Create; InitIMM32; Mouse := TMouse.Create; Screen := TScreen.Create(nil); Application := TApplication.Create(nil); Application.ShowHint := True; RegisterIntegerConsts(TypeInfo(TCursor), IdentToCursor, CursorToIdent); UserHandle := GetModuleHandle('USER32'); if UserHandle <> 0 then @AnimateWindowProc := GetProcAddress(UserHandle, 'AnimateWindow'); end; TApplication = class(TComponent) end; 标准的Windows程序：改写成： begin Application.initialize; Application.createMainWindow; Application.createform(TForm1,form1); while Application.GetMessage(@AMessage,0,0,0) do begin Application.TranslateMessage(AMessage); Application.DispatchMessage(Amessage); end; end. procedure TApplication.CreateHandle; var TempClass: TWndClass; SysMenu: HMenu; begin if not FHandleCreated and not IsConsole then then begin FObjectInstance := Classes.MakeObjectInstance(WndProc); WindowClass.lpfnWndProc := @DefWindowProc; if not GetClassInfo(HInstance, WindowClass.lpszClassName, TempClass) then begin WindowClass.hInstance := HInstance; if Windows.RegisterClass(WindowClass) = 0 then raise EOutOfResources.Create(SWindowClass); end; FHandle := CreateWindow(WindowClass.lpszClassName, PChar(FTitle), WS_POPUP or WS_CAPTION or WS_CLIPSIBLINGS or WS_SYSMENU or WS_MINIMIZEBOX, GetSystemMetrics(SM_CXSCREEN) div 2, GetSystemMetrics(SM_CYSCREEN) div 2, 0, 0, 0, 0, HInstance, nil); FTitle := ''; FHandleCreated := True; SetWindowLong(FHandle, GWL_WNDPROC, Longint(FObjectInstance)); //重新设置回调函数。 if NewStyleControls then begin SendMessage(FHandle, WM_SETICON, 1, GetIconHandle); SetClassLong(FHandle, GCL_HICON, GetIconHandle); end; SysMenu := GetSystemMenu(FHandle, False); DeleteMenu(SysMenu, SC_MAXIMIZE, MF_BYCOMMAND); DeleteMenu(SysMenu, SC_SIZE, MF_BYCOMMAND); if NewStyleControls then DeleteMenu(SysMenu, SC_MOVE, MF_BYCOMMAND); end; end; 负责分配消息： procedure TApplication.WndProc(var Message: TMessage); type TInitTestLibrary = function(Size: DWord; PAutoClassInfo: Pointer): Boolean; stdcall; var I: Integer; SaveFocus, TopWindow: HWnd; InitTestLibrary: TInitTestLibrary; procedure Default; begin with Message do Result := DefWindowProc(FHandle, Msg, WParam, LParam); end; procedure DrawAppIcon; var DC: HDC; PS: TPaintStruct; begin with Message do begin DC := BeginPaint(FHandle, PS); DrawIcon(DC, 0, 0, GetIconHandle); EndPaint(FHandle, PS); end; end; begin try Message.Result := 0; for I := 0 to FWindowHooks.Count - 1 do if TWindowHook(FWindowHooks[I]^)(Message) then Exit; CheckIniChange(Message); with Message do case Msg of WM_SYSCOMMAND: case WParam and $FFF0 of SC_MINIMIZE: Minimize; SC_RESTORE: Restore; else Default; end; WM_CLOSE: if MainForm <> nil then MainForm.Close; WM_PAINT: if IsIconic(FHandle) then DrawAppIcon else Default; WM_ERASEBKGND: begin Message.Msg := WM_ICONERASEBKGND; Default; end; WM_QUERYDRAGICON: Result := GetIconHandle; WM_SETFOCUS: begin PostMessage(FHandle, CM_ENTER, 0, 0); Default; end; WM_ACTIVATEAPP: begin Default; FActive := TWMActivateApp(Message).Active; if TWMActivateApp(Message).Active then begin RestoreTopMosts; PostMessage(FHandle, CM_ACTIVATE, 0, 0) end else begin NormalizeTopMosts; PostMessage(FHandle, CM_DEACTIVATE, 0, 0); end; end; WM_ENABLE: if TWMEnable(Message).Enabled then begin RestoreTopMosts; if FWindowList <> nil then begin EnableTaskWindows(FWindowList); FWindowList := nil; end; Default; end else begin Default; if FWindowList = nil then FWindowList := DisableTaskWindows(Handle); NormalizeAllTopMosts; end; WM_CTLCOLORMSGBOX..WM_CTLCOLORSTATIC: Result := SendMessage(LParam, CN_BASE + Msg, WParam, LParam); WM_ENDSESSION: if TWMEndSession(Message).EndSession then FTerminate := True; WM_COPYDATA: if (PCopyDataStruct(Message.lParam)^.dwData = DWORD($DE534454)) and (FAllowTesting) then if FTestLib = 0 then begin {$IFDEF MSWINDOWS} FTestLib := SafeLoadLibrary('vcltest3.dll'); {$ENDIF} if FTestLib <> 0 then begin Result := 0; @InitTestLibrary := GetProcAddress(FTestLib, 'RegisterAutomation'); if @InitTestLibrary <> nil then InitTestLibrary(PCopyDataStruct(Message.lParam)^.cbData, PCopyDataStruct(Message.lParam)^.lpData); end else begin Result := GetLastError; FTestLib := 0; end; end else Result := 0; CM_ACTIONEXECUTE, CM_ACTIONUPDATE: Message.Result := Ord(DispatchAction(Message.Msg, TBasicAction(Message.LParam))); CM_APPKEYDOWN: if IsShortCut(TWMKey(Message)) then Result := 1; CM_APPSYSCOMMAND: if MainForm <> nil then with MainForm do if (Handle <> 0) and IsWindowEnabled(Handle) and IsWindowVisible(Handle) then begin FocusMessages := False; SaveFocus := GetFocus; Windows.SetFocus(Handle); Perform(WM_SYSCOMMAND, WParam, LParam); Windows.SetFocus(SaveFocus); FocusMessages := True; Result := 1; end; CM_ACTIVATE: if Assigned(FOnActivate) then FOnActivate(Self); CM_DEACTIVATE: if Assigned(FOnDeactivate) then FOnDeactivate(Self); //和方法相关联和VCL的处理事件相结合 CM_ENTER: if not IsIconic(FHandle) and (GetFocus = FHandle) then begin TopWindow := FindTopMostWindow(0); if TopWindow <> 0 then Windows.SetFocus(TopWindow); end; WM_HELP, // MessageBox(... MB_HELP) CM_INVOKEHELP: InvokeHelp(WParam, LParam); CM_WINDOWHOOK: if wParam = 0 then HookMainWindow(TWindowHook(Pointer(LParam)^)) else UnhookMainWindow(TWindowHook(Pointer(LParam)^)); CM_DIALOGHANDLE: if wParam = 1 then Result := FDialogHandle else FDialogHandle := lParam; WM_SETTINGCHANGE: begin Mouse.SettingChanged(wParam); SettingChange(TWMSettingChange(Message)); Default; end; WM_FONTCHANGE: begin Screen.ResetFonts; Default; end; WM_THEMECHANGED: if ThemeServices.ThemesEnabled then ThemeServices.ApplyThemeChange; WM_NULL: CheckSynchronize; else Default; end; except HandleException(Self); end; end; RUN的工作原理： procedure TApplication.Run; begin FRunning := True; try AddExitProc(DoneApplication); if FMainForm <> nil then begin case CmdShow of SW_SHOWMINNOACTIVE: FMainForm.FWindowState := wsMinimized; SW_SHOWMAXIMIZED: MainForm.WindowState := wsMaximized; end; if FShowMainForm then if FMainForm.FWindowState = wsMinimized then Minimize else FMainForm.Visible := True; repeat try HandleMessage; except HandleException(Self); end; until Terminated; end; finally FRunning := False; end; end; procedure TApplication.HandleMessage; var Msg: TMsg; begin if not ProcessMessage(Msg) then Idle(Msg); end; function TApplication.ProcessMessage(var Msg: TMsg): Boolean; var Handled: Boolean; begin Result := False; if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then begin Result := True; if Msg.Message <> WM_QUIT then begin Handled := False; if Assigned(FOnMessage) then FOnMessage(Msg, Handled); if not IsHintMsg(Msg) and not Handled and not IsMDIMsg(Msg) and not IsKeyMsg(Msg) and not IsDlgMsg(Msg) then begin TranslateMessage(Msg); DispatchMessage(Msg); end; end else FTerminate := True; end; end; TApplication的秘密隐藏的窗口虽然是Delphi应用程序第一个创建的母窗口，但是真正提供Delphi应用程序可视化窗体动作功能的却是程序员设计的主窗体。