Dialoghi comuni di Delphi 7 e Vista/Windows 7 - gli eventi non funzionano

Question

Sto provando a modificare Delphi 7 Dialogs.pas per accedere alle nuove finestre di dialogo Apri/Salva di Windows 7 (vedere Creazione di applicazioni Windows Vista Ready con Delphi) . Posso visualizzare le finestre di dialogo usando le modifiche suggerite; tuttavia, eventi come OnFolderChange e OnCanClose non funzionano più.

Questo sembra essere correlato alla modifica dei flag: = OFN_ENABLEHOOK a Flags: = 0. Quando Flags è impostato su 0, TOpenDialog.Wndproc viene ignorato e i messaggi CDN_xxxxxxx appropriati non vengono intrappolati.

Qualcuno può suggerire ulteriori modifiche al codice per D7 Dialogs.pas che visualizzeranno entrambe le finestre di dialogo comuni più recenti e manterranno le funzionalità degli eventi dei controlli originali?

Grazie ...

Answer 1

si dovrebbe usare il IFileDialog Interface e chiamare il suo metodo Advise() con un'implementazione del IFileDialogEvents Interface. Le unità di intestazione di Delphi 7 Windows non conterranno le dichiarazioni necessarie, quindi devono essere copiate (e tradotte) dai file di intestazione dell'SDK (o forse è già disponibile un'altra traduzione di intestazione?), Ma a parte questo sforzo aggiuntivo non dovrebbe avere qualche problema a chiamarlo da Delphi 7 (o anche versioni precedenti di Delphi).

Edit:

OK, visto che non ha reagito in alcun modo le risposte che aggiungerò qualche informazione in più. Un esempio C su come utilizzare le interfacce può essere avuto here. È facile da tradurre in codice Delphi, a condizione che tu abbia le unità di importazione necessarie.

ho buttato insieme un piccolo campione in Delphi 4. Per semplicità ho creato un discendente TOpenDialog (si sarebbe probabilmente modificare la classe originale) e attuato la IFileDialogEvents direttamente su di esso:

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; 

Se si esegue questo su Windows 7 mostrerà la nuova finestra di dialogo e accetterà solo i file con l'estensione txt. Questo è hard-coded e deve essere implementato passando attraverso l'evento OnClose della finestra di dialogo. C'è ancora molto da fare, ma il codice fornito dovrebbe essere sufficiente come punto di partenza.

Answer 2

stavo guardando un po 'intorno, e ho fatto questo rapido patch per FPC/Lazarus, ma naturalmente è possibile utilizzare questo come base per D7 aggiornamento troppo:

(eliminata, utilizzare fonti FPC di corrente, in quanto correzioni erano applicato a questa funzionalità)

Nota: non testata e potrebbe contenere simboli non in D7.

Answer 3

Ecco il framework per un componente di dialogo Delphi 7 Vista/Win7 (e un'unità che lo chiama). Ho provato a duplicare gli eventi del TOpenDialog (ad esempio, OnCanClose). Le definizioni di tipo non sono incluse nel componente, ma possono essere trovate in alcune nuove unità ShlObj e ActiveX disponibili in rete.

Ho riscontrato un problema nel tentativo di convertire una stringa di filtro vecchio stile in un array FileTypes (vedere di seguito). Quindi per ora, puoi impostare l'array FileTypes come mostrato. Qualsiasi aiuto sul problema della conversione dei filtri o altri miglioramenti sono i benvenuti.

Ecco il codice:

{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 - Il problema con il vostro codice di filtraggio era legato al casting per un PWideChar di una conversione WideString. La widestring convertita non è stata assegnata a nulla, quindi sarebbe stata nello stack o nell'heap, il salvataggio di un puntatore su un valore temporaneo sullo stack o sull'heap è intrinsecamente pericoloso!

Come suggerito da loursonwinny, è possibile utilizzare StringToOleStr, ma da solo causerà una perdita di memoria, in quanto la memoria contenente OleStr creato non verrà mai rilasciata.

La mia versione rielaborata di questa sezione del codice è:

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

Molte grazie per voi esempio di codice in quanto mi ha salvato un sacco di lavoro !!