Delphi 7 and Vista/Windows 7 common dialogs - events do not work

I'm trying to modify the Delphi 7 Dialogs.pas to access the newer Windows 7 Open/Save dialog boxes (see Creating Windows Vista Ready Applications with Delphi). I can display the dialogs using the suggested modifications; however, events such as OnFolderChange and OnCanClose no longer function.

This appears to be related to changing开发者_JAVA百科 the Flags:= OFN_ENABLEHOOK to Flags:=0. When Flags is set to 0 the TOpenDialog.Wndproc is bypassed and the appropriate CDN_xxxxxxx messages are not trapped.

Can anyone suggest further code modifications to the D7 Dialogs.pas that will both display the newer common dialogs and maintain the event features of the original controls?

Thanks...

You should use the IFileDialog Interface and call its Advise() method with an implementation of the IFileDialogEvents Interface. The Delphi 7 Windows header units won't contain the necessary declarations, so they must be copied (and translated) from the SDK header files (or maybe there's already another header translation available?), but apart from that additional effort there shouldn't be any problem to call this from Delphi 7 (or even earlier Delphi versions).

Edit:

OK, since you didn't react in any way to the answers I'll add some more information. A C sample on how to use the interfaces can be had here. It's easy to translate it to Delphi code, provided you have the necessary import units.

I threw together a small sample in Delphi 4. For simplicity I created a TOpenDialog descendant (you would probably modify the original class) and implemented the IFileDialogEvents directly on it:

type
  TVistaOpenDialog = class(TOpenDialog, IFileDialogEvents)
  private
    // IFileDialogEvents implementation
    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;
  public
    function Execute: Boolean; override;
  end;

function TVistaOpenDialog.Execute: Boolean;
var
  guid: TGUID;
  Ifd: IFileDialog;
  hr: HRESULT;
  Cookie: Cardinal;
  Isi: IShellItem;
  pWc: PWideChar;
  s: WideString;
begin
  CLSIDFromString(SID_IFileDialog, guid);
  hr := CoCreateInstance(CLSID_FileOpenDialog, nil, CLSCTX_INPROC_SERVER,
    guid, Ifd);
  if Succeeded(hr) then begin
    Ifd.Advise(Self, Cookie);
    // call DisableTaskWindows() etc.
    // see implementation of Application.MessageBox()
    try
      hr := Ifd.Show(Application.Handle);
    finally
      // call EnableTaskWindows() etc.
      // see implementation of Application.MessageBox()
    end;
    Ifd.Unadvise(Cookie);
    if Succeeded(hr) then begin
      hr := Ifd.GetResult(Isi);
      if Succeeded(hr) then begin
        Assert(Isi <> nil);
        // TODO: just for testing, needs to be implemented properly
        if Succeeded(Isi.GetDisplayName(SIGDN_NORMALDISPLAY, pWc))
          and (pWc <> nil)
        then begin
          s := pWc;
          FileName := s;
        end;
      end;
    end;
    Result := Succeeded(hr);
    exit;
  end;
  Result := inherited Execute;
end;

function TVistaOpenDialog.OnFileOk(const pfd: IFileDialog): HResult;
var
  pszName: PWideChar;
  s: WideString;
begin
  if Succeeded(pfd.GetFileName(pszName)) and (pszName <> nil) then begin
    s := pszName;
    if AnsiCompareText(ExtractFileExt(s), '.txt') = 0 then begin
      Result := S_OK;
      exit;
    end;
  end;
  Result := S_FALSE;
end;

function TVistaOpenDialog.OnFolderChange(const pfd: IFileDialog): HResult;
begin
  Result := S_OK;
end;

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

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

function TVistaOpenDialog.OnSelectionChange(
  const pfd: IFileDialog): HResult;
begin
  Result := S_OK;
end;

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

function TVistaOpenDialog.OnTypeChange(const pfd: IFileDialog): HResult;
begin
  Result := S_OK;
end;

If you run this on Windows 7 it will show the new dialog and accept only files with the txt extension. This is hard-coded and needs to be implemented by going through the OnClose event of the dialog. There's lots more to be done, but the provided code should suffice as a starting point.

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.

JeffR - The problem with your filtering code was related to the casting to a PWideChar of a conversion to WideString. The Converted widestring was not assigned to anything, so would have been on the stack or heap, saving a pointer to a temporary value on the stack or heap is inherently dangerous!

As suggested by loursonwinny, you could use StringToOleStr, but this alone will cause a memory leak, as the memory containing the created OleStr would never be released.

My reworked version of this section of the code is:

{Set FileTypes (either from Filter or FilterArray)}
  if length(Filter)>0 then
  begin
    aStringList:=TStringList.Create;
    try
      ParseDelimited(aStringList,Filter,'|');
      i:=0;
      While i <= aStringList.Count-1 do
      begin
        SetLength(aFileTypesArray,Length(aFileTypesArray)+1);
        aFileTypesArray[Length(aFileTypesArray)-1].pszName:=
          StringToOleStr(aStringList[i]);
        aFileTypesArray[Length(aFileTypesArray)-1].pszSpec:=
          StringToOleStr(aStringList[i+1]);
        Inc(i,2);
      end;
      FileDialog.SetFileTypes(length(aFileTypesArray),aFileTypesArray);
    finally
      for i := 0 to Length(aFileTypesArray) - 1 do
      begin
        SysFreeString(aFileTypesArray[i].pszName);
        SysFreeString(aFileTypesArray[i].pszSpec);
      end;
      aStringList.Free;
    end;
  end
  else
  begin
    FileDialog.SetFileTypes(length(FilterArray),FilterArray);
  end;

Many thanks for you code sample as it saved me a lot of work!!

I was looking around a bit, and made this quick patch for FPC/Lazarus, but of course you can use this as basis for D7 upgrading too:

(Deleted, use current FPC sources, since bugfixes were applied to this functionality)

Note: untested, and might contain symbols not in D7.