gpt4 book ai didi

windows - 如何在Delphi中模拟下拉表单?

转载 作者:行者123 更新时间:2023-12-03 14:34:48 36 4
gpt4 key购买 nike

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

超出这一点的一切都是研究工作。并且与答案没有任何关系。

研究工作

进行适当的下拉列表需要很多步骤来仔细地一起工作。我认为人们不喜欢这个难题,宁愿我问七个独立的问题。每个解决一个小问题。接下来的一切都是我为解决看似简单的问题所做的研究工作。

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

  • 1. 下拉列表扩展到其“所有者”窗口之外
  • 2. “所有者”窗口保持焦点;下拉菜单永远不会窃取焦点
  • 3. 下拉窗口中有一个下拉阴影

  • 这是我在WinForms中询问的同一问题的Delphi变体:
  • How to simulate a drop-down window in 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 而不是 单击。单击是不正确的,因为无需单击即可显示下拉列表。尚 Unresolved 问题之一是,如果用户再次按下鼠标,则如何隐藏下拉菜单。但是,我们会将其留给回答问题的人来解决。这个问题中的所有内容都是研究工作,而不是解决方案。

    我们出发了:

    现在如何正确地做呢?

    我们立即注意到的第一件事是缺少阴影。那是因为我们需要应用 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 (真,-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 :

    Determines whether the slide-open effect for combo boxes is enabled. The pvParam parameter must point to a BOOL variable that receives TRUE for enabled, or FALSE for disabled.



    在我们新近奉献的 TfrmPopup.Show方法中,我们可以检查是否启用了客户端动画,并根据用户的喜好调用 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 (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上使用。这就指出了隐藏在“如何模拟下拉菜单”背后的困难深处。模拟下拉列表需要很多工作。

    问题是,如果您尝试在背后使用 ShowWindowAnimateWindow,则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;

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

    现在要显示特写时再次显示

    如果下拉组合框,并且用户尝试在按钮上使用 MouseDown ,则真正的Windows ComboBox控件不会简单地再次显示该控件,而是将其隐藏:

    下拉菜单还知道它当前处于“下拉”状态,这很有用,因此它可以像在“下拉”模式下一样绘制自身。我们需要的是一种知道下拉列表已下拉的方式,以及一种知道下拉列表不再下拉的方式。某种 bool 变量:
    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难题之外,我也许还可以利用自己的研究成果来解决我能想到的所有问题,以便:

    Simulate a drop-down form in Delphi



    当然,这可能都是徒劳的。可能有一个VCL功能:
    TComboBoxHelper = class;
    public
    class procedure ShowDropDownForm(...);
    end;

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

    最佳答案

    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.

    关于windows - 如何在Delphi中模拟下拉表单?,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/29549816/

    36 4 0
    Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
    广告合作:1813099741@qq.com 6ren.com