Checkbox Created with CreateWindow Disappears on Resize - checkbox

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