Boîtes de dialogue communes à Delphi 7 et Vista/Windows 7 - les événements ne fonctionnent pas

Question

J'essaie de modifier le Delphi 7 Dialogs.pas pour accéder aux boîtes de dialogue Ouvrir/Enregistrer Windows 7 plus récentes (voir Création d'applications Windows Vista prêtes avec Delphi) . Je peux afficher les boîtes de dialogue en utilisant les modifications suggérées; Toutefois, les événements tels que OnFolderChange et OnCanClose ne fonctionnent plus.

Ceci semble être lié à la modification des drapeaux: = OFN_ENABLEHOOK à Flags: = 0. Lorsque Flags est défini sur 0, TOpenDialog.Wndproc est ignoré et les messages CDN_xxxxxxx appropriés ne sont pas interceptés.

Quelqu'un peut-il suggérer d'autres modifications de code aux D7 Dialogs.pas qui afficheront les boîtes de dialogue communes les plus récentes et conserveront les fonctions d'événement des commandes d'origine?

Merci ...

Answer 1

Vous devez utiliser le IFileDialog Interface et appeler sa méthode Advise() avec une mise en œuvre du IFileDialogEvents Interface. Les unités d'en-tête Delphi 7 Windows ne contiennent pas les déclarations nécessaires, elles doivent donc être copiées (et traduites) à partir des fichiers d'en-tête du SDK (ou peut-être une autre traduction d'en-tête est-elle disponible?). être n'importe quel problème pour appeler cela à partir de Delphi 7 (ou même des versions antérieures de Delphi).

Edit:

OK, puisque vous ne réagissez en aucune façon les réponses que je vais ajouter un peu plus d'informations. Un échantillon C sur la façon d'utiliser les interfaces peut être obtenu here. Il est facile de le traduire en code Delphi, à condition d'avoir les unités d'importation nécessaires.

Je jeté ensemble un petit échantillon de Delphi 4. Pour simplifier, je créé un TOpenDialog descendant (vous modifieraient probablement la classe d'origine) et mis en œuvre le IFileDialogEvents directement sur elle:

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; 

Si vous exécutez ce sur Windows 7 affichera la nouvelle boîte de dialogue et n'acceptera que les fichiers portant l'extension txt. Ceci est codé en dur et doit être implémenté en passant par l'événement OnClose de la boîte de dialogue. Il y a encore beaucoup à faire, mais le code fourni devrait suffire comme point de départ.

Answer 2

Je cherchais un peu, et fait ce patch rapide pour FPC/Lazarus, mais bien sûr, vous pouvez l'utiliser comme base pour la mise à niveau D7 aussi:

(supprimé, utiliser des sources FPC actuelles, étant donné que des corrections de bugs ont été appliqué à cette fonctionnalité)

Note: non testé, et pourrait contenir des symboles non en D7.

Answer 3

Voici le cadre d'un composant de dialogue Delphi 7 Vista/Win7 (et une unité qui l'appelle). J'ai essayé de dupliquer les événements de TOpenDialog (par exemple, OnCanClose). Les définitions de type ne sont pas incluses dans le composant, mais peuvent être trouvées dans certaines nouvelles unités ShlObj et ActiveX sur le net.

J'ai rencontré un problème lors de la tentative de conversion d'une chaîne de filtre de style ancien en un tableau FileTypes (voir ci-dessous). Donc, pour l'instant, vous pouvez définir le tableau FileTypes comme indiqué. Toute aide sur le problème de conversion de filtre ou d'autres améliorations sont les bienvenues.

Voici le 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. 

Answer 4

jeffr - Le problème avec votre code de filtrage a été lié à la coulée à une PWideChar d'une conversion à WideString. Le Widetring converti n'a été affecté à rien, donc aurait été sur la pile ou le tas, enregistrer un pointeur vers une valeur temporaire sur la pile ou le tas est intrinsèquement dangereux!

Comme suggéré par loursonwinny, vous pouvez utiliser StringToOleStr, mais cela seul causera une fuite de mémoire, car la mémoire contenant l'OleStr créé ne sera jamais libérée.

Ma version retravaillée de cette section du code est:

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

Un grand merci pour vous exemple de code comme il m'a sauvé beaucoup de travail !!