Here's the framework for a Delphi 7 Vista/Win7 dialog component (and a unit that calls it). I've tried to duplicate the TOpenDialog's events (e.g., OnCanClose). The type definitions are not included in the component, but can be found in some newer ShlObj and ActiveX units out there on the net.
I had a problem trying to convert an old style Filter string to a FileTypes array (see below). So for now, you can set the FileTypes array as shown. Any help on filter conversion issue or other improvements are welcome.
Here's the code:
{Example of using the TWin7FileDialog delphi component to access the
Vista/Win7 File Dialog AND handle basic events.}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Win7FileDialog;
type
TForm1 = class(TForm)
btnOpenFile: TButton;
btnSaveFile: TButton;
procedure btnOpenFileClick(Sender: TObject);
procedure btnSaveFileClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure DoDialogCanClose(Sender: TObject; var CanClose: Boolean);
procedure DoDialogFolderChange(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{Using the dialog to open a file}
procedure TForm1.btnOpenFileClick(Sender: TObject);
var
i: integer;
aOpenDialog: TWin7FileDialog;
aFileTypesArray: TComdlgFilterSpecArray;
begin
aOpenDialog:=TWin7FileDialog.Create(Owner);
aOpenDialog.Title:='My Win 7 Open Dialog';
aOpenDialog.DialogType:=dtOpen;
aOpenDialog.OKButtonLabel:='Open';
aOpenDialog.DefaultExt:='pas';
aOpenDialog.InitialDir:='c:\program files\borland\delphi7\source';
aOpenDialog.Options:=[fosPathMustExist, fosFileMustExist];
//aOpenDialog.Filter := 'Text files (*.txt)|*.TXT|
Pascal files (*.pas)|*.PAS|All Files (*.*)|*.*';
// Create an array of file types
SetLength(aFileTypesArray,3);
aFileTypesArray[0].pszName:=PWideChar(WideString('Text Files (*.txt)'));
aFileTypesArray[0].pszSpec:=PWideChar(WideString('*.txt'));
aFileTypesArray[1].pszName:=PWideChar(WideString('Pascal Files (*.pas)'));
aFileTypesArray[1].pszSpec:=PWideChar(WideString('*.pas'));
aFileTypesArray[2].pszName:=PWideChar(WideString('All Files (*.*)'));
aFileTypesArray[2].pszSpec:=PWideChar(WideString('*.*'));
aOpenDialog.FilterArray:=aFileTypesArray;
aOpenDialog.FilterIndex:=1;
aOpenDialog.OnCanClose:=DoDialogCanClose;
aOpenDialog.OnFolderChange:=DoDialogFolderChange;
if aOpenDialog.Execute then
begin
showMessage(aOpenDialog.Filename);
end;
end;
{Example of using the OnCanClose event}
procedure TForm1.DoDialogCanClose(Sender: TObject;
var CanClose: Boolean);
begin
if UpperCase(ExtractFilename(TWin7FileDialog(Sender).Filename))=
'TEMPLATE.SSN' then
begin
MessageDlg('The Template.ssn filename is reserved for use by the system.',
mtInformation, [mbOK], 0);
CanClose:=False;
end
else
begin
CanClose:=True;
end;
end;
{Helper function to get path from ShellItem}
function PathFromShellItem(aShellItem: IShellItem): string;
var
hr: HRESULT;
aPath: PWideChar;
begin
hr:=aShellItem.GetDisplayName(SIGDN_FILESYSPATH,aPath);
if hr = 0 then
begin
Result:=aPath;
end
else
Result:='';
end;
{Example of handling a folder change}
procedure TForm1.DoDialogFolderChange(Sender: TObject);
var
aShellItem: IShellItem;
hr: HRESULT;
aFilename: PWideChar;
begin
hr:=TWin7FileDialog(Sender).FileDialog.GetFolder(aShellItem);
if hr = 0 then
begin
// showmessage(PathFromShellItem(aShellItem));
end;
end;
{Using the dialog to save a file}
procedure TForm1.btnSaveFileClick(Sender: TObject);
var
aSaveDialog: TWin7FileDialog;
aFileTypesArray: TComdlgFilterSpecArray;
begin
aSaveDialog:=TWin7FileDialog.Create(Owner);
aSaveDialog.Title:='My Win 7 Save Dialog';
aSaveDialog.DialogType:=dtSave;
aSaveDialog.OKButtonLabel:='Save';
aSaveDialog.DefaultExt:='pas';
aSaveDialog.InitialDir:='c:\program files\borland\delphi7\source';
aSaveDialog.Options:=[fosNoReadOnlyReturn, fosOverwritePrompt];
//aSaveDialog.Filter := 'Text files (*.txt)|*.TXT|
Pascal files (*.pas)|*.PAS';
{Create an array of file types}
SetLength(aFileTypesArray,3);
aFileTypesArray[0].pszName:=PWideChar(WideString('Text Files (*.txt)'));
aFileTypesArray[0].pszSpec:=PWideChar(WideString('*.txt'));
aFileTypesArray[1].pszName:=PWideChar(WideString('Pascal Files (*.pas)'));
aFileTypesArray[1].pszSpec:=PWideChar(WideString('*.pas'));
aFileTypesArray[2].pszName:=PWideChar(WideString('All Files (*.*)'));
aFileTypesArray[2].pszSpec:=PWideChar(WideString('*.*'));
aSaveDialog.FilterArray:=aFileTypesArray;
aSaveDialog.OnCanClose:=DoDialogCanClose;
aSaveDialog.OnFolderChange:=DoDialogFolderChange;
if aSaveDialog.Execute then
begin
showMessage(aSaveDialog.Filename);
end;
end;
end.
{A sample delphi 7 component to access the
Vista/Win7 File Dialog AND handle basic events.}
unit Win7FileDialog;
interface
uses
SysUtils, Classes, Forms, Dialogs, Windows,DesignIntf, ShlObj,
ActiveX, CommDlg;
{Search the internet for new ShlObj and ActiveX units to get necessary
type declarations for IFileDialog, etc.. These interfaces can otherwise
be embedded into this component.}
Type
TOpenOption = (fosOverwritePrompt,
fosStrictFileTypes,
fosNoChangeDir,
fosPickFolders,
fosForceFileSystem,
fosAllNonStorageItems,
fosNoValidate,
fosAllowMultiSelect,
fosPathMustExist,
fosFileMustExist,
fosCreatePrompt,
fosShareAware,
fosNoReadOnlyReturn,
fosNoTestFileCreate,
fosHideMRUPlaces,
fosHidePinnedPlaces,
fosNoDereferenceLinks,
fosDontAddToRecent,
fosForceShowHidden,
fosDefaultNoMiniMode,
fosForcePreviewPaneOn);
TOpenOptions = set of TOpenOption;
type
TDialogType = (dtOpen,dtSave);
type
TWin7FileDialog = class(TOpenDialog)
private
{ Private declarations }
FOptions: TOpenOptions;
FDialogType: TDialogType;
FOKButtonLabel: string;
FFilterArray: TComdlgFilterSpecArray;
procedure SetOKButtonLabel(const Value: string);
protected
{ Protected declarations }
function CanClose(Filename:TFilename): Boolean;
function DoExecute: Bool;
public
{ Public declarations }
FileDialog: IFileDialog;
FileDialogCustomize: IFileDialogCustomize;
FileDialogEvents: IFileDialogEvents;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function Execute: Boolean; override;
published
{ Published declarations }
property DefaultExt;
property DialogType: TDialogType read FDialogType write FDialogType
default dtOpen;
property FileName;
property Filter;
property FilterArray: TComdlgFilterSpecArray read fFilterArray
write fFilterArray;
property FilterIndex;
property InitialDir;
property Options: TOpenOptions read FOptions write FOptions
default [fosNoReadOnlyReturn, fosOverwritePrompt];
property Title;
property OKButtonLabel: string read fOKButtonLabel write SetOKButtonLabel;
property OnCanClose;
property OnFolderChange;
property OnSelectionChange;
property OnTypeChange;
property OnClose;
property OnShow;
// property OnIncludeItem;
end;
TFileDialogEvent = class(TInterfacedObject, IFileDialogEvents,
IFileDialogControlEvents)
private
{ Private declarations }
// 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,
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;
public
{ Public declarations }
ParentDialog: TWin7FileDialog;
end;
procedure Register;
implementation
constructor TWin7FileDialog.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;
destructor TWin7FileDialog.Destroy;
begin
inherited Destroy;
end;
procedure TWin7FileDialog.SetOKButtonLabel(const Value: string);
begin
if Value<>fOKButtonLabel then
begin
fOKButtonLabel := Value;
end;
end;
function TWin7FileDialog.CanClose(Filename: TFilename): Boolean;
begin
Result := DoCanClose;
end;
{Helper function to get path from ShellItem}
function PathFromShellItem(aShellItem: IShellItem): string;
var
hr: HRESULT;
aPath: PWideChar;
begin
hr:=aShellItem.GetDisplayName(SIGDN_FILESYSPATH,aPath);
if hr = 0 then
begin
Result:=aPath;
end
else
Result:='';
end;
function TFileDialogEvent.OnFileOk(const pfd: IFileDialog): HResult; stdcall
var
aShellItem: IShellItem;
hr: HRESULT;
aFilename: PWideChar;
begin
{Get selected filename and check CanClose}
aShellItem:=nil;
hr:=pfd.GetResult(aShellItem);
if hr = 0 then
begin
hr:=aShellItem.GetDisplayName(SIGDN_FILESYSPATH,aFilename);
if hr = 0 then
begin
ParentDialog.Filename:=aFilename;
if not ParentDialog.CanClose(aFilename) then
begin
result := s_FALSE;
Exit;
end;
end;
end;
result := s_OK;
end;
function TFileDialogEvent.OnFolderChanging(const pfd: IFileDialog;
const psiFolder: IShellItem): HResult; stdcall
begin
{Not currently handled}
result := s_OK;
end;
function TFileDialogEvent.OnFolderChange(const pfd: IFileDialog):
HResult; stdcall
begin
ParentDialog.DoFolderChange;
result := s_OK;
end;
function TFileDialogEvent.OnSelectionChange(const pfd: IFileDialog):
HResult; stdcall
begin
ParentDialog.DoSelectionChange;
result := s_OK;
end;
function TFileDialogEvent.OnShareViolation(const pfd: IFileDialog;
const psi: IShellItem;out pResponse: DWORD): HResult; stdcall
begin
{Not currently handled}
result := s_OK;
end;
function TFileDialogEvent.OnTypeChange(const pfd: IFileDialog):
HResult; stdcall;
begin
ParentDialog.DoTypeChange;
result := s_OK;
end;
function TFileDialogEvent.OnOverwrite(const pfd: IFileDialog;
const psi: IShellItem;out pResponse: DWORD): HResult; stdcall;
begin
{Not currently handled}
result := s_OK;
end;
function TFileDialogEvent.OnItemSelected(const pfdc: IFileDialogCustomize;
dwIDCtl,dwIDItem: DWORD): HResult; stdcall;
begin
{Not currently handled}
// Form1.Caption := Format('%d:%d', [dwIDCtl, dwIDItem]);
result := s_OK;
end;
function TFileDialogEvent.OnButtonClicked(const pfdc: IFileDialogCustomize;
dwIDCtl: DWORD): HResult; stdcall;
begin
{Not currently handled}
result := s_OK;
end;
function TFileDialogEvent.OnCheckButtonToggled(const pfdc: IFileDialogCustomize;
dwIDCtl: DWORD; bChecked: BOOL): HResult; stdcall;
begin
{Not currently handled}
result := s_OK;
end;
function TFileDialogEvent.OnControlActivating(const pfdc: IFileDialogCustomize;
dwIDCtl: DWORD): HResult; stdcall;
begin
{Not currently handled}
result := s_OK;
end;
procedure ParseDelimited(const sl : TStrings; const value : string;
const delimiter : string) ;
var
dx : integer;
ns : string;
txt : string;
delta : integer;
begin
delta := Length(delimiter) ;
txt := value + delimiter;
sl.BeginUpdate;
sl.Clear;
try
while Length(txt) > 0 do
begin
dx := Pos(delimiter, txt) ;
ns := Copy(txt,0,dx-1) ;
sl.Add(ns) ;
txt := Copy(txt,dx+delta,MaxInt) ;
end;
finally
sl.EndUpdate;
end;
end;
//function TWin7FileDialog.DoExecute(Func: Pointer): Bool;
function TWin7FileDialog.DoExecute: Bool;
var
aFileDialogEvent: TFileDialogEvent;
aCookie: cardinal;
aWideString: WideString;
aFilename: PWideChar;
hr: HRESULT;
aShellItem: IShellItem;
aShellItemFilter: IShellItemFilter;
aComdlgFilterSpec: TComdlgFilterSpec;
aComdlgFilterSpecArray: TComdlgFilterSpecArray;
i: integer;
aStringList: TStringList;
aFileTypesCount: integer;
aFileTypesArray: TComdlgFilterSpecArray;
aOptionsSet: Cardinal;
begin
if DialogType = dtSave then
begin
CoCreateInstance(CLSID_FileSaveDialog, nil, CLSCTX_INPROC_SERVER,
IFileSaveDialog, FileDialog);
end
else
begin
CoCreateInstance(CLSID_FileOpenDialog, nil, CLSCTX_INPROC_SERVER,
IFileOpenDialog, FileDialog);
end;
// FileDialog.QueryInterface(
// StringToGUID('{8016B7B3-3D49-4504-A0AA-2A37494E606F}'),
// FileDialogCustomize);
// FileDialogCustomize.AddText(1000, 'My first Test');
{Set Initial Directory}
aWideString:=InitialDir;
aShellItem:=nil;
hr:=SHCreateItemFromParsingName(PWideChar(aWideString), nil,
StringToGUID(SID_IShellItem), aShellItem);
FileDialog.SetFolder(aShellItem);
{Set Title}
aWideString:=Title;
FileDialog.SetTitle(PWideChar(aWideString));
{Set Options}
aOptionsSet:=0;
if fosOverwritePrompt in Options then aOptionsSet:=
aOptionsSet + FOS_OVERWRITEPROMPT;
if fosStrictFileTypes in Options then aOptionsSet:=
aOptionsSet + FOS_STRICTFILETYPES;
if fosNoChangeDir in Options then aOptionsSet:=
aOptionsSet + FOS_NOCHANGEDIR;
if fosPickFolders in Options then aOptionsSet:=
aOptionsSet + FOS_PICKFOLDERS;
if fosForceFileSystem in Options then aOptionsSet:=
aOptionsSet + FOS_FORCEFILESYSTEM;
if fosAllNonStorageItems in Options then aOptionsSet:=
aOptionsSet + FOS_ALLNONSTORAGEITEMS;
if fosNoValidate in Options then aOptionsSet:=
aOptionsSet + FOS_NOVALIDATE;
if fosAllowMultiSelect in Options then aOptionsSet:=
aOptionsSet + FOS_ALLOWMULTISELECT;
if fosPathMustExist in Options then aOptionsSet:=
aOptionsSet + FOS_PATHMUSTEXIST;
if fosFileMustExist in Options then aOptionsSet:=
aOptionsSet + FOS_FILEMUSTEXIST;
if fosCreatePrompt in Options then aOptionsSet:=
aOptionsSet + FOS_CREATEPROMPT;
if fosShareAware in Options then aOptionsSet:=
aOptionsSet + FOS_SHAREAWARE;
if fosNoReadOnlyReturn in Options then aOptionsSet:=
aOptionsSet + FOS_NOREADONLYRETURN;
if fosNoTestFileCreate in Options then aOptionsSet:=
aOptionsSet + FOS_NOTESTFILECREATE;
if fosHideMRUPlaces in Options then aOptionsSet:=
aOptionsSet + FOS_HIDEMRUPLACES;
if fosHidePinnedPlaces in Options then aOptionsSet:=
aOptionsSet + FOS_HIDEPINNEDPLACES;
if fosNoDereferenceLinks in Options then aOptionsSet:=
aOptionsSet + FOS_NODEREFERENCELINKS;
if fosDontAddToRecent in Options then aOptionsSet:=
aOptionsSet + FOS_DONTADDTORECENT;
if fosForceShowHidden in Options then aOptionsSet:=
aOptionsSet + FOS_FORCESHOWHIDDEN;
if fosDefaultNoMiniMode in Options then aOptionsSet:=
aOptionsSet + FOS_DEFAULTNOMINIMODE;
if fosForcePreviewPaneOn in Options then aOptionsSet:=
aOptionsSet + FOS_FORCEPREVIEWPANEON;
FileDialog.SetOptions(aOptionsSet);
{Set OKButtonLabel}
aWideString:=OKButtonLabel;
FileDialog.SetOkButtonLabel(PWideChar(aWideString));
{Set Default Extension}
aWideString:=DefaultExt;
FileDialog.SetDefaultExtension(PWideChar(aWideString));
{Set Default Filename}
aWideString:=FileName;
FileDialog.SetFilename(PWideChar(aWideString));
{Note: Attempting below to automatically parse an old style filter string into
the newer FileType array; however the below code overwrites memory when the
stringlist item is typecast to PWideChar and assigned to an element of the
FileTypes array. What's the correct way to do this??}
{Set FileTypes (either from Filter or FilterArray)}
if length(Filter)>0 then
begin
{
aStringList:=TStringList.Create;
try
ParseDelimited(aStringList,Filter,'|');
aFileTypesCount:=Trunc(aStringList.Count/2)-1;
i:=0;
While i <= aStringList.Count-1 do
begin
SetLength(aFileTypesArray,Length(aFileTypesArray)+1);
aFileTypesArray[Length(aFileTypesArray)-1].pszName:=
PWideChar(WideString(aStringList[i]));
aFileTypesArray[Length(aFileTypesArray)-1].pszSpec:=
PWideChar(WideString(aStringList[i+1]));
Inc(i,2);
end;
FileDialog.SetFileTypes(length(aFileTypesArray),aFileTypesArray);
finally
aStringList.Free;
end;
}
end
else
begin
FileDialog.SetFileTypes(length(FilterArray),FilterArray);
end;
{Set FileType (filter) index}
FileDialog.SetFileTypeIndex(FilterIndex);
aFileDialogEvent:=TFileDialogEvent.Create;
aFileDialogEvent.ParentDialog:=self;
aFileDialogEvent.QueryInterface(IFileDialogEvents,FileDialogEvents);
FileDialog.Advise(aFileDialogEvent,aCookie);
hr:=FileDialog.Show(Application.Handle);
if hr = 0 then
begin
aShellItem:=nil;
hr:=FileDialog.GetResult(aShellItem);
if hr = 0 then
begin
hr:=aShellItem.GetDisplayName(SIGDN_FILESYSPATH,aFilename);
if hr = 0 then
begin
Filename:=aFilename;
end;
end;
Result:=true;
end
else
begin
Result:=false;
end;
FileDialog.Unadvise(aCookie);
end;
function TWin7FileDialog.Execute: Boolean;
begin
Result := DoExecute;
end;
procedure Register;
begin
RegisterComponents('Dialogs', [TWin7FileDialog]);
end;
end.