使用CreateWindow创建的Checkbox在对话框调整大小时消失

安全阿岳

2026-8-3

为BrowseForFolder对话框添加Checkbox后窗口缩放时控件消失的问题

我通过以下代码为BrowseForFolder对话框添加了一个Checkbox：

ControlCreateStyles := WS_CHILD or {WS_CLIPSIBLINGS or} WS_VISIBLE or WS_TABSTOP or BS_CHECKBOX;
ChkBoxHdl := CreateWindow('BUTTON', PChar(ChkBoxCap), ControlCreateStyles,
   Left, Top, Width, Height, Wnd, FB_CHECKBOX_ID, HInstance, nil);

Checkbox显示和运行正常，但当对话框缩小至最小尺寸时，Checkbox及其标题会消失；调整对话框大小后Checkbox会重现，但重现并不稳定。尝试启用WS_CLIPSIBLINGS会导致控件完全无法显示。

以下是测试单元代码：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

function BrowseForFolder(Title, Caption: string; const InitFolder: string = ''; DoNewBtn: Boolean = True; DoCheckBox: Boolean = False): string;

var
  Form1: TForm1;
  ShowCheckBox: Boolean = False;
  DialogCaption: string;

implementation

{$R *.dfm}

uses
  ShlObj, FileCtrl;

const
  BIF_NEWDIALOGSTYLE = $40;
  BIF_NONEWFOLDERBUTTON = $200;
  FB_CHECKBOX_ID = 4005;

var
  lg_StartFolder: String;
  OldWndProc: Pointer;

function WndProcLocal(HWindow: HWND; MsgId: UINT; wP: WPARAM; lP: LPARAM): LRESULT; stdcall;
var
  NewFolder: string;
  Cnt: Integer;
  maxwidth: Integer;
  MyFB: HWND;

begin
  if (MsgId = WM_COMMAND) and (wP = FB_CHECKBOX_ID) then begin
    Result := 0;
    NewFolder := '';
    Cnt := 0;

    if (IsDlgButtonChecked(HWindow, FB_CHECKBOX_ID) = 0) then begin
      CheckDlgButton(HWindow, FB_CHECKBOX_ID, BST_CHECKED);
      // Do Something
    end
    else begin
      CheckDlgButton(HWindow, FB_CHECKBOX_ID, BST_UNCHECKED);
      // Do Something
    end;
  end
  else begin
    if (MsgId = WM_SHOWWINDOW) then begin
      // Do Something
    end
    else if (MsgId = WM_SIZE) then begin
      // Do Something
    end
    else if (MsgId = WM_MOVE) then begin
      // Do Something
    end;
    Result := CallWindowProc(OldWndProc, HWindow, MsgId, wP, lP);
  end;
end;

function BrowseForFolderCallBack(Wnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): Integer stdcall;
var
  ControlCreateStyles: Integer;
  ChkBoxCap: String;
  ChkBoxHdl: HWND;
  Left, Top, Width, Height: Integer;
  PPI: Integer;
  Cnv: TCanvas;
  TempFont: TFont;

begin
  Result := 0;
  if uMsg = BFFM_INITIALIZED then begin
    if ShowCheckBox then begin
      Left := 16;
      Top := 32;
      //Width := ?; { Calculated next based on caption }
      Height := 16;

      ChkBoxCap := 'Checkbox Caption';

      Cnv := TCanvas.Create;
      try
        Cnv.Handle := GetDC(Wnd);
        Width := Height * 2 + Cnv.TextWidth(ChkBoxCap);
      finally
        Cnv.Free;
      end;

      ControlCreateStyles := WS_CHILD or {WS_CLIPSIBLINGS or} WS_VISIBLE or WS_TABSTOP or BS_CHECKBOX;
      ChkBoxHdl := CreateWindow('BUTTON', PChar(ChkBoxCap), ControlCreateStyles,
         Left, Top, Width, Height, Wnd, FB_CHECKBOX_ID, HInstance, nil);

      TempFont := nil;
      TempFont := TFont.Create;
      TempFont.Assign(Screen.IconFont);
      try
        PostMessage(ChkBoxHdl, WM_SETFONT, Longint(TempFont.Handle), MAKELPARAM(1, 0));
      finally
        TempFont.Free;
      end;

      CheckDlgButton(Wnd, FB_CHECKBOX_ID, BST_UNCHECKED); { Should always default to False }

      //EnableWindow(ChkBoxHdl, True); { Necessary? }
    end; { ShowCheckBox }

    SetWindowText(Wnd, PChar(DialogCaption));

    SendMessage(Wnd, BFFM_SETSELECTION, 1, Integer(@lg_StartFolder[1]));
    OldWndProc := Pointer(GetWindowLong(Wnd, GWL_WNDPROC));
    SetWindowLong(Wnd, GWL_WNDPROC, Longint(@WndProcLocal));
  end;
end;

function BrowseForFolder(Title, Caption: string; const InitFolder: string = ''; DoNewBtn: Boolean = True; DoCheckBox: Boolean = False): string;
var
  lpItemID: PItemIDList;
  BrowseInfo: TBrowseInfo;
  DisplayName: array[0 .. MAX_PATH] of Char;
  find_context: PItemIDList;
  ptrWindows: Pointer;

begin
  DialogCaption := Caption;
  ShowCheckBox := DoCheckBox;

  FillChar(BrowseInfo, SizeOf(BrowseInfo), #0);
  FillChar(DisplayName, SizeOf(DisplayName), #0);

  lg_StartFolder := InitFolder;

  with BrowseInfo do begin
    hwndOwner := Application.Handle;
    pszDisplayName := @DisplayName[0];
    lpszTitle := PChar(Title);

    ulFlags := BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE;
    if not DoNewBtn then
      ulFlags := ulFlags or BIF_NONEWFOLDERBUTTON; { Hide New Folder Button }

    if (InitFolder <> '') then
      lpfn := @BrowseForFolderCallBack;
    LPARAM := 0;
  end;

  ptrWindows := DisableTaskWindows(0);

  try
    lpItemID := SHBrowseForFolder(BrowseInfo);
  finally
    EnableTaskWindows(ptrWindows);
  end;

  if Assigned(lpItemID) then
  begin
    if SHGetPathFromIDList(lpItemID, DisplayName) then
      Result := DisplayName
    else
      Result := '';
    GlobalFreePtr(lpItemID);
  end
  else
    Result := '';
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Dir: String;
begin
  BrowseForFolder('Title', 'Caption', 'C:\', True, True);
end;

end.

问题原因

对话框缩放时，系统会重新绘制控件，但自定义添加的Checkbox未被纳入对话框的布局管理，导致窗口尺寸变化时控件被裁剪或未正确重绘。另外，WS_CLIPSIBLINGS会让控件裁剪兄弟窗口，而对话框原生控件的层级可能覆盖了Checkbox，导致无法显示。

修复方案

1. 处理WM_SIZE消息强制重绘Checkbox

在WndProcLocal的WM_SIZE分支中，强制Checkbox重绘：

else if (MsgId = WM_SIZE) then begin
  if ShowCheckBox then begin
    ChkBoxHdl := GetDlgItem(HWindow, FB_CHECKBOX_ID);
    if ChkBoxHdl <> 0 then begin
      InvalidateRect(ChkBoxHdl, nil, True);
      UpdateWindow(ChkBoxHdl);
    end;
  end;
end;

注：可将ChkBoxHdl设为全局变量，避免每次调用GetDlgItem

2. 调整窗口与控件样式

移除Checkbox的WS_CLIPSIBLINGS样式，为对话框添加WS_CLIPCHILDREN，确保对话框绘制时不裁剪子控件：

// 在BrowseForFolderCallBack中创建Checkbox后添加：
SetWindowLong(Wnd, GWL_STYLE, GetWindowLong(Wnd, GWL_STYLE) or WS_CLIPCHILDREN);

3. 确保Checkbox层级不被遮挡

使用SetWindowPos将Checkbox置于对话框原生控件上方：

// 在BrowseForFolderCallBack中创建Checkbox后添加：
SetWindowPos(ChkBoxHdl, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);

4. 优化控件位置计算

不要固定Top/Left值，基于对话框客户区或原生控件位置相对定位，确保窗口缩放时控件位置合理：

var
  ClientRect: TRect;
begin
  GetClientRect(Wnd, ClientRect);
  Left := ClientRect.Left + 16;
  // 可通过FindWindowEx找到对话框内的列表框等控件，获取其位置后计算Top
end;

内容的提问来源于stack exchange，提问作者MFM