娃娃鸭深入核心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应用程序可视化窗体动作功能的却是程序员设计的主窗体。