如何在Delphi中模拟下拉窗体?

如何创build一个使用Delphi的“下拉式”窗口?

除此之外的一切都是研究工作; 与答案无关。

研究努力

做一个适当的下拉式需要很多件小心的一起工作。 我假设人们不喜欢这个棘手的问题,而是我问了七个不同的问题。 每一个问题的一小部分。 接下来的一切都是我在解决这个看似简单的问题上的研究努力


请注意下拉窗口的定义特征:

在这里输入图像说明

  • 1.下拉菜单扩展到“所有者”窗口之外
  • 2. “所有者”窗口保持焦点; 下拉式从来没有窃取焦点
  • 3.下拉窗口有一个阴影

这是我在WinForms中询问的同一个问题的Delphi变体:

  • 如何模拟WinForms中的下拉窗口?

WinForms中的答案是使用ToolStripDropDown class 。 这是一个助手类,可以将任何forms变成下拉菜单。

让我们在Delphi中做

我将首先创build一个艳丽的下拉表单,作为例子:

在这里输入图像说明

接下来,我将放下一个button,这将是我点击使下拉菜单出现的东西:

在这里输入图像说明

最后,我会连线一些初始代码,以显示它需要在OnClick中的表单:

 procedure TForm3.Button1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var frmPopup: TfrmPopup; pt: TPoint; begin frmPopup := TfrmPopup.Create(Self); //Show the form just under, and right aligned, to this button pt := Self.ClientToScreen(Button1.BoundsRect.BottomRight); Dec(pt.X, frmPopup.ClientWidth); frmPopup.Show(Self, Self.Handle, pt); end; 

编辑 :将其更改为MouseDown而不是Click 。 点击不正确,因为显示的下拉列表不需要点击。 其中一个未解决的问题是,如果用户再次按下鼠标button,如何隐藏下拉菜单。 但是,我们会留给那个回答问题的人来解决。 这个问题的一切都是研究工作,而不是一个解决scheme。

我们离开了:

在这里输入图像说明

现在该怎么做正确的方法?

我们马上注意到的第一件事是缺less阴影。 这是因为我们需要应用CS_DROPSHADOW窗口风格:

 procedure TfrmPopup.CreateParams(var Params: TCreateParams); const CS_DROPSHADOW = $00020000; begin inherited CreateParams({var}Params); Params.WindowClass.Style := Params.WindowClass.Style or CS_DROPSHADOW; end; 

这解决了这个问题:

在这里输入图像说明

焦点窃取

下一个问题是调用.Show的popup导致它窃取焦点(应用程序的标题栏指出它已经失去了焦点)。 塞尔特克解决这个问题。

  • 当popup窗口收到WM_Activate消息,表明它正在接收焦点(即Lo(wParam) <> WA_INACTIVE ):
  • 发送父窗体一个WM_NCActivate (True,-1)来表明它应该绘制自己像它仍然有焦点

我们处理WM_Activate

 protected procedure WMActivate(var Msg: TWMActivate); message WM_ACTIVATE; 

并执行:

 procedure TfrmPopup.WMActivate(var Msg: TWMActivate); begin //if we are being activated, then give pretend activation state back to our owner if (Msg.Active <> WA_INACTIVE) then SendMessage(Self.PopupParent.Handle, WM_NCACTIVATE, WPARAM(True), -1); inherited; end; 

所以所有者窗口看起来仍然有焦点(谁知道这是否是正确的方式 – 它看起来像它仍然有焦点):

在这里输入图像说明

卷起

幸运的是,Sertac已经解决了用户点击时如何closures窗口的问题:

  • 当popup窗口收到WM_Activate消息表明它失去焦点(即Lo(wParam) = WA_INACTIVE ):
  • 发送所有者控制我们正在滚动的通知
  • 免费popup窗体

我们将其添加到我们现有的WM_Activate处理程序中:

 procedure TfrmPopup.WMActivate(var Msg: TWMActivate); begin //if we are being activated, then give pretend activation state back to our owner if (Msg.Active <> WA_INACTIVE) then SendMessage(Self.PopupParent.Handle, WM_NCACTIVATE, WPARAM(True), -1); inherited; //If we're being deactivated, then we need to rollup if Msg.Active = WA_INACTIVE then begin //TODO: Tell our owner that we've rolled up //Note: The parent should not be using rollup as the time to read the state of all controls in the popup. // Every time something in the popup changes, the drop-down should give that inforamtion to the owner Self.Release; //use Release to let WMActivate complete end; end; 

滑动下拉菜单

下拉控件使用AnimateWindow向下滑动下拉菜单。 从微软自己的combo.c

 if (!(TEST_EffectPUSIF(PUSIF_COMBOBOXANIMATION)) || (GetAppCompatFlags2(VER40) & GACF2_ANIMATIONOFF)) { NtUserShowWindow(hwndList, SW_SHOWNA); } else { AnimateWindow(hwndList, CMS_QANIMATION, (fAnimPos ? AW_VER_POSITIVE : AW_VER_NEGATIVE) | AW_SLIDE); } 

在检查是否应该使用animation之后,他们使用AnimateWindow来显示窗口。 我们可以使用带SPI_GetComboBoxAnimation的 SystemParametersInfo

确定是否启用combobox的滑动打开效果。 pvParam参数必须指向BOOLvariables,该variables在启用时接收TRUE ,在禁用时为FALSE

在我们新奉献的TfrmPopup.Show方法中,我们可以检查是否启用了客户区域animation ,并根据用户的喜好调用AnimateWindowShow

 procedure TfrmPopup.Show(Owner: TForm; NotificationParentWindow: HWND; PopupPosition: TPoint); var pt: TPoint; comboBoxAnimation: BOOL; begin FNotificationParentWnd := NotificationParentWindow; //We want the dropdown form "owned" by (ie not "parented" to) the OwnerWindow Self.Parent := nil; //the default anyway; but just to reinforce the idea Self.PopupParent := Owner; //Owner means the Win32 concept of owner (ie always on top of, cf Parent, which means clipped child of) Self.PopupMode := pmExplicit; //explicitely owned by the owner //Show the form just under, and right aligned, to this button Self.BorderStyle := bsNone; Self.Position := poDesigned; Self.Left := PopupPosition.X; Self.Top := PopupPosition.Y; if not Winapi.Windows.SystemParametersInfo(SPI_GETCOMBOBOXANIMATION, 0, @comboBoxAnimation, 0) then comboBoxAnimation := False; if comboBoxAnimation then begin //200ms is the shell animation duration AnimateWindow(Self.Handle, 200, AW_VER_POSITIVE or AW_SLIDE or AW_ACTIVATE); end else inherited Show; end; 

编辑 :原来有SPI_GETCOMBOBOXANIMATION应该可能使用SPI_GETCLIENTAREAANIMATION 。 哪些指向隐藏在微妙的“如何模拟下拉”背后的难度的深处。 模拟一个下拉菜单需要很多东西。

问题是,如果你试图在后面使用ShowWindowAnimateWindow ,那么Delphi就会死亡。

在这里输入图像说明

如何解决?

微软自己也使用以下方法也很奇怪:

  • ShowWindow(..., SW_SHOWNOACTIVATE)
  • AnimateWindow(...) *(不含AW_ACTIVATE

显示没有激活的下拉列表框。 然后间谍与Spy ++的combobox,我可以看到WM_NCACTIVATE飞来飞去。

在过去,人们使用重复调用来模拟幻灯片窗口,从计时器中更改下拉窗体的Height 。 这不仅是不好的, 但它也改变了窗体的大小。 这个表格不是滑下来的,而是performance出来。 您可以看到所有控件在下拉菜单中都会更改其布局。 不,下拉式表格仍然是真实的大小,但滑落是在这里想要的。

我知道AnimateWindow和Delphi从来没有过。 这个问题在Stackoverflow到达之前已经被问及了很多。 我在2005年甚至在新闻组上提过。 但这不能阻止我再次问。

animation后,我试图强制我的表单重绘:

 AnimateWindow(Self.Handle, 200, AW_VER_POSITIVE or AW_SLIDE or AW_ACTIVATE); Self.Repaint; Self.Update; Self.Invalidate; 

但是这是行不通的。 它只是坐在那里嘲笑我:

在这里输入图像说明

现在再次显示,当我想特写

如果一个combobox下降,并且用户试图在button上的MouseDown ,真正的Windowscombobox控件不会再简单地显示该控件,而是隐藏它:

在这里输入图像说明

该下拉菜单也知道它是“下降” ,这是很有用的,这样它就可以像“下降”模式一样绘制自己。 我们需要的是一种知道下拉下降的方法,以及知道下拉不再下降的方法。 某种布尔variables:

 private FDroppedDown: Boolean; 

在我看来,我们需要告诉主机,我们正在closures( 即失去激活 )。 主机然后需要负责销毁popup窗口。 (主机不能负责销毁popup窗口,导致无法解决的竞争条件) 。 所以我创build一个消息来通知所有者,我们正在closures:

 const WM_PopupFormCloseUp = WM_APP+89; 

注意 :我不知道人们如何避免消息常量冲突(特别是因为CM_BASE以$ B000开始,CN_BASE以$ BC00开始)。

基于Sertac的激活/closures程序:

 procedure TfrmPopup.WMActivate(var Msg: TWMActivate); begin //if we are being activated, then give pretend activation state back to our owner if (Msg.Active <> WA_INACTIVE) then SendMessage(Self.PopupParent.Handle, WM_NCACTIVATE, WPARAM(True), -1); inherited; //If we're being deactivated, then we need to rollup if Msg.Active = WA_INACTIVE then begin //DONE: Tell our owner that we've rolled up //Note: We must post the message. If it is Sent, the owner //will get the CloseUp notification before the MouseDown that //started all this. When the MouseDown comes, they will think //they were not dropped down, and drop down a new one. PostMessage(FNotificationParentWnd, WM_PopupFormCloseUp, 0, 0); Self.Release; //use release to give WM_Activate a chance to return end; end; 

然后,我们必须更改我们的MouseDown代码,以了解下拉列表仍然存在:

 procedure TForm3.Edit1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var frmPopup: TfrmPopup; pt: TPoint; begin //If we (were) dropped down, then don't drop-down again. //If they click us, pretend they are trying to close the drop-down rather than open a second copy if FDroppedDown then begin //And since we're receiving mouse input, we by defintion must have focus. //and since the drop-down self-destructs when it loses activation, //it can no longer be dropped down (since it no longer exists) Exit; end; frmPopup := TfrmPopup.Create(Self); //Show the form just under, and right aligned, to this button pt := Self.ClientToScreen(Edit1.BoundsRect.BottomRight); Dec(pt.X, frmPopup.ClientWidth); frmPopup.Show(Self, Self.Handle, pt); FDroppedDown := True; end; 

而我认为就是这样

除了AnimateWindow难题,我可能已经能够利用我的研究成果来解决我所能想到的所有问题:

在Delphi中模拟一个下拉式表单

当然,这可能都是徒劳的。 可能会发现有一个VCL函数:

 TComboBoxHelper = class; public class procedure ShowDropDownForm(...); end; 

在这种情况下,这将是正确的答案。

Solutions Collecting From Web of "如何在Delphi中模拟下拉窗体?"

procedure TForm3.Button1Click(Sender: TObject);底部的procedure TForm3.Button1Click(Sender: TObject); 你叫frmPopup.Show; 改为ShowWindow(frmPopup.Handle, SW_SHOWNOACTIVATE); 之后你需要调用frmPopup.Visible := True; 否则表单上的组件将不会显示

所以新的程序看起来像这样:

 uses frmPopupU; procedure TForm3.Button1Click(Sender: TObject); var frmPopup: TfrmPopup; pt: TPoint; begin frmPopup := TfrmPopup.Create(Self); frmPopup.BorderStyle := bsNone; //We want the dropdown form "owned", but not "parented" to us frmPopup.Parent := nil; //the default anyway; but just to reinforce the idea frmPopup.PopupParent := Self; //Show the form just under, and right aligned, to this button frmPopup.Position := poDesigned; pt := Self.ClientToScreen(Button1.BoundsRect.BottomRight); Dec(pt.X, frmPopup.ClientWidth); frmPopup.Left := pt.X; frmPopup.Top := pt.Y; // frmPopup.Show; ShowWindow(frmPopup.Handle, SW_SHOWNOACTIVATE); //Else the components on the form won't show frmPopup.Visible := True; end; 

但这不会阻止你弹出焦点。 为了防止这种情况,您需要在弹出窗体中覆盖WM_MOUSEACTIVATE事件

 type TfrmPopup = class(TForm) ... procedure WMMouseActivate(var Message: TWMMouseActivate); message WM_MOUSEACTIVATE; ... end; 

并执行

 procedure TfrmPopup.WMMouseActivate(var Message: TWMMouseActivate); begin Message.Result := MA_NOACTIVATE; end; 

我决定和你的弹出窗口一起玩:我添加的第一件事是一个关闭按钮。 只是一个简单的TButton在其onCLick事件中调用Close:

 procedure TfrmPopup.Button1Click(Sender: TObject); begin Close; end; 

但是,这只会隐藏窗体,为了释放它,我添加了一个OnFormClose事件:

 procedure TfrmPopup.FormClose(Sender: TObject; var Action: TCloseAction); begin Action := caFree; end; 

最后我觉得添加一个调整大小的函数会很有趣

我通过覆盖WM_NCHITTEST消息来做到这一点:

 procedure TfrmPopup.WMNCHitTest(var Message: TWMNCHitTest); const EDGEDETECT = 7; //adjust to suit yourself var deltaRect: TRect; //not really used as a rect, just a convenient structure begin inherited; with Message, deltaRect do begin Left := XPos - BoundsRect.Left; Right := BoundsRect.Right - XPos; Top := YPos - BoundsRect.Top; Bottom := BoundsRect.Bottom - YPos; if (Top < EDGEDETECT) and (Left < EDGEDETECT) then Result := HTTOPLEFT else if (Top < EDGEDETECT) and (Right < EDGEDETECT) then Result := HTTOPRIGHT else if (Bottom < EDGEDETECT) and (Left < EDGEDETECT) then Result := HTBOTTOMLEFT else if (Bottom < EDGEDETECT) and (Right < EDGEDETECT) then Result := HTBOTTOMRIGHT else if (Top < EDGEDETECT) then Result := HTTOP else if (Left < EDGEDETECT) then Result := HTLEFT else if (Bottom < EDGEDETECT) then Result := HTBOTTOM else if (Right < EDGEDETECT) then Result := HTRIGHT; end; end; 

所以最后,我已经结束了这个:

 unit frmPopupU; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TfrmPopup = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormCreate(Sender: TObject); private procedure WMMouseActivate(var Message: TWMMouseActivate); message WM_MOUSEACTIVATE; procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST; public procedure CreateParams(var Params: TCreateParams); override; end; implementation {$R *.dfm} { TfrmPopup } procedure TfrmPopup.Button1Click(Sender: TObject); begin Close; end; procedure TfrmPopup.CreateParams(var Params: TCreateParams); const CS_DROPSHADOW = $00020000; begin inherited CreateParams({var}Params); Params.WindowClass.Style := Params.WindowClass.Style or CS_DROPSHADOW; end; procedure TfrmPopup.FormClose(Sender: TObject; var Action: TCloseAction); begin Action := caFree; end; procedure TfrmPopup.FormCreate(Sender: TObject); begin DoubleBuffered := true; BorderStyle := bsNone; end; procedure TfrmPopup.WMMouseActivate(var Message: TWMMouseActivate); begin Message.Result := MA_NOACTIVATE; end; procedure TfrmPopup.WMNCHitTest(var Message: TWMNCHitTest); const EDGEDETECT = 7; //adjust to suit yourself var deltaRect: TRect; //not really used as a rect, just a convenient structure begin inherited; with Message, deltaRect do begin Left := XPos - BoundsRect.Left; Right := BoundsRect.Right - XPos; Top := YPos - BoundsRect.Top; Bottom := BoundsRect.Bottom - YPos; if (Top < EDGEDETECT) and (Left < EDGEDETECT) then Result := HTTOPLEFT else if (Top < EDGEDETECT) and (Right < EDGEDETECT) then Result := HTTOPRIGHT else if (Bottom < EDGEDETECT) and (Left < EDGEDETECT) then Result := HTBOTTOMLEFT else if (Bottom < EDGEDETECT) and (Right < EDGEDETECT) then Result := HTBOTTOMRIGHT else if (Top < EDGEDETECT) then Result := HTTOP else if (Left < EDGEDETECT) then Result := HTLEFT else if (Bottom < EDGEDETECT) then Result := HTBOTTOM else if (Right < EDGEDETECT) then Result := HTRIGHT; end; end; end. 

希望你能使用它。

完整和功能性的代码

以下单元仅在Delphi 5中进行了测试(模拟对PopupParent支持)。 但除此之外,它完成了一个下拉式的需求。 Sertac解决了AnimateWindow问题。

 unit DropDownForm; { A drop-down style form. Sample Usage ================= procedure TForm1.SpeedButton1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var pt: TPoint; begin if FPopup = nil then FPopup := TfrmOverdueReportsPopup.Create(Self); if FPopup.DroppedDown then //don't drop-down again if we're already showing it Exit; pt := Self.ClientToScreen(SmartSpeedButton1.BoundsRect.BottomRight); Dec(pt.X, FPopup.Width); FPopup.ShowDropdown(Self, pt); end; Simply make a form descend from TDropDownForm. Change: type TfrmOverdueReportsPopup = class(TForm) to: uses DropDownForm; type TfrmOverdueReportsPopup = class(TDropDownForm) } interface uses Forms, Messages, Classes, Controls, Windows; const WM_PopupFormCloseUp = WM_USER+89; type TDropDownForm = class(TForm) private FOnCloseUp: TNotifyEvent; FPopupParent: TCustomForm; FResizable: Boolean; function GetDroppedDown: Boolean; {$IFNDEF SupportsPopupParent} procedure SetPopupParent(const Value: TCustomForm); {$ENDIF} protected procedure CreateParams(var Params: TCreateParams); override; procedure WMActivate(var Msg: TWMActivate); message WM_ACTIVATE; procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST; procedure DoCloseup; virtual; procedure WMPopupFormCloseUp(var Msg: TMessage); message WM_PopupFormCloseUp; {$IFNDEF SupportsPopupParent} property PopupParent: TCustomForm read FPopupParent write SetPopupParent; {$ENDIF} public constructor Create(AOwner: TComponent); override; procedure ShowDropdown(OwnerForm: TCustomForm; PopupPosition: TPoint); property DroppedDown: Boolean read GetDroppedDown; property Resizable: Boolean read FResizable write FResizable; property OnCloseUp: TNotifyEvent read FOnCloseUp write FOnCloseUp; end; implementation uses SysUtils; { TDropDownForm } constructor TDropDownForm.Create(AOwner: TComponent); begin inherited; Self.BorderStyle := bsNone; //get rid of our border right away, so the creator can measure us accurately FResizable := True; end; procedure TDropDownForm.CreateParams(var Params: TCreateParams); const SPI_GETDROPSHADOW = $1024; CS_DROPSHADOW = $00020000; var dropShadow: BOOL; begin inherited CreateParams({var}Params); //It's no longer documented (because Windows 2000 is no longer supported) //but use of CS_DROPSHADOW and SPI_GETDROPSHADOW are only supported on XP (5.1) or newer if (Win32MajorVersion > 5) or ((Win32MajorVersion = 5) and (Win32MinorVersion >= 1)) then begin //Use of a drop-shadow is controlled by a system preference if not Windows.SystemParametersInfo(SPI_GETDROPSHADOW, 0, @dropShadow, 0) then dropShadow := False; if dropShadow then Params.WindowClass.Style := Params.WindowClass.Style or CS_DROPSHADOW; end; {$IFNDEF SupportsPopupParent} //Delphi 5 support for "PopupParent" style form ownership if FPopupParent <> nil then Params.WndParent := FPopupParent.Handle; {$ENDIF} end; procedure TDropDownForm.DoCloseup; begin if Assigned(FOnCloseUp) then FOnCloseUp(Self); end; function TDropDownForm.GetDroppedDown: Boolean; begin Result := (Self.Visible); end; {$IFNDEF SupportsPopupParent} procedure TDropDownForm.SetPopupParent(const Value: TCustomForm); begin FPopupParent := Value; end; {$ENDIF} procedure TDropDownForm.ShowDropdown(OwnerForm: TCustomForm; PopupPosition: TPoint); var comboBoxAnimation: BOOL; i: Integer; const AnimationDuration = 200; //200 ms begin //We want the dropdown form "owned" by (ie not "parented" to) the OwnerForm Self.Parent := nil; //the default anyway; but just to reinforce the idea Self.PopupParent := OwnerForm; //Owner means the Win32 concept of owner (ie always on top of, cf Parent, which means clipped child of) {$IFDEF SupportsPopupParent} Self.PopupMode := pmExplicit; //explicitely owned by the owner {$ENDIF} //Show the form just under, and right aligned, to this button // Self.BorderStyle := bsNone; moved to during FormCreate; so can creator can know our width for measurements Self.Position := poDesigned; Self.Left := PopupPosition.X; Self.Top := PopupPosition.Y; //Use of drop-down animation is controlled by preference if not Windows.SystemParametersInfo(SPI_GETCOMBOBOXANIMATION, 0, @comboBoxAnimation, 0) then comboBoxAnimation := False; if comboBoxAnimation then begin //Delphi doesn't react well to having a form show behind its back (eg ShowWindow, AnimateWindow). //Force Delphi to create all the WinControls so that they will exist when the form is shown. for i := 0 to ControlCount - 1 do begin if Controls[i] is TWinControl and Controls[i].Visible and not TWinControl(Controls[i]).HandleAllocated then begin TWinControl(Controls[i]).HandleNeeded; SetWindowPos(TWinControl(Controls[i]).Handle, 0, 0, 0, 0, 0, SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_SHOWWINDOW); end; end; AnimateWindow(Self.Handle, AnimationDuration, AW_VER_POSITIVE or AW_SLIDE or AW_ACTIVATE); Visible := True; // synch VCL end else inherited Show; end; procedure TDropDownForm.WMActivate(var Msg: TWMActivate); begin //If we are being activated, then give pretend activation state back to our owner if (Msg.Active <> WA_INACTIVE) then SendMessage(Self.PopupParent.Handle, WM_NCACTIVATE, WPARAM(True), -1); inherited; //If we're being deactivated, then we need to rollup if Msg.Active = WA_INACTIVE then begin { Post a message (not Send a message) to oursleves that we're closing up. This gives a chance for the mouse/keyboard event that triggered the closeup to believe the drop-down is still dropped down. This is intentional, so that the person dropping it down knows not to drop it down again. They want clicking the button while is was dropped to hide it. But in order to hide it, it must still be dropped down. } PostMessage(Self.Handle, WM_PopupFormCloseUp, WPARAM(Self), LPARAM(0)); end; end; procedure TDropDownForm.WMNCHitTest(var Message: TWMNCHitTest); var deltaRect: TRect; //not really used as a rect, just a convenient structure cx, cy: Integer; begin inherited; if not Self.Resizable then Exit; //The sizable border is a preference cx := GetSystemMetrics(SM_CXSIZEFRAME); cy := GetSystemMetrics(SM_CYSIZEFRAME); with Message, deltaRect do begin Left := XPos - BoundsRect.Left; Right := BoundsRect.Right - XPos; Top := YPos - BoundsRect.Top; Bottom := BoundsRect.Bottom - YPos; if (Top < cy) and (Left < cx) then Result := HTTOPLEFT else if (Top < cy) and (Right < cx) then Result := HTTOPRIGHT else if (Bottom < cy) and (Left < cx) then Result := HTBOTTOMLEFT else if (Bottom < cy) and (Right < cx) then Result := HTBOTTOMRIGHT else if (Top < cy) then Result := HTTOP else if (Left < cx) then Result := HTLEFT else if (Bottom < cy) then Result := HTBOTTOM else if (Right < cx) then Result := HTRIGHT; end; end; procedure TDropDownForm.WMPopupFormCloseUp(var Msg: TMessage); begin //This message gets posted to us. //Now it's time to actually closeup. Self.Hide; DoCloseup; //raise the OnCloseup event *after* we're actually hidden end; end. 

如何创建一个使用Delphi的“下拉式”窗口?

你把所有你已经总结的零碎放在一起,没有一个VCL类/函数会产生一个下拉式的表单。

在你的研究中有几点要提到。

首先,你把激活与焦点混淆起来。 当另一个窗口弹出时,焦点不会保存在调用窗体中,激活是 – 或者似乎是这样。 焦点是键盘输入的地方,显然是在弹出/放下的窗口或在它的控制。

AnimateWindow没有显示控件的问题在于,VCL不会创建TWinControl的底层本机(OS)控件,直到有必要为止(非wincontrols不是问题)。 就VCL而言,创建它们通常是必需的,直到它们可见为止,也就是当你将窗体的Visible设置为true(或称为Show )时,这是不可能的,除非当然,否则将不会有动画你在动画之后设置visible

当您尝试刷新您的表单时,这也是缺少的要求:

 AnimateWindow(Self.Handle, 200, AW_VER_POSITIVE or AW_SLIDE or AW_ACTIVATE); Self.Repaint; Self.Update; Self.Invalidate; 

请注意,在上面的问题中,没有一个调用失败。 但是没有什么可以绘画的,这个形式甚至不是visible

任何强制控件创建并使其可见的手段都会使您的动画变得活灵活现。

 ... if comboBoxAnimation then begin for i := 0 to ControlCount - 1 do if Controls[i] is TWinControl and Controls[i].Visible and not TWinControl(Controls[i]).HandleAllocated then begin TWinControl(Controls[i]).HandleNeeded; SetWindowPos(TWinControl(Controls[i]).Handle, 0, 0, 0, 0, 0, SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_SHOWWINDOW); end; AnimateWindow(Handle, 200, AW_VER_POSITIVE or AW_SLIDE or AW_ACTIVATE); Visible := True; // synch VCL end else ... 

这只是一个例子,显示屏幕外的形式或任何其他创造性的方法可以同样工作。 在这个答案中 ,我通过设置动画形式的高度为'0',然后将visible设置为true(我喜欢这个答案中的方法,尽管..)。

对于表单已经被删除的情况下再次丢弃,您不必为此调用表单发送消息。 其实不这样做,这就需要不必要的合作。 将只有一个实例被删除,所以你可以使用全局:

  TfrmPopup = class(TForm) ... procedure FormDestroy(Sender: TObject); private FNotificationParentWnd: HWND; class var FDroppedDown: Boolean; protected ... procedure TfrmPopup.Show(Owner: TForm; NotificationParentWindow: HWND; ... if not FDroppedDown then begin if comboBoxAnimation then begin // animate as above Visible := True; // synch with VCL FDroppedDown := True; end else inherited Show; end; end; procedure TfrmPopup.FormDestroy(Sender: TObject); begin FDroppedDown := False; end;