TWinControl = class(TControl)
property ParentWindow: HWnd read FParentWindow write SetParentWindow;
// 注意它的参数是windoows句柄,而不是Win控件,适合于那些不需要父控件管理内存释放的子控件
// 哲学,这个函数极少被用到(它是Delphi的写属性),只有菜单,ActiveX,THintWindow,TOpenPictureDialog,TOleForm和TShadowWindow用到
// important 重点是,研究一下,它与SetParent有什么区别就知道了:不加入父控件的子控件列表。而且此函数的参数是一个Windows句柄,不是Win控件
constructor CreateParented(ParentWindow: HWnd); // 创建一个没有Parent的Windows控件,只有ActiveX里有一处调用
class function CreateParentedControl(ParentWindow: HWnd): TWinControl; // 搜遍所有VCL源代码,它从未被使用
// 另外还想到一点:之所以这样做,也许为了让Application专门管理所有TForm的实例,别的Windows句柄可以挂载到Application.Handle,但不允许让别的Win控件挂载到Application(待验证)
function TWinControl.GetParentHandle: HWnd; begin if Parent <> nil then // important 优先使用Parent属性,然后再检查ParentWindow属性 Result := Parent.Handle else Result := ParentWindow; // 类函数,没有句柄会在这个函数里申请 end; function TWinControl.GetTopParentHandle: HWnd; var C: TWinControl; begin C := Self; while C.Parent <> nil do C := C.Parent; Result := C.ParentWindow; if Result = 0 then Result := C.Handle; end; procedure TWinControl.SetFocus; var Parent: TCustomForm; begin Parent := GetParentForm(Self); if Parent <> nil then Parent.FocusControl(Self) // Form类函数,让Form来设置键盘焦点 else if ParentWindow <> 0 then Windows.SetFocus(Handle) // API,为了避免混淆函数名,加上了单元名 else ValidParentForm(Self); // 全局函数 end; constructor TWinControl.CreateParented(ParentWindow: HWnd); begin // Creates and initializes a control as the child of a specified non-VCL container. // Call CreateParented to embed a new control in a non-VCL parent window. // TActiveXControl objects call CreateParented to create an ActiveX control as a child of the host application's client site window. // 外部传入句柄后,不重新创建,但覆盖属性(没彻底搞清楚) FParentWindow := ParentWindow; // 给类实例添加句柄后重新创建?这里不是Delphi属性赋值,不会引起连锁反应 Create(nil); // fixme 貌似把之前的许多属性给弄没了,重新创建并赋值一份。这样调用构造函数,有意思。 end; class function TWinControl.CreateParentedControl(ParentWindow: HWnd): TWinControl; begin // 外部传入句柄后,重新创建 // 类函数,所以完全重新创建一个类实例,并返回这个类实例 Result := TWinControl(NewInstance); // 有实例(内存)不一定有句柄,仍需要外部传入 Result.FParentWindow := ParentWindow; Result.Create(nil); end;
最关键的函数:
procedure TWinControl.SetParentWindow(Value: HWnd); begin // 哲学,这个函数极少被用到(它是Delphi的写属性),只有菜单,ActiveX,THintWindow,TOpenPictureDialog,TOleForm和TShadowWindow用到 // important 重点是,研究一下,它与SetParent有什么区别就知道了:不加入父控件的子控件列表。而且此函数的参数是一个Windows句柄,不是Win控件 // 只有在Parent等于空的情况才使用 if (FParent = nil) and (FParentWindow <> Value) then begin // fixme 不清楚各种控件是如何使用这个函数的 // 当前句柄不为空,当前父窗口不为空,传来新的值要进行更换 if (FHandle <> 0) and (FParentWindow <> 0) and (Value <> 0) then begin // 简单更换父句柄 FParentWindow := Value; // 简单赋值,因为是变量,不是Delphi属性,不会引起连锁反应 Windows.SetParent(FHandle, Value); // API // 通知一下 if (Win32MajorVersion >= 5) and (Win32Platform = VER_PLATFORM_WIN32_NT) then Perform(WM_CHANGEUISTATE, MakeWParam(UIS_INITIALIZE, UISF_HIDEACCEL or UISF_HIDEFOCUS), 0); end // 如果Fhandle等于0,FParentWindow等于0(不可能,因为有外部if语句控制),或者Value=0(关键是这句,一旦新值是0,就要销毁句柄),就会执行: else begin DestroyHandle; // 区别就在这句 FParentWindow := Value; // 简单赋值,因为是变量,不是Delphi属性,不会引起连锁反应 end; // 最后都要更新状态 UpdateControlState; // 更新状态,没有句柄就会申请句柄(销毁后,马上申请新的句柄) end; end;
使用ParentWindow的所有代码都在这里了(这里没有列出ActiveX里的情况,因为实在太特殊,也很少用到):
procedure THintWindow.ActivateHint(Rect: TRect; const AHint: string); type TAnimationStyle = (atSlideNeg, atSlidePos, atBlend); const AnimationStyle: array[TAnimationStyle] of Integer = (AW_VER_NEGATIVE, AW_VER_POSITIVE, AW_BLEND); var Animate: BOOL; Style: TAnimationStyle; begin FActivating := True; try Caption := AHint; Inc(Rect.Bottom, 4); UpdateBoundsRect(Rect); if Rect.Top + Height > Screen.DesktopHeight then Rect.Top := Screen.DesktopHeight - Height; if Rect.Left + Width > Screen.DesktopWidth then Rect.Left := Screen.DesktopWidth - Width; if Rect.Left < Screen.DesktopLeft then Rect.Left := Screen.DesktopLeft; if Rect.Bottom < Screen.DesktopTop then Rect.Bottom := Screen.DesktopTop; SetWindowPos(Handle, HWND_TOPMOST, Rect.Left, Rect.Top, Width, Height, SWP_NOACTIVATE); // API if (GetTickCount - FLastActive > 250) and (Length(AHint) < 100) and Assigned(AnimateWindowProc) then begin SystemParametersInfo(SPI_GETTOOLTIPANIMATION, 0, @Animate, 0); if Animate then begin SystemParametersInfo(SPI_GETTOOLTIPFADE, 0, @Animate, 0); if Animate then Style := atBlend else if Mouse.GetCursorPos.Y > Rect.Top then Style := atSlideNeg else Style := atSlidePos; AnimateWindowProc(Handle, 100, AnimationStyle[Style] or AW_SLIDE); end; end; ParentWindow := Application.Handle; // important 真是猛! ShowWindow(Handle, SW_SHOWNOACTIVATE); // API Invalidate; finally FLastActive := GetTickCount; FActivating := False; end; end; procedure TCustomActionPopupMenu.Popup(X, Y: Integer); begin if ItemCount = 0 then exit; ParentWindow := Application.Handle; FRootMenu := Self; if FindFirstVisibleItem = nil then Expand(False); SetBounds(X, Y, Width, Height); PersistentHotKeys := True; Visible := True; TrackMenu; end; constructor TShadowWindow.Create(AOwner: TComponent); begin inherited; Side := csRight; FDeskTop := TBitmap.Create; FDesktop.HandleType := bmDDB; FDesktop.PixelFormat := pf24bit; Hide; FCachedclr := 0; FCachedFade := 0; ParentWindow := Forms.Application.Handle; end; procedure TCustomActionBar.WMContextMenu(var Message: TWMContextMenu); var PopupMenu: TCustomActionPopupMenu; begin inherited; if Assigned(ActionClient) and (ActionClient.ContextItems.Count > 0) then begin PopupMenu := GetPopupMenuClass.Create(Owner) as TCustomActionPopupMenu; PopupMenu.ContextBar := True; PopupMenu.ParentWindow := Application.Handle; PopupMenu.Parent := Self; PopupMenu.ActionClient := ActionClient; PopupMenu.Popup(Message.XPos, Message.YPos); PopupMenu.Free; end; end; procedure TOpenPictureDialog.DoShow; var PreviewRect, StaticRect: TRect; begin { Set preview area to entire dialog } GetClientRect(Handle, PreviewRect); StaticRect := GetStaticRect; { Move preview area to right of static area } PreviewRect.Left := StaticRect.Left + (StaticRect.Right - StaticRect.Left); Inc(PreviewRect.Top, 4); FPicturePanel.BoundsRect := PreviewRect; FPreviewButton.Left := FPaintPanel.BoundsRect.Right - FPreviewButton.Width - 2; FImageCtrl.Picture := nil; FSavedFilename := ''; FPaintPanel.Caption := srNone; FPicturePanel.ParentWindow := Handle; inherited DoShow; end; function TOleForm.SetActiveObject(const ActiveObject: IOleInPlaceActiveObject; pszObjName: POleStr): HResult; var Window, ParentWindow: HWnd; begin Result := S_OK; FActiveObject := ActiveObject; if FActiveObject = nil then Exit; if FActiveObject.GetWindow(Window) = 0 then while True do begin ParentWindow := GetParent(Window); if ParentWindow = 0 then Break; if FindControl(ParentWindow) <> nil then begin SetWindowPos(Window, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE); Break; end; Window := ParentWindow; end; FSaveWidth := FForm.ClientWidth; FSaveHeight := FForm.ClientHeight; end;
---------------------------------------------------------------------------------------
而且还牵扯到了WM_CHANGEUISTATE消息,搜遍所有VCL源码,没有发现哪个控件响应此消息:
procedure TWinControl.UpdateUIState(CharCode: Word); var Form: TCustomForm; begin Form := GetParentForm(Self); // 全局函数 if Assigned(Form) then case CharCode of VK_LEFT..VK_DOWN, VK_TAB: Form.Perform(WM_CHANGEUISTATE, MakeLong(UIS_CLEAR, UISF_HIDEFOCUS), 0); VK_MENU: Form.Perform(WM_CHANGEUISTATE, MakeLong(UIS_CLEAR, UISF_HIDEACCEL), 0); end; end;
就此打个伏笔,也许将来哪天会用到~