• 在做一个下拉窗口的时候，一般使用PopupEdit来实现，不过使用PopupEdit有一个缺点，那就是PopupEdit的下拉内容一出现那么编辑框就不能编辑了，为了解决这个问题，
  可以自己使用buttonEdit来模拟PopupEdit的操作，只有当点击下拉按钮的时候下拉框（也就是一个窗体）才会出现。
• 大体思路，点击下拉按钮，出现一个新的窗体（ShowModal的形式），这个窗体的位置在buttonEdit的下面，点击其他的地方（非窗口中的内容）这个窗口会关闭。
• 难点：1. 窗体的位置在ButtonEdit的下面。2. 当点击其他位置的时候这个窗口关闭。

1. 窗口的位置：1. 获取ButtonEdit的位置坐标，将这个坐标转换为屏幕坐标。

var
  EditorOrigin: TPoint;
  BtnEdt: TcxButtonEdit;
begin
  EditorOrigin.Y := BtnEdt.Height;
  EditorOrigin.X := 0;
  EditorOrigin := BtnEdt.ClientToScreen(EditorOrigin);  
  ShowDialog(EditorOrigin.X, EditorOrigin.Y);
end;

2. 当点击其他位置的时候，这个窗口要关闭，那么肯定要重写Application.OnMessage; 当这个窗口不在active的时候 ModalResult := mrCancel;

procedure CMMOUSEENTER(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure WMACTIVATE(var Msg: TWMActivate); message WM_ACTIVATE;
procedure OnMessage(var Msg: TMsg; var Handled: Boolean);
function ShowModal: Integer; override;

function ShowDialog(X, Y: Integer): Boolean;
begin
  Result := False;
  with TfrmDialog.Create(nil) do
  try
    Left := X;
    Top := Y;
    FOldOnMsg := Application.OnMessage;
    Application.OnMessage := OnMessage;
    ShowModal;
    Application.OnMessage := FOldOnMsg;
    if (ModalResult = mrOk) or (ModalResult = mrCancel) then
    begin
      Result := True;
      // do something
    end;
  finally
    Free;
  end;
end;

procedure TfrmDialog.CMMOUSEENTER(var Message: TMessage);
begin
// ReleaseCapture();
end;

procedure TfrmDialog.CMMouseLeave(var Message: TMessage);
begin
// SetCaptureControl(tlFlValue);
end;

procedure TfrmDialog.WMACTIVATE(var Msg: TWMActivate);
begin
  if Msg.Active = WA_INACTIVE then
  begin
    ModalResult := mrCancel;
  end;
  inherited;
end;

function TfrmDialog.ShowModal: Integer;
var
  // WindowList: TTaskWindowList;
  LSaveFocusState: TFocusState;
  // SaveCursor: TCursor;
  // SaveCount: Integer;
  // ActiveWindow: HWnd;
begin
  LSaveFocusState := nil;
  CancelDrag;
  if GetCapture <> 0 then
    SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
  ReleaseCapture;
  Application.ModalStarted;
  try
    { RecreateWnd could change the active window }
    // ActiveWindow := GetActiveWindow;
    Include(FFormState, fsModal);
    if (PopupMode = pmNone) and (Application.ModalPopupMode <> pmNone) then
    begin
      RecreateWnd;
      HandleNeeded;
      { The active window might have become invalid, refresh it }
      // if (ActiveWindow = 0) or not IsWindow(ActiveWindow) then
      // ActiveWindow := GetActiveWindow;
    end;
    Screen.SaveFocusedList.Insert(0, Screen.FocusedForm);
    Screen.FocusedForm := Self;
    // SaveCursor := Screen.Cursor;
    Screen.Cursor := crDefault;
    // SaveCount := Screen.CursorCount;
    try
      Show;
      try
        SendMessage(Handle, CM_ACTIVATE, 0, 0);
        ModalResult := 0;
        repeat
          Application.HandleMessage;
          if Application.Terminated then
            ModalResult := mrCancel
          else
            if ModalResult <> 0 then
            CloseModal;
        until ModalResult <> 0;
        Result := ModalResult;
        SendMessage(Handle, CM_DEACTIVATE, 0, 0);
        // if GetActiveWindow <> Handle then ActiveWindow := 0;
      finally
        Hide;
      end;
    finally
      if Screen.SaveFocusedList.Count > 0 then
      begin
        Screen.FocusedForm := TCustomForm(Screen.SaveFocusedList.First);
        Screen.SaveFocusedList.Remove(Screen.FocusedForm);
      end
      else
        Screen.FocusedForm := nil;
      RestoreFocusState(LSaveFocusState);
      Exclude(FFormState, fsModal);
    end;
  finally
    Application.ModalFinished;
  end;
end;

procedure TfrmDialog.OnMessage(var Msg: TMsg;
  var Handled: Boolean);
begin
  if Msg.message in [WM_NCLBUTTONDOWN, WM_NCRBUTTONDOWN] then
    Handled := True
  else
    if Assigned(FOldOnMsg) then
      FOldOnMsg(Msg, Handled);
end;

涉及的 Delphi 相关知识点

1. 控件组件

• TcxButtonEdit（来自 DevExpress）：

  • 是一个带按钮的编辑框。用户点击按钮可以触发事件或显示额外内容（如弹出窗体）。

• TForm：

  • 用于创建弹出窗体 TfrmDialog，并以 ShowModal 模式显示。

---

2. 坐标转换

EditorOrigin := BtnEdt.ClientToScreen(EditorOrigin);

• ClientToScreen：将控件内部坐标系转换为屏幕坐标。这里用于让弹窗定位在按钮下方。

---

3. 消息机制

procedure OnMessage(var Msg: TMsg; var Handled: Boolean);

• 通过 Application.OnMessage 捕获全局 Windows 消息（比如鼠标点击、键盘操作），实现“点击窗体外部自动关闭”的逻辑。

---

4. 窗口激活处理

procedure TfrmDialog.WMACTIVATE(var Msg: TWMActivate); message WM_ACTIVATE;

• 当窗体失去焦点（即 WA_INACTIVE）时自动设置 ModalResult := mrCancel; 从而关闭弹出窗体。

---

5. ShowModal 重写

• 重写了 ShowModal 来自定义弹窗生命周期，模拟 Delphi 默认模态行为。

• 使用 Application.HandleMessage 来保持窗口响应性。

---

6. 消息屏蔽

if Msg.message in [WM_NCLBUTTONDOWN, WM_NCRBUTTONDOWN] then
Handled := True;

• 阻止对非客户端区域（窗口标题栏、边框等）的点击响应，从而防止窗体意外关闭或拖动。

---

✅ 优化建议

✅ 1. 避免覆盖 Application.OnMessage，全局副作用大

• 当前方式是全局劫持 Application.OnMessage，这对整个应用有潜在副作用（多个窗体同时使用时会互相影响）。
  优化建议：

• 使用 SetWindowsHookEx 安装局部鼠标钩子，仅监听当前线程鼠标事件；

• 或使用非模态窗体并结合 TApplicationEvents 组件中的 OnDeactivate / OnIdle 进行判断关闭。

---

✅ 2. 使用非模态窗体+“伪模态”处理

• ShowModal 会阻塞主线程，不利于用户界面响应。
  优化建议：

• 改用 Show 非模态弹窗 + 设置 PopupParent := 主窗体 + 响应 Deactivate 消息来自行关闭，体验一致但更灵活。

---

✅ 3. 封装行为为组件更好复用

• 当前逻辑写在窗体类中，重复使用不方便。
  优化建议：

• 封装成一个 TPopupFormHelper 类或组件，将弹出逻辑抽象出来；

• 提供回调接口，让主窗体接收选中值。

---

✅ 4. 视觉体验优化

• 弹出窗体应无边框，可能需要设置 BorderStyle := bsNone；

• 显示位置应考虑屏幕边界，防止窗体超出可视区域。
  优化建议：if X + Width > Screen.Width then
  X := Screen.Width – Width;
  if Y + Height > Screen.Height then
  Y := Screen.Height – Height;

✅ 5. 资源释放保护

当前代码结构良好，但仍建议：

Application.OnMessage := FOldOnMsg;
Free;

可包裹在 try..finally 中，避免异常泄漏：

try
ShowModal;
finally
Application.OnMessage := FOldOnMsg;
Free;
end;

总结：适合场景与建议改进

完整的相关封装类

 

下面是一个完整的 Delphi 封装类 TPopupFormHelper，可用于为任意 TcxButtonEdit 实现点击按钮时弹出窗体的效果，具备以下特性：

• ✅ 弹出窗体位于 ButtonEdit 下方

• ✅ 自动关闭（点击窗体外部自动关闭）

• ✅ 非模态弹窗（不会阻塞主线程）

• ✅ 无需修改 Application.OnMessage

• ✅ 可复用、可回调处理选择结果

---

✅ 使用方式

1. 创建你自己的弹窗窗体（如 TfrmPopup)，可以是 bsNone 窗体，带有内容控件。

2. 使用 TPopupFormHelper 创建并显示弹窗。

---

🔧 代码：TPopupFormHelper 单元

unit PopupFormHelper;

interface

uses
  System.Classes, Winapi.Windows, Vcl.Forms, Vcl.Controls,
  Vcl.ExtCtrls, System.Types;

type
  TPopupFormHelper = class
  private
    FPopupForm: TForm;
    FOwnerControl: TWinControl;
    FOnSelectDone: TNotifyEvent;
    FDeactivationChecker: TTimer;
    procedure OnDeactivateCheck(Sender: TObject);
  public
    constructor Create(AOwner: TWinControl; APopupForm: TForm);
    destructor Destroy; override;

    procedure ShowBelowControl;
    property OnSelectDone: TNotifyEvent read FOnSelectDone write FOnSelectDone;
  end;

implementation

uses
  Vcl.Graphics;

{ TPopupFormHelper }

constructor TPopupFormHelper.Create(AOwner: TWinControl; APopupForm: TForm);
begin
  FOwnerControl := AOwner;
  FPopupForm := APopupForm;
  FPopupForm.BorderStyle := bsNone;
  FPopupForm.FormStyle := fsStayOnTop;
  FPopupForm.Position := poDesigned;
  FPopupForm.Visible := False;
  FPopupForm.KeyPreview := True;

  FDeactivationChecker := TTimer.Create(nil);
  FDeactivationChecker.Interval := 100;
  FDeactivationChecker.OnTimer := OnDeactivateCheck;
end;

destructor TPopupFormHelper.Destroy;
begin
  FDeactivationChecker.Free;
  inherited;
end;

procedure TPopupFormHelper.OnDeactivateCheck(Sender: TObject);
begin
  if not FPopupForm.Focused and not FPopupForm.ContainsControl(Screen.ActiveControl) then
  begin
    FPopupForm.Close;
    FDeactivationChecker.Enabled := False;
    if Assigned(FOnSelectDone) then
      FOnSelectDone(FPopupForm);  // 通知父窗口选择已完成
  end;
end;

procedure TPopupFormHelper.ShowBelowControl;
var
  Pos: TPoint;
begin
  Pos := FOwnerControl.ClientToScreen(Point(0, FOwnerControl.Height));
  FPopupForm.Left := Pos.X;
  FPopupForm.Top := Pos.Y;

  // 避免超出屏幕
  if FPopupForm.Left + FPopupForm.Width > Screen.WorkAreaWidth then
    FPopupForm.Left := Screen.WorkAreaWidth - FPopupForm.Width;
  if FPopupForm.Top + FPopupForm.Height > Screen.WorkAreaHeight then
    FPopupForm.Top := Screen.WorkAreaHeight - FPopupForm.Height;

  FPopupForm.Show;
  FPopupForm.BringToFront;
  FDeactivationChecker.Enabled := True;
end;

end.

示例：在窗体中调用

你在主窗体中可以这样使用：

procedure TForm1.cxButtonEdit1PropertiesButtonClick(Sender: TObject;
  AButtonIndex: Integer);
var
  PopupForm: TfrmPopup; // 你自己设计的弹出窗体
  Helper: TPopupFormHelper;
begin
  PopupForm := TfrmPopup.Create(Self);
  Helper := TPopupFormHelper.Create(cxButtonEdit1, PopupForm);
  Helper.OnSelectDone := procedure(Sender: TObject)
  begin
    // 从弹出窗体获取值
    cxButtonEdit1.Text := PopupForm.SelectedValue;
    Helper.Free; // 释放 Helper（也会释放 Timer）
    PopupForm.Free; // 释放弹出窗体
  end;
  Helper.ShowBelowControl;
end;

补充说明

• TfrmPopup 可以是你自己设计的窗体，里面放 ListBox、Grid、按钮都可以。

• 通过 PopupForm.SelectedValue 获取选择结果（你自己定义字段）。

• OnSelectDone 是点击窗体外部或关闭弹窗时触发的回调，可用于处理结果或清理资源。

• 可扩展 Helper.ShowBelowControl(Rect: TRect) 支持定位到任意控件或区域。