如何在Delphi中模拟下拉式表单？

本文介绍了如何在Delphi中模拟下拉式表单？的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！ 问题描述 29岁程序员，3月因学历无情被辞！ 如何使用Delphi创建一个下拉窗口？ 除此之外，一切都是研究工作;而且与答案无关。 研究努力 做出正确的下拉菜单需要很多件精心合作。我假设人们不喜欢这个困难的问题，宁愿问七个问题，每一个都解决了一个小问题。以下的一切都是我的研究工作来解决这个简单易懂的问题。 注意定义一个下拉窗口的特征： 1。下拉菜单扩展到它的所有者窗口 2。 所有者窗口保持焦点; 3。下拉列表中有一个阴影 这是我在WinForms中提到的相同问题的Delphi变体： 消息，指示它正在接收焦点（即 Lo（wParam）<> WA_INACTIVE ）： 发送父表单消息，表明它正在失去焦点（即 Lo（wParam）= WA_INACTIVE ）： 发送所有者控制权我们正在滚动的通知 释放弹出窗体 我们将其添加到我们现有的 WM_Activate 处理程序中： procedure Tf rmPopup.WMActivate（var Msg：TWMActivate）; begin //如果我们被激活，然后将假装激活状态返回给我们的所有者 if（Msg.Active<> WA_INACTIVE）then SendMessage（Self。 PopupParent.Handle，WM_NCACTIVATE，WPARAM（True），-1）; 继承; //如果我们被停用，那么我们需要汇总如果Msg.Active = WA_INACTIVE然后 begin // TODO：告诉我们的所有者我们已经卷起 //注意：父进程不应该使用汇总来查看弹出窗口中所有控件的状态。 //每当弹出窗口中的某些内容发生变化时，下拉列表都会将该信息提供给所有者 Self.Release; //使用Release来让WMActivate完成 end; 结束 滑动下拉菜单 下拉式控制使用 AnimateWindow 向下滑动下拉菜单。从Microsoft自己的 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） } 在检查是否应使用动画后，他们使用 AnimateWindow 显示窗口。我们可以使用 SystemParametersInfo 与 SPI_GetComboBoxAnimation ：在我们新近奉承的 TfrmPopup.Show 方法中，我们可以检查客户端动画已启用，并根据用户的偏好调用 AnimateWindow 或显示 p> 程序TfrmPopup.Show（Owner：TForm; NotificationParentWindow：HWND; PopupPosition：TPoint）; var pt：TPoint; comboBoxAnimation：BOOL; begin FNotificationParentWnd：= NotificationParentWindow; //我们希望下载表单拥有（即不是父母）OwnerWindow Self.Parent：= nil; //默认;但只是为了加强这个想法 Self.PopupParent：= Owner; //所有者意味着所有者的Win32概念（即始终位于，父Parent，这意味着剪切的孩子） Self.PopupMode：= pmExplicit; //由主人明确拥有 //显示刚刚下的正确对齐的按钮 Self.BorderStyle：= bsNone; Self.Position：= poDesigned; Self.Left：= PopupPosition.X; Self.Top：= PopupPosition.Y; 如果不是Winapi.Windows.SystemParametersInfo（SPI_GETCOMBOBOXANIMATION，0，@comboBoxAnimation，0）然后 comboBoxAnimation：= False; 如果comboBoxAnimation然后开始 // 200ms是shell动画持续时间 AnimateWindow（Self.Handle，200，AW_VER_POSITIVE或AW_SLIDE或AW_ACTIVATE）; end else 继承显示; 结束 修改：结果是 SPI_GETCOMBOBOXANIMATION 应该可能使用超过 SPI_GETCLIENTAREAANIMATION 。哪些指向隐藏在微妙之后的深度难题如何模拟下拉。模拟一个下拉菜单需要很多东西。 问题是如果您尝试使用 ShowWindow 或 AnimateWindow 背后： 如何解决？ 也是奇怪的是，微软本身也使用： ShowWindow （...，SW_SHOWNOACTIVATE）或 AnimateWindow（...） *（without AW_ACTIVATE ） 显示下拉列表框激活。然后用间谍软件对ComboBox进行间谍，我可以看到 WM_NCACTIVATE 飞行。 在过去人们已经模拟了滑动窗口使用重复调用从定时器更改下拉式窗体的 Height 。这不但不好但它也会改变表单的大小。形式不断下滑，您可以看到所有控件更改其布局，因为下拉列表显示。不，下拉式表格仍然是真实的大小，但是下滑是这里想要的。 我知道 AnimateWindow 和Delphi从来没有过。而且问题已经被问到很多了，很久以前Stackoverflow到了。我甚至在2005年就新闻组询问。但是，这不能阻止我再次询问。 我动画后强制重新绘制表格： AnimateWindow（Self.Handle，200，AW_VER_POSITIVE或AW_SLIDE或AW_ACTIVATE）; Self.Repaint; Self.Update; Self.Invalidate; 但它不起作用;它只是坐在那里嘲笑我： 现在再次显示我想要特写 如果组合框被放下，用户尝试在按钮上 MouseDown ，真正的Windows ComboBox控件不会再次显示控件，而是隐藏它： 下拉列表也知道它是目前下拉，这是有用的，以便它可以自己绘制，就像它在下降模式。我们需要的是一种知道下拉菜单被删除的方式，并且知道下拉菜单不再被丢弃的方法。某种布尔变量： private FDroppedDown：Boolean; 在我看来，我们需要告诉主机我们关闭（即失去激活）。 主机然后需要负责销毁弹出窗口。 （主机不负责销毁弹出窗口，导致无法解决的竞争条件）。所以我创建一个消息通知所有者我们正在关闭： const WM_PopupFormCloseUp = WM_APP + 89; 注意：我不知道人们如何避免消息不断冲突（特别是因为 CM_BASE 从$ B000开始，$ code> CN_BASE 以$ BC00开始）。 基于Sertac的激活/停用例程： procedure TfrmPopup.WMActivate（var Msg：TWMActivate）; begin //如果我们被激活，然后将假装激活状态返回给我们的所有者 if（Msg.Active<> WA_INACTIVE）then SendMessage（Self。 PopupParent.Handle，WM_NCACTIVATE，WPARAM（True），-1）; 继承; //如果我们被停用，那么我们需要汇总如果Msg.Active = WA_INACTIVE然后 begin // DONE：告诉我们的所有者我们已经卷起 //注意：我们必须发布消息。如果它是发送，所有者 //将在MouseDown之前获得CloseUp通知， //启动所有这些。当MouseDown到来时，他们会认为 //它们没有被丢弃，并且下拉一个新的。 PostMessage（FNotificationParentWnd，WM_PopupFormCloseUp，0，0）; Self.Release; //使用发布给WM_Activate一个机会返回结束; 结束 然后我们必须更改我们的 MouseDown 代码，以了解drop还有： 程序TForm3.Edit1MouseDown（发件人：TObject; Button：TMouseButton; Shift：TShiftState; X，Y ： 整数）; var frmPopup：TfrmPopup; pt：TPoint; begin //如果我们（已）下降了，那么不要再下拉。 //如果他们点击我们，假装他们试图关闭下拉菜单，而不是打开第二个副本如果FDroppedDown然后开始 //因为我们是接收鼠标输入，我们通过定义必须有焦点。 //因为下拉列表自动破坏它，当它失去激活， //它不能再被丢弃（因为它不再存在）退出; 结束 frmPopup：= TfrmPopup.Create（Self）; //显示下面的对象，右对齐到这个按钮 pt：= Self.ClientToScreen（Edit1.BoundsRect.BottomRight）; Dec（pt.X，frmPopup.ClientWidth）; frmPopup.Show（Self，Self.Handle，pt）; FDroppedDown：= True; 结束 我认为是 Aside从 AnimateWindow 难题中，我可能可以使用我的研究工作来解决我想到的所有问题，以便：当然这可能是为了没有可能会出现一个VCL功能： TComboBoxHelper = class; public 类程序ShowDropDownForm（...）; 结束 在这种情况下 将是正确答案。解决方案在过程的底部，TForm3.Button1Click（Sender：TObject）; frmPopup.Show; 将其更改为 ShowWindow（frmPopup.Handle，SW_SHOWNOACTIVATE）; 之后，您需要调用 frmPopup.Visible：= True; 否则表单上的组件将不会显示 所以新的过程看起来像这个： 使用 frmPopupU; 程序TForm3.Button1Click（Sender：TObject）; var frmPopup：TfrmPopup; pt：TPoint; begin frmPopup：= TfrmPopup.Create（Self）; frmPopup.BorderStyle：= bsNone; //我们希望下载表单拥有，但不是父母给我们 frmPopup.Parent：= nil; //默认;但只是为了加强这个想法 frmPopup.PopupParent：= Self; //显示下面的对象，右对齐到此按钮 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）; //否则表单上的组件不会显示 frmPopup.Visible：= True; 结束 但这不会阻止弹出窗口窃取焦点。为了防止这种情况，您需要覆盖弹出窗体中的 WM_MOUSEACTIVATE 事件 type TfrmPopup = class（TForm） ... procedure WMMouseActivate（var Message：TWMMouseActivate）;消息WM_MOUSEACTIVATE; ... end; 执行 procedure TfrmPopup.WMMouseActivate（var Message：TWMMouseActivate）; begin Message.Result：= MA_NOACTIVATE; 结束 我决定用弹出窗口播放：我添加的第一件事是关闭按钮。只是一个简单的TButton，它的onCLick事件调用关闭： procedure TfrmPopup.Button1Click（Sender：TObject）; 开始关闭; 结束 但这只会隐藏表单，为了释放它我添加了一个 OnFormClose 事件： procedure TfrmPopup.FormClose（Sender：TObject; var Action：TCloseAction）; begin 动作：= caFree; 结束 然后终于我以为添加一个调整大小函数会很有趣 我通过覆盖 WM_NCHITTEST 消息： procedure TfrmPopup.WMNCHitTest（var Message：TWMNCHitTest）; const EDGEDETECT = 7; //调整适合自己 var deltaRect：TRect; //不是真的用作一个rect，只是一个方便的结构 begin 继承; with Message，deltaRect do begin 左：= XPos - BoundsRect.Left; 权限：= BoundsRect.Right - XPos; 顶部：= YPos - BoundsRect.Top; 底部：= BoundsRect.Bottom - YPos; if（Top< EDGEDETECT）和（Left< EDGEDETECT）然后结果：= HTTOPLEFT else if（Top< EDGEDETECT）和（Right< EDGEDETECT）那么结果：= HTTOPRIGHT else if（Bottom< EDGEDETECT）和（Left< EDGEDETECT）然后结果：= HTBOTTOMLEFT else if（Bottom< EDGEDETECT）和（右&EDGEDETECT）然后结果：= HTBOTTOMRIGHT else if（顶部< EDGEDETECT）然后结果：= HTTOP else if（Left< EDGEDETECT）then 结果：= HTLEFT else if（底部< EDGEDETECT）然后结果：= HTBOTTOM else if（Right< EDGEDETECT）then 结果：= HTRIGHT; 结束结束 所以最后我结束了： 单位frmPopupU; 接口 使用 Windows，消息，SysUtils，变体，类，图形，控件，窗体，对话框，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）;消息WM_MOUSEACTIVATE; procedure WMNCHitTest（var Message：TWMNCHitTest）;消息WM_NCHITTEST; public 程序CreateParams（var Params：TCreateParams）;覆盖结束 执行 {$ R * .dfm} {TfrmPopup} 程序TfrmPopup.Button1Click（发件人： TObject）; 开始关闭; 结束 程序TfrmPopup.CreateParams（var Params：TCreateParams）; const CS_DROPSHADOW = $ 00020000; begin 继承CreateParams（{var} Params）; Params.WindowClass.Style：= Params.WindowClass.Style或CS_DROPSHADOW; 结束 程序TfrmPopup.FormClose（发件人：TObject; var Action：TCloseAction）; begin 动作：= caFree; 结束 程序TfrmPopup.FormCreate（发件人：TObject）; begin DoubleBuffered：= true; BorderStyle：= bsNone; 结束 程序TfrmPopup.WMMouseActivate（var Message：TWMMouseActivate）; begin Message.Result：= MA_NOACTIVATE; 结束 程序TfrmPopup.WMNCHitTest（var Message：TWMNCHitTest）; const EDGEDETECT = 7; //调整适合自己 var deltaRect：TRect; //不是真的用作一个rect，只是一个方便的结构 begin 继承; with Message，deltaRect do begin 左：= XPos - BoundsRect.Left; 权限：= BoundsRect.Right - XPos; 顶部：= YPos - BoundsRect.Top; 底部：= BoundsRect.Bottom - YPos; if（Top< EDGEDETECT）和（Left< EDGEDETECT）然后结果：= HTTOPLEFT else if（Top< EDGEDETECT）和（Right< EDGEDETECT）那么结果：= HTTOPRIGHT else if（Bottom< EDGEDETECT）和（Left< EDGEDETECT）然后结果：= HTBOTTOMLEFT else if（Bottom< EDGEDETECT）和（右&EDGEDETECT）然后结果：= HTBOTTOMRIGHT else if（顶部< EDGEDETECT）然后结果：= HTTOP else if（Left< EDGEDETECT）then 结果：= HTLEFT else if（底部< EDGEDETECT）然后结果：= HTBOTTOM else if（Right< EDGEDETECT）then 结果：= HTRIGHT; 结束结束 结束。 希望你可以使用它。 全功能代码 以下单元仅在Delphi 5中进行了测试（模拟支持 PopupParent ）。但除此之外，它做的一切都是一个下拉式的需求。 Sertac解决了 AnimateWindow 问题。 unit DropDownForm; {一个下拉式样式。 样本使用 ================= 程序TForm1.SpeedButton1MouseDown（发件人：TObject;按钮： TMouseButton; Shift：TShiftState; X，Y：Integer）; var pt：TPoint; begin 如果FPopup = nil then FPopup：= TfrmOverdueReportsPopup.Create（Self）; 如果FPopup.DroppedDown然后//不再下拉，如果我们已经显示退出; pt：= Self.ClientToScreen（SmartSpeedButton1.BoundsRect.BottomRight）; Dec（pt.X，FPopup.Width）; FPopup.ShowDropdown（Self，pt）; 结束 只需将表单从TDropDownForm下降。 更改：类型 TfrmOverdueReportsPopup =类（TForm） 到：使用 DropDownForm; 类型 TfrmOverdueReportsPopup =类（TDropDownForm）} 接口 使用表单，消息，类，控件，Windows; const WM_PopupFormCloseUp = WM_USER + 89; type TDropDownForm = class（TForm） private FOnCloseUp：TNotifyEvent; FPopupParent：TCustomForm; FResizable：Boolean; 函数GetDroppedDown：Boolean; {$ IFNDEF SupportsPopupParent} procedure SetPopupParent（const Value：TCustomForm）; {$ ENDIF} protected procedure CreateParams（var Params：TCreateParams）;覆盖 procedure WMActivate（var Msg：TWMActivate）;消息WM_ACTIVATE; procedure WMNCHitTest（var Message：TWMNCHitTest）;消息WM_NCHITTEST; 程序DoCloseup;虚拟; procedure WMPopupFormCloseUp（var Msg：TMessage）;消息WM_PopupFormCloseUp; {$ IFNDEF SupportsPopupParent} 属性PopupParent：TCustomForm读取FPopupParent写入SetPopupParent; {$ ENDIF} public 构造函数Create（AOwner：TComponent）;覆盖 procedure ShowDropdown（OwnerForm：TCustomForm; PopupPosition：TPoint）; 属性DroppedDown：Boolean读取GetDroppedDown; 属性可调整大小：Boolean读FResizable写FResizable; 属性OnCloseUp：TNotifyEvent读取FOnCloseUp写入FOnCloseUp; 结束 执行 使用 SysUtils; {TDropDownForm} 构造函数TDropDownForm.Create（AOwner：TComponent）; 开始继承; Self.BorderStyle：= bsNone; //立即摆脱我们的边界，所以创作者可以准确地衡量我们 FResizable：= True; 结束 程序TDropDownForm.CreateParams（var Params：TCreateParams）; const SPI_GETDROPSHADOW = $ 1024; CS_DROPSHADOW = $ 00020000; var dropShadow：BOOL; begin 继承CreateParams（{var} Params）; //不再记录（因为Windows 2000不再受支持） //但使用CS_DROPSHADOW和SPI_GETDROPSHADOW仅在XP（5.1）或更新版本的中支持（Win32MajorVersion> 5）或（（Win32MajorVersion = 5）和（Win32MinorVersion> = 1））然后 begin //使用阴影由系统偏好控制如果不是Windows.SystemParametersInfo（SPI_GETDROPSHADOW，0，@dropShadow，0）then dropShadow：= False; 如果dropShadow然后 Params.WindowClass.Style：= Params.WindowClass.Style或CS_DROPSHADOW; 结束 {$ IFNDEF SupportsPopupParent} // Delphi 5支持PopupParent样式表单所有权如果FPopupParent<> nil then Params.WndParent：= FPopupParent.Handle; {$ ENDIF} end; 程序TDropDownForm.DoCloseup; 开始如果分配（FOnCloseUp）然后 FOnCloseUp（Self）; 结束 函数TDropDownForm.GetDroppedDown：Boolean; begin 结果：=（Self.Visible）; 结束 {$ IFNDEF SupportsPopupParent} 程序TDropDownForm.SetPopupParent（const Value：TCustomForm）; begin FPopupParent：= Value; 结束 {$ ENDIF} 程序TDropDownForm.ShowDropdown（OwnerForm：TCustomForm; PopupPosition：TPoint）; var comboBoxAnimation：BOOL; i：整数; const AnimationDuration = 200; // 200 ms begin //我们希望下载表单拥有（即不是父母）OwnerForm Self.Parent：= nil; //默认;但只是为了强化这个想法 Self.PopupParent：= OwnerForm; //所有者意味着所有者的Win32概念（即始终位于，cf Parent，这意味着剪切的孩子） {$ IFDEF SupportsPopupParent} Self.PopupMode：= pmExplicit; //所有者明示拥有者 {$ ENDIF} //显示刚刚下的正确对齐的按钮 // Self.BorderStyle：= bsNone ;在FormCreate期间移动;所以创建者可以知道我们的度量宽度 Self.Position：= poDesigned; Self.Left：= PopupPosition.X; Self.Top：= PopupPosition.Y; //使用下拉式动画由偏好控制如果不是Windows.SystemParametersInfo（SPI_GETCOMBOBOXANIMATION，0，@comboBoxAnimation，0）则 comboBoxAnimation：= False; 如果comboBoxAnimation然后 begin // Delphi对后面的表单显示没有反应（例如ShowWindow，AnimateWindow）。 //强制Delphi创建所有WinControls，以便在显示窗体时它们将存在。 for i：= 0 to ControlCount - 1 do begin 如果Controls [i]是TWinControl和Controls [i] .Visible和不是TWinControl（Controls [i]） .HandleAllocated then begin TWinControl（Controls [i]）。HandleNeeded; SetWindowPos（TWinControl（Controls [i]）。句柄，0，0，0，0，0， SWP_NOSIZE或SWP_NOMOVE或SWP_NOZORDER或SWP_NOACTIVATE或SWP_SHOWWINDOW）; 结束结束 AnimateWindow（Self.Handle，AnimationDuration，AW_VER_POSITIVE或AW_SLIDE或AW_ACTIVATE）; 可见：= True; // synch VCL end else inherited Show; 结束 程序TDropDownForm.WMActivate（var Msg：TWMActivate）; begin //如果我们被激活，那么将假装激活状态返回给我们的所有者 if（Msg.Active<> WA_INACTIVE）then SendMessage（Self。 PopupParent.Handle，WM_NCACTIVATE，WPARAM（True），-1）; 继承; //如果我们正在停用，那么我们需要汇总如果Msg.Active = WA_INACTIVE然后 $ $ $ $ $ $ $ $ $ $ $ $ $ $ （不发送消息）给我们关闭的我们。 这给了触发特写的鼠标/键盘事件相信下拉列表仍然下降的机会。 这是有意的，所以放下的人知道不要再下降了。 他们想要点击按钮，而被删除隐藏它。 但为了隐藏它，它仍然必须被删除。 } PostMessage（Self.Handle，WM_PopupFormCloseUp，WPARAM（Self），LPARAM（0））; 结束结束 程序TDropDownForm.WMNCHitTest（var Message：TWMNCHitTest）; var deltaRect：TRect; //不是真的用作一个rect，只是一个方便的结构 cx，cy：整数; 开始继承; 如果不是Self.Resizable然后退出; //相当大的边框是一个首选项 cx：= GetSystemMetrics（SM_CXSIZEFRAME）; cy：= GetSystemMetrics（SM_CYSIZEFRAME）; with Message，deltaRect do begin 左：= XPos - BoundsRect.Left; 权限：= BoundsRect.Right - XPos; 顶部：= YPos - BoundsRect.Top; 底部：= BoundsRect.Bottom - YPos; if（Top< cy）和（Left 结果：= HTTOPLEFT else if（Top< cy）和（Right 结果：= HTTOPRIGHT else if（Bottom< cy）和（Left 结果：= HTBOTTOMLEFT else if（Bottom< cy）和（右< cx）然后结果：= HTBOTTOMRIGHT else if（Top< cy）then 结果：= HTTOP else if（Left else if (Bottom < cy) then Result := HTBOTTOM else if (Right < cx) then Result := HTRIGHT; 结束结束 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; 结束。 How can i create a "drop-down" window using Delphi?Everything beyond this point is research effort; and is in no way related to the answer.Research EffortMaking a proper drop-down requires a lot of pieces to carefully work together. I assume people don't like the difficult question, and would rather i asked seven separate questions; each one addressing one tiny piece of the problem. Everything that follows is my research effort into solving the deceptively simple problem.Note the defining characteristics of a drop-down window:1. The drop-down extends outside it's "owner" window2. The "owner" window keeps focus; the drop-down never steals focus3. The drop-down window has a drop-shadowThis is the Delphi variation of the same question i asked about in WinForms:How to simulate a drop-down window in WinForms?The answer in WinForms was to use the ToolStripDropDown class. It is a helper class that turns any form into a drop-down.Lets do it in DelphiI will start by creating a gaudy dropdown form, that serves as the example:Next i will drop a button, that will be the thing i click to make the drop-down appear:And finally i will wire-up some initial code to show the form where it needs to be in the 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;Edit: Changed it to MouseDown rather than Click. Click is incorrect, as the drop-down is shown without the need to click. One of the unresolved issues is how to hide a drop-down if the user mouse-downs the button again. But we'll leave that for the person who answers the question to solve. Everything in this question is research effort - not a solution.And we're off:Now how to do it the right way?First thing we notice right away is the lack of a drop-shadow. That's because we need to apply the CS_DROPSHADOW window style: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;That fixes that:Focus StealingThe next issue is that calling .Show on the popup causes it to steal focus (the title bar of the application indicates that it has lost focus). Sertac comes up with the solution to this.when the popup receives it's WM_Activate message indicating that it is receiving focus (i.e. Lo(wParam) <> WA_INACTIVE):send the parent form a WM_NCActivate(True, -1) to indicate that it should draw itself like it still has focusWe handle the WM_Activate:protected procedure WMActivate(var Msg: TWMActivate); message WM_ACTIVATE;and the implementation: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;So the owner window looks like it still has focus (who knows if that is the correct way to do it - it only looks like it still has focus):Rolling upFortunately, Sertac already solves the problem of how to dismiss the window whenever the user clicks away:when the popup receives it's WM_Activate message indicating that it is losing focus (i.e. Lo(wParam) = WA_INACTIVE):send the owner control a notification that we are rolling upFree the popup formWe add that to our existing WM_Activate handler: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;Sliding the dropdownDropdown controls use AnimateWindow to slide the drop-down down. From Microsoft's own 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);}After checking if animations should be used, they use AnimateWindow to show the window. We can use SystemParametersInfo with SPI_GetComboBoxAnimation:Inside our newly consecrated TfrmPopup.Show method, we can check if client area animations are enabled, and call either AnimateWindow or Show depending on the user's preference:procedure TfrmPopup.Show(Owner: TForm; NotificationParentWindow: HWND; PopupPosition: TPoint);var pt: TPoint; comboBoxAnimation: BOOL;begin FNotificationParentWnd := NotificationParentWindow; //We want the dropdown form "owned" by (i.e. 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 (i.e. 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;Edit: Turns out there is SPI_GETCOMBOBOXANIMATION which should probably use over SPI_GETCLIENTAREAANIMATION. Which points to the depths of difficulty hidden behind the subtle "How to simulate a drop-down". Simulating a drop-down requires a lot of stuff.The problem is that Delphi forms pretty much fall over dead if you try to use ShowWindow or AnimateWindow behind their back:How to solve that?It's also odd that Microsoft itself uses either:ShowWindow(..., SW_SHOWNOACTIVATE), orAnimateWindow(...) *(without AW_ACTIVATE)to show the drop-down listbox without activation. And yet spying on a ComboBox with Spy++ i can see WM_NCACTIVATE flying around.In the past people have simulated a slide window using repeated calls to change the Height of the drop-down form from a timer. Not only is this bad; but it also changes the size of the form. Rather than sliding down, the form grows down; you can see all the controls change their layout as the drop-down appears. No, having the drop-down form remain it's real size, but slide down is what is wanted here.I know AnimateWindow and Delphi have never gotten along. And the question has been asked, a lot, long before Stackoverflow arrived. I even asked about it in 2005 on the newsgroups. But that can't stop me from asking again.I tried to force my form to redraw after it animates:AnimateWindow(Self.Handle, 200, AW_VER_POSITIVE or AW_SLIDE or AW_ACTIVATE);Self.Repaint;Self.Update;Self.Invalidate;But it doesn't work; it just sits there mocking me:Now showing again when i want to close-upIf a combobox is dropped down, and the user tries to MouseDown on the button, the real Windows ComboBox control does not simply show the control again, but instead hides it:The drop-down also knows that it is currently "dropped-down", which is useful so that it can draw itself as if it is in "dropped down" mode. What we need is a way to know that the drop-down is dropped down, and a way to know that the drop-down is no longer dropped down. Some kind of boolean variable:private FDroppedDown: Boolean;And it seems to me that we need to tell the host that we're closing up (i.e. losing activation). The host then needs to be responsible for destroying the popup. (the host cannot be responsible for destroying the popup; it leads to an unresolvable race condition). So i create a message used to notify the owner that we're closing up:const WM_PopupFormCloseUp = WM_APP+89;Note: I don't know how people avoid message constant conflicts (especially since CM_BASE starts at $B000 and CN_BASE starts at $BC00).Building on Sertac's activation/deactivation routine: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;And then we have to change our MouseDown code to understand that the drop-down is still there: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;And i think that's itAside from the AnimateWindow conundrum, i may have been able use my research effort to solve all the problems i can think of in order to:Of course, this could all be for naught. It might turn out there's a VCL function:TComboBoxHelper = class;public class procedure ShowDropDownForm(...);end;In which case that would be the correct answer. 解决方案 At the bottom of procedure TForm3.Button1Click(Sender: TObject); you call frmPopup.Show; change that to ShowWindow(frmPopup.Handle, SW_SHOWNOACTIVATE); and after that you need to call frmPopup.Visible := True; else the components on the form won't showSo the new procedure looks like this: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;But this won't prevent you popup from stealing focus. Inorder for preventing that, you need to override the WM_MOUSEACTIVATE event in your popup formtype TfrmPopup = class(TForm)... procedure WMMouseActivate(var Message: TWMMouseActivate); message WM_MOUSEACTIVATE;... end;And the implementationprocedure TfrmPopup.WMMouseActivate(var Message: TWMMouseActivate);begin Message.Result := MA_NOACTIVATE;end;I've decided to play arround with your popup window: The first thing I added was a close button. Just a simple TButton which in its onCLick Event calls Close:procedure TfrmPopup.Button1Click(Sender: TObject);begin Close;end;But that would only hide the form, in order for freeing it I added a OnFormClose event:procedure TfrmPopup.FormClose(Sender: TObject; var Action: TCloseAction);begin Action := caFree;end;Then finally I thought it would be funny to add a resize functionI did that by overriding the WM_NCHITTEST Message :procedure TfrmPopup.WMNCHitTest(var Message: TWMNCHitTest);const EDGEDETECT = 7; //adjust to suit yourselfvar deltaRect: TRect; //not really used as a rect, just a convenient structurebegin 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;So finally I've ended up with this :unit frmPopupU;interfaceuses 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 yourselfvar deltaRect: TRect; //not really used as a rect, just a convenient structurebegin 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.Hope you can use it.Full and functional codeThe following unit was tested only in Delphi 5 (emulated support for PopupParent). But beyond that, it does everything a drop-down needs. Sertac solved the AnimateWindow problem.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)}interfaceuses 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;implementationuses 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 msbegin //We want the dropdown form "owned" by (i.e. 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 (i.e. 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 (e.g. 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 hiddenend;end. 这篇关于如何在Delphi中模拟下拉式表单？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！ 上岸，阿里云！