Delphi 7 i Vista/Windows 7 wspólne okna dialogowe - zdarzenia nie działają

Question

Próbuję zmodyfikować Delphi 7 Dialogs.pas, aby uzyskać dostęp do nowszych okien dialogowych Windows 7 Open/Save (patrz Tworzenie aplikacji Windows Vista Ready z Delphi) . Mogę wyświetlić okna dialogowe za pomocą sugerowanych modyfikacji; jednak zdarzenia takie jak OnFolderChange i OnCanClose nie działają.

Wygląda na to, że ma to związek ze zmianą flag: = OFN_ENABLEHOOK na flagi: = 0. Kiedy Flagi są ustawione na 0, TOpenDialog.Wndproc jest ominięty, a odpowiednie wiadomości CDN_xxxxxxx nie są uwięzione.

Czy ktokolwiek może sugerować dalsze modyfikacje kodu w D7 Dialogs.pas, które będą wyświetlały nowsze, wspólne okna dialogowe i utrzymują funkcje zdarzeń oryginalnych elementów sterujących?

Dzięki ...

Answer 1

należy użyć IFileDialog Interface i wywołać jego metodę Advise() z realizacji IFileDialogEvents Interface. Jednostki nagłówkowe systemu Windows Delphi 7 nie będą zawierały niezbędnych deklaracji, więc muszą zostać skopiowane (i przetłumaczone) z plików nagłówkowych SDK (lub może jest już dostępne inne tłumaczenie nagłówka?), Ale oprócz tego dodatkowego wysiłku nie powinno być problemem, aby wywołać to z Delphi 7 (lub nawet wcześniejszych wersji Delphi).

Edit:

OK, skoro nie zareagował w żaden sposób odpowiedzi dodam trochę więcej informacji. Próbka C dotycząca korzystania z interfejsów może mieć numer here. Łatwo jest przetłumaczyć go na kod Delphi pod warunkiem, że posiadasz niezbędne jednostki importu.

wrzuciłem razem małą próbkę w Delphi 4. Dla uproszczenia I stworzył TOpenDialog potomka (to prawdopodobnie modyfikować oryginalnej klasy) i wdrożył IFileDialogEvents bezpośrednio na niej:

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; 

Jeśli uruchomić to na Windows 7 wyświetli nowe okno dialogowe i zaakceptuje tylko pliki z rozszerzeniem txt. Jest to zakodowane na stałe i należy je wdrożyć, przechodząc przez zdarzenie OnClose w oknie dialogowym. Jest jeszcze wiele do zrobienia, ale dostarczony kod powinien wystarczyć jako punkt wyjścia.

Answer 2

szukałem wokół kawałka, i uczynił to szybką poprawkę dla FPC/Lazarus, ale oczywiście można wykorzystać jako podstawę do D7 modernizacji TOO:

(skreślony, stosowanie istniejących źródeł FPC, ponieważ poprawki były zastosowane do tej funkcji)

Uwaga: nietestowane i mogą zawierać symbole spoza D7.

Answer 3

Oto schemat dla okna dialogowego Delphi 7 Vista/Win7 (i jednostki, która go wywołuje). Próbowałem zduplikować zdarzenia TOpenDialog (np. OnCanClose). Definicje typów nie są zawarte w komponencie, ale można je znaleźć w niektórych nowszych jednostkach ShlObj i ActiveX w sieci.

Wystąpił problem podczas próby przekonwertowania starego stylu ciągu filtrów na tablicę FileTypes (patrz poniżej). Na razie możesz ustawić tablicę FileTypes, jak pokazano. Pomocy w kwestii konwersji filtra lub innych ulepszeń są mile widziane.

Oto kod:

{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 - Problem z kodem filtrującego była związana z odlewu do PWideChar z konwersją na WideString. Konwertowany zestaw nie został przypisany do niczego, więc byłby na stosie lub stercie, zapisywanie wskaźnika na wartości tymczasowej na stosie lub sterty jest z natury niebezpieczne!

Zgodnie z sugestią loursonwinnego, można użyć StringToOleStr, ale samo to spowoduje wyciek pamięci, ponieważ pamięć zawierająca utworzone oprogramowanie OleStr nigdy nie zostanie zwolniona.

Moja przerobiona wersja tej sekcji kodu jest:

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

Wielkie dzięki dla ciebie próbki kodu, ponieważ uratował mnie dużo pracy !!