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

Question

如何使用Delphi 创建"下拉"窗口？

超越这一点的一切都是研究工作; 并且与答案无关.

研究工作

做一个适当的下拉需要很多部分仔细一起工作.我假设人们不喜欢这个棘手的问题,我宁愿问七个不同的问题; 每一个都解决了一小部分问题.接下来的一切都是我为解决这个看似简单的问题所做的研究工作.

---

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

• 1.下拉延伸到它的"所有者"窗口之外
• 2.该"拥有者"窗口保持焦点; 下拉永远不会抢断焦点
• 3.下拉窗口有一个阴影

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

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

WinForms的答案是使用ToolStripDropDown class.它是一个帮助类,可以将任何形式转换为下拉列表.

让我们在Delphi中做到这一点

我将首先创建一个华而不实的下拉表单,作为示例:

接下来我将删除一个按钮,这将是我点击以显示下拉列表的内容:

最后,我将连接一些初始代码,以显示它在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.单击不正确,因为显示下拉列表而无需单击.其中一个未解决的问题是如果用户再次按下按钮,如何隐藏下拉列表.但我们会留下那个回答问题的人来解决.这个问题的一切都是研究工作 - 而不是解决方案.

我们离开了:

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

我们马上注意到的第一件事是缺少阴影.那是因为我们需要应用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弹出窗口会导致它偷取焦点(应用程序的标题栏表示它已失去焦点).Sertac提出了解决方案.

• 当弹出窗口收到它的WM_Activate消息,表明它正在接收焦点(即Lo(wParam) <> WA_INACTIVE):
• 发送父表单a 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已经解决了用户点击时如何解除窗口的问题:

• 当弹出窗口收到它的WM_Activate消息,表明它正在失去焦点(即Lo(wParam) = WA_INACTIVE):
• 向所有者控制发送我们正在汇总的通知
• 释放弹出窗体

我们将它添加到现有的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);
}

在检查是否应该使用动画之后,它们用于AnimateWindow显示窗口.我们可以使用SystemParametersInfo与SPI_GetComboBoxAnimation:

确定是否启用组合框的滑动打开效果.的pvParam参数必须指向BOOL接收变量TRUE为启用,或FALSE为禁用.

在我们新近完成的TfrmPopup.Show方法中,我们可以检查客户区动画是否已启用,并根据用户的偏好调用AnimateWindow或Show根据用户的偏好调用:

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;

编辑:原来SPI_GETCOMBOBOXANIMATION应该使用哪个SPI_GETCLIENTAREAANIMATION.这指向隐藏在微妙的"如何模拟下拉"背后的难度.模拟下拉列表需要很多东西.

问题是,如果你试图使用ShowWindow或AnimateWindow背后隐藏,德尔福的形式几乎已经过时了:

怎么解决？

微软自己使用以下任何一种方法也很奇怪:

• ShowWindow(..., SW_SHOWNOACTIVATE), 要么
• AnimateWindow(...)*(没有AW_ACTIVATE)

显示下拉列表框而不激活.然而,使用Spy ++监视ComboBox我可以看到WM_NCACTIVATE飞来飞去.

在过去,人们使用重复调用来模拟幻灯片窗口Height,以从计时器更改下拉表单.这不仅是坏事; 但它也会改变表格的大小.表格不是向下滑,而是向下滑; 您可以看到所有控件在下拉列表中更改其布局.不,有下拉形式仍然是它的实际尺寸,但下滑是这里想要的.

我知道AnimateWindow,德尔福从来没有这样做过.在Stackoverflow到来之前很久就提出了这个问题.我甚至在2005年就新闻组问过这个问题.但这无法阻止我再次提出要求.

我试图强制我的表格重绘后动画:

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

但它不起作用; 它只是坐在那里嘲笑我:

现在再次显示我想要特写

如果组合框被删除,并且用户尝试按钮上的MouseDown,真正的Windows ComboBox控件不会再次显示控件,而是隐藏它:

下拉列表也知道它当前是"下拉"的,这很有用,因此它可以像处于"下拉"模式一样绘制自己.我们需要的是一种了解下拉列表被丢弃的方法,以及一种了解下拉列表不再下降的方法.某种布尔变量:

private
   FDroppedDown: Boolean;

在我看来,我们需要告诉主持人我们正在关闭(即失去激活).然后主机需要负责销毁弹出窗口. (主持人不负责销毁弹出窗口;导致无法解决的竞争条件).所以我创建了一条消息,用于通知所有者我们正在关闭:

const
   WM_PopupFormCloseUp = WM_APP+89;

注意:我不知道人们如何避免消息持续冲突(特别是从CM_BASE$ B000 CN_BASE开始并从$ BC00开始).

基于Sertac的激活/停用例程:

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;

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

Answer 1

在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 (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 hidden
end;

end.

Answer 2

如何使用 Delphi 创建“下拉”窗口？

您将总结的所有点点滴滴放在一起，没有一个 VCL 类/函数可以生成下拉表单。

不过，在您的研究中有几点需要提及。

首先，您将激活与焦点混淆了。当另一个窗口在它前面弹出时，焦点不会保留在调用表单中，激活是 - 或者看起来是这样。焦点是键盘输入的地方，它显然位于弹出/下拉窗口或其中的控件上。

您的控件未显示的问题AnimateWindow是，VCL 不会创建TWinControls 的底层本机（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
  ...

这只是一个示例，在屏幕外显示表单或任何其他创意方法都可以同样有效。在这里，在这个答案中，我通过在设置visible为 true之前将动画表单的高度设置为“0”来实现相同的效果（不过我更喜欢这个答案中的方法......）。

关于在表单已经下拉时不再删除，您不必为此向调用表单发布消息。实际上不要那样做，它需要调用表单不必要的合作。将永远只有一个实例被删除，因此您可以使用全局：

  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;