Delphi 7 和 Vista/Windows 7 常用对话框 - 事件不起作用

Question

我正在尝试修改 Delphi 7 Dialogs.pas 以访问较新的 Windows 7 打开/保存对话框（请参阅使用 Delphi 创建 Windows Vista Ready 应用程序）。我可以使用建议的修改来显示对话框；但是，OnFolderChange 和 OnCanClose 等事件不再起作用。

这似乎与将 Flags:= OFN_ENABLEHOOK 更改为 Flags:=0 有关。当 Flags 设置为 0 时，会绕过 TOpenDialog.Wndproc，并且不会捕获相应的 CDN_xxxxxxx 消息。

任何人都可以建议对 D7 Dialogs.pas 进行进一步的代码修改，以显示较新的通用对话框并保持原始控件的事件功能吗？

谢谢...

Answer 1

您应该使用IFileDialog Interface 并使用IFileDialogEvents Interface 的实现调用其Advise() 方法。 Delphi 7 Windows 标头单元不包含必要的声明，因此必须从 SDK 标头文件中复制（和翻译）它们（或者可能已经有另一个标头翻译可用？），但除了额外的努力之外，不应该从 Delphi 7（甚至更早的 Delphi 版本）调用它有什么问题。

编辑：

好的，由于您对答案没有任何反应，我将添加更多信息。可以在here 获得有关如何使用接口的 C 示例。只要您有必要的导入单元，就可以很容易地将其转换为 Delphi 代码。

我在 Delphi 4 中拼凑了一个小示例。为简单起见，我创建了一个 TOpenDialog 后代（您可能会修改原始类）并直接在其上实现 IFileDialogEvents：

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;

如果您在 Windows 7 上运行它，它将显示新对话框并仅接受扩展名为 txt 的文件。这是硬编码的，需要通过对话框的OnClose 事件来实现。还有很多工作要做，但提供的代码应该足以作为起点。

Answer 2

这是 Delphi 7 Vista/Win7 对话框组件（以及调用它的单元）的框架。我试图复制 TOpenDialog 的事件（例如 OnCanClose）。类型定义不包含在组件中，但可以在网上一些较新的 ShlObj 和 ActiveX 单元中找到。

我在尝试将旧式过滤器字符串转换为 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.

Answer 3

JeffR - 您的过滤代码的问题与将转换为 WideString 的转换为 PWideChar 有关。 转换后的宽字符串没有分配给任何东西，所以本来会在堆栈或堆上，将指向堆栈或堆上的临时值的指针保存在本质上是危险的！

按照 loursonwinny 的建议，您可以使用 StringToOleStr，但仅此一项就会导致内存泄漏，因为包含创建的 OleStr 的内存永远不会被释放。

我对这部分代码的修改版本是：

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

非常感谢您提供的代码示例，因为它为我节省了大量工作！

Answer 4

我环顾四周，为 FPC/Lazarus 制作了这个快速补丁，当然你也可以以此作为 D7 升级的基础：

（已删除，使用当前 FPC 源，因为此功能已应用错误修复）

注意：未经测试，可能包含 D7 中没有的符号。