Gemeinsame Dialoge von Delphi 7 und Vista/Windows 7 - Ereignisse funktionieren nicht

Question

Ich versuche, die Delphi 7 Dialogs.pas zu modifizieren, um auf die neueren Windows 7 Öffnen/Speichern-Dialogfelder zuzugreifen (siehe Erstellen von Windows Vista-fähigen Anwendungen mit Delphi) . Ich kann die Dialoge mit den vorgeschlagenen Änderungen anzeigen; Ereignisse wie OnFolderChange und OnCanClose funktionieren jedoch nicht mehr.

Dies scheint mit der Änderung der Flags zu tun: = OFN_ENABLEHOOK zu Flags: = 0. Wenn Flags auf 0 gesetzt ist, wird der TOpenDialog.Wndproc umgangen und die entsprechenden CDN_xxxxxxx-Nachrichten werden nicht abgefangen.

Kann jemand weitere Code-Änderungen an den D7-Dialogs.pas vorschlagen, die sowohl die neueren allgemeinen Dialoge anzeigen als auch die Ereignisfunktionen der ursprünglichen Steuerelemente beibehalten?

Dank ...

Answer 1

Sie sollten die IFileDialog Interface verwenden und rufen seine Advise() Methode mit einer Implementierung des IFileDialogEvents Interface. Die Windows-Header-Einheiten von Delphi 7 enthalten nicht die notwendigen Deklarationen, also müssen sie von den SDK-Header-Dateien kopiert (und übersetzt) ​​werden (oder vielleicht gibt es schon eine andere Header-Übersetzung verfügbar?), Aber abgesehen von diesem zusätzlichen Aufwand sollte es nicht Irgendein Problem, um dies von Delphi 7 (oder sogar früheren Delphi-Versionen) aufzurufen.

Edit:

OK, da Sie nicht auf die Antworten in irgendeiner Weise reagieren habe ich werde einige weitere Informationen hinzufügen. Ein C-Beispiel zur Verwendung der Schnittstellen kann here sein. Es ist einfach, es in Delphi-Code zu übersetzen, sofern Sie über die erforderlichen Importeinheiten verfügen.

Ich warf zusammen eine kleine Probe in Delphi 4. Der Einfachheit halber habe ich eine TOpenDialog Nachkomme (Sie würden die ursprüngliche Klasse wahrscheinlich ändern) und implementiert die IFileDialogEvents direkt darauf:

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; 

Wenn Sie dies auf ausführen Windows 7 wird das neue Dialogfeld anzeigen und nur Dateien mit der Erweiterung txt akzeptieren. Dies ist hart codiert und muss implementiert werden, indem das Ereignis OnClose des Dialogfelds durchlaufen wird. Es gibt noch viel mehr zu tun, aber der bereitgestellte Code sollte als Ausgangspunkt ausreichen.

Answer 2

Ich war ein bisschen herum suchen, und machte diese schnelle Patch für FPC/Lazarus, aber natürlich können Sie dies als Grundlage für D7 Upgrade verwenden:

(Gelöscht, aktuelle FPC Quellen verwenden, da Fehlerbehebung waren auf diese Funktionalität angewendet)

Hinweis: ungetestet und kann Symbole enthalten, die nicht in D7 enthalten sind.

Answer 3

Hier ist das Framework für eine Delphi 7 Vista/Win7-Dialogkomponente (und eine Einheit, die es aufruft). Ich habe versucht, die Ereignisse des TOpenDialogs zu duplizieren (z. B. OnCanClose). Die Typdefinitionen sind nicht in der Komponente enthalten, können aber in einigen neueren ShlObj- und ActiveX-Einheiten im Internet gefunden werden.

Ich hatte ein Problem beim Versuch, eine alte Stil-Filter-Zeichenfolge in ein FileTypes-Array zu konvertieren (siehe unten). Jetzt können Sie das Array "FileTypes" wie gezeigt einstellen. Jede Hilfe bei der Filterkonvertierung oder andere Verbesserungen sind willkommen.

Hier ist der 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 - Das Problem mit dem Filter Code wurde im Zusammenhang mit dem Gießen zu einer PWideChar einer Umwandlung in Wide. Der konvertierte Widestring wurde keinem zugewiesen und wäre daher auf dem Stack oder Heap gespeichert worden. Das Speichern eines Zeigers auf einen temporären Wert auf dem Stack oder Heap ist von Natur aus gefährlich!

Wie von loursonwinny vorgeschlagen, könnten Sie StringToOleStr verwenden, aber dies allein führt zu einem Speicherverlust, da der Speicher, der den erstellten OleStr enthält, niemals freigegeben würde.

Meine überarbeitete Version dieses Abschnitts des Codes ist:

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

Vielen Dank für Sie Codebeispiel, wie es mir eine Menge Arbeit erspart !!