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

Question

Я пытаюсь изменить Delphi 7 Dialogs.pas для доступа к новым диалоговым окнам Windows 7 "Открыть / Сохранить" (см. "Создание готовых приложений для Windows Vista с Delphi"). Я могу отображать диалоги, используя предложенные модификации; однако такие события, как OnFolderChange и OnCanClose, больше не работают.

Похоже, это связано с изменением Flags:= OFN_ENABLEHOOK на Flags:=0. Когда Flags установлен в 0, TOpenDialog.Wndproc обходится, и соответствующие сообщения CDN_xxxxxxx не перехватываются.

Кто-нибудь может предложить дальнейшие модификации кода в D7 Dialogs.pas, которые будут отображать более новые общие диалоги и поддерживать функции событий оригинальных элементов управления?

Спасибо...

Answer 1

Вы должны использовать интерфейс IFileDialog и вызвать его Advise() метод с реализацией интерфейса IFileDialogEvents. Заголовочные блоки Delphi 7 для Windows не будут содержать необходимых объявлений, поэтому они должны быть скопированы (и переведены) из заголовочных файлов SDK (или, возможно, уже есть другой доступный перевод заголовков?), Но кроме этих дополнительных усилий не должно быть Возникли проблемы с вызовом этого из Delphi 7 (или даже более ранних версий Delphi).

Редактировать:

Хорошо, поскольку вы никак не отреагировали на ответы, я добавлю еще немного информации. Образец A 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 - проблема с вашим фильтрующим кодом была связана с приведением к PWideChar преобразования в WideString. Преобразованная широкая строка не была назначена чему-либо, поэтому она находилась бы в стеке или куче, сохраняя указатель на временное значение в стеке или куче по своей природе опасно!

Как предлагает 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.