Checkbox Created with CreateWindow Disappears on Resize

Question

I'm adding a checkbox to the BrowseForFolder dialog using the following calls...

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);

The checkbox displays and operates correctly. However, when I resize the dialog down to its smallest size, the checkbox and caption disappear. Resizing the dialog causes the checkbox to reappear but not consistently. I tried enabling WS_CLIPSIBLINGS but doing so causes the component to not display at all.

Here is my test unit...

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.

Answer 1

As recommended by Embarcadero, it looks like I would need to go this route.

JAM Software ShellBrowser Delphi Components
Creating Custom File Dialogs: ShellBrowser Delphi Components

Yes, I am aware these libraries are only supported on Delphi XE3 and later.

Answer 2

Using Remy's suggestion, I produced the following: A File Dialog set to Pick Folders with a custom checkbox item.

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    btnSelectFolder: TButton;
    BrowseForFolder: TFileOpenDialog;
    procedure BrowseForFolderOkClick(Sender: TObject; var CanClose: Boolean);
    procedure BrowseForFolderExecute(Sender: TObject);
    procedure btnSelectFolderClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

const
  FB_CHECKBOX_ID = 4005;

implementation

uses
  Winapi.ShlObj;

{$R *.dfm}

type
  TFBDialogEvents = class(TInterfacedObject, IFileDialogEvents, IFileDialogControlEvents)
  public
    { IFileDialogEvents }
    function OnFileOk(const pfd: IFileDialog): HResult; stdcall;
    function OnFolderChanging(const pfd: IFileDialog; const psiFolder: IShellItem): HResult; stdcall;
    function OnFolderChange(const pfd: IFileDialog): HResult; stdcall;
    function OnSelectionChange(const pfd: IFileDialog): HResult; stdcall;
    function OnShareViolation(const pfd: IFileDialog; const psi: IShellItem; out pResponse: DWORD): HResult; stdcall;
    function OnTypeChange(const pfd: IFileDialog): HResult; stdcall;
    function OnOverwrite(const pfd: IFileDialog; const psi: IShellItem; out pResponse: DWORD): HResult; stdcall;
    { IFileDialogControlEvents }
    function OnItemSelected(const pfdc: IFileDialogCustomize; dwIDCtl: DWORD; dwIDItem: DWORD): HResult; stdcall;
    function OnButtonClicked(const pfdc: IFileDialogCustomize; dwIDCtl: DWORD): HResult; stdcall;
    function OnCheckButtonToggled(const pfdc: IFileDialogCustomize; dwIDCtl: DWORD; bChecked: BOOL): HResult; stdcall;
    function OnControlActivating(const pfdc: IFileDialogCustomize; dwIDCtl: DWORD): HResult; stdcall;
  end;

const
  dwVisualGroup1ID: DWORD = 1900;

var
  FB: IFileDialog = nil;
  FBEvents: IFileDialogEvents = nil;
  FBEventsCookie: DWORD = 0;

procedure TForm1.btnSelectFolderClick(Sender: TObject);
var
  aFolder: string;
begin
  BrowseForFolder.Options := [fdoPickFolders];
  if BrowseForFolder.Execute(Self.Handle) then begin
    // Do Something
    aFolder := BrowseForFolder.FileName;
  end;
end;

procedure TForm1.BrowseForFolderExecute(Sender: TObject);
var
  iCustomize: IFileDialogCustomize;
  iEvents: IFileDialogEvents;
  cookie: DWORD;

begin
  if Supports(BrowseForFolder.Dialog, IFileDialogCustomize, iCustomize) then begin

    if BrowseForFolder.Dialog.QueryInterface(IFileDialogCustomize, iCustomize) = S_OK then begin
      iCustomize.StartVisualGroup(0, 'Custom Caption');
      try
        iCustomize.AddCheckButton(FB_CHECKBOX_ID, 'Checkbox Caption', False);
        iCustomize.MakeProminent(FB_CHECKBOX_ID);
      finally
        iCustomize.EndVisualGroup;
      end;

      iEvents := TFBDialogEvents.Create;
      if Succeeded(BrowseForFolder.Dialog.Advise(iEvents, cookie)) then begin
        FB := BrowseForFolder.Dialog;
        FBEvents := iEvents;
        FBEventsCookie := cookie;
      end;
    end;
  end;
end;

// Grab the custom control's selection
procedure TForm1.BrowseForFolderOkClick(Sender: TObject; var CanClose: Boolean);
var
  iCustomize: IFileDialogCustomize;
  IsChecked: LongBool;

begin
  if BrowseForFolder.Dialog.QueryInterface(IFileDialogCustomize, iCustomize) = S_OK then begin
    iCustomize.GetCheckButtonState(FB_CHECKBOX_ID, IsChecked);
  end;
end;

function TFBDialogEvents.OnFileOk(const pfd: IFileDialog): HResult;
begin
  Result := E_NOTIMPL;
end;

function TFBDialogEvents.OnFolderChange(const pfd: IFileDialog): HResult;
begin
  Result := E_NOTIMPL;
end;

function TFBDialogEvents.OnFolderChanging(const pfd: IFileDialog; const psiFolder: IShellItem): HResult;
begin
  Result := E_NOTIMPL;
end;

function TFBDialogEvents.OnOverwrite(const pfd: IFileDialog; const psi: IShellItem; out pResponse: DWORD): HResult;
begin
  Result := E_NOTIMPL;
end;

function TFBDialogEvents.OnSelectionChange(const pfd: IFileDialog): HResult;
begin
  Result := E_NOTIMPL;
end;

function TFBDialogEvents.OnShareViolation(const pfd: IFileDialog; const psi: IShellItem; out pResponse: DWORD): HResult;
begin
  Result := E_NOTIMPL;
end;

function TFBDialogEvents.OnTypeChange(const pfd: IFileDialog): HResult;
begin
  Result := E_NOTIMPL;
end;

function TFBDialogEvents.OnItemSelected(const pfdc: IFileDialogCustomize; dwIDCtl: DWORD; dwIDItem: DWORD): HResult;
begin
  Result := E_NOTIMPL;
end;

function TFBDialogEvents.OnButtonClicked(const pfdc: IFileDialogCustomize; dwIDCtl: DWORD): HResult;
begin
  if dwIDCtl = dwVisualGroup1ID then begin
    // ...
    Result := S_OK;
  end
  else begin
    Result := E_NOTIMPL;
  end;
end;

function TFBDialogEvents.OnCheckButtonToggled(const pfdc: IFileDialogCustomize; dwIDCtl: DWORD; bChecked: BOOL)
   : HResult;
var
  IsChecked: LongBool;

begin
  pfdc.GetCheckButtonState(FB_CHECKBOX_ID, IsChecked);

  if IsChecked then
    // Do Somethihng
  else
    // Don't Do Anything

       Result := E_NOTIMPL;
end;

function TFBDialogEvents.OnControlActivating(const pfdc: IFileDialogCustomize; dwIDCtl: DWORD): HResult;
begin
  Result := E_NOTIMPL;
end;

end.

Which produces this:

File Dialog (Select Folder)

However, all I want is this:

Browse For Folder