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;
就此打个伏笔,也许将来哪天会用到~