Delphi 7 и Vista/Windows 7 стандартных диалогов - события не работают

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.

Я немного осмотрелся и сделал этот быстрый патч для FPC / Lazarus, но, конечно, вы можете использовать его как основу для обновления D7:

(Удалено, используйте текущий FPC исходники, так как к этой функции были применены исправления)

Примечание: не проверено и может содержать символы, не входящие в D7.

Вот фреймворк для компонента диалога Delphi 7 Vista/Win7 (и вызывающего его устройства). Я пытался дублировать события TOpenDialog (например, OnCanClose). Определения типов не включены в компонент, но можно найти в некоторых более новых ShlObj и ActiveX модулях в сети.

У меня возникла проблема при попытке преобразовать старую строку стиля Filter в массив FileTypes (см. ниже). Поэтому пока что вы можете установить массив FileTypes, как показано на рисунке. Любая помощь по вопросу преобразования фильтров или другие улучшения приветствуются.

Вот код:

{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.