如何在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 ）：
• 发送父表单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 ，那么Delphi几乎已经死了：

怎么解决？

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

• ShowWindow(..., SW_SHOWNOACTIVATE) ，或
• AnimateWindow(...) *（没有AW_ACTIVATE ）

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

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

我知道AnimateWindow和Delphi从未相处过。 在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);底部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;

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

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

但这只会隐藏表单，为了释放它，我添加了一个OnFormClose事件：

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

最后我觉得添加一个resize函数会很有趣

我通过覆盖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不会创建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
  ...

这只是一个示例，显示屏幕外的表单或任何其他创作方法可以同样有效。 在这个答案中 ，我通过在将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;