Delphi 7和Vista/Windows 7通用對話框 - 事件不起作用

我想修改Delphi 7 Dialogs.pas以訪問較新的Windows 7打開/保存對話框（請參閱使用Delphi創建Windows Vista就緒應用程序）。我可以使用建議的修改來顯示對話框;但是，OnFolderChange和OnCanClose等事件不再起作用。Delphi 7和Vista/Windows 7通用對話框 - 事件不起作用

這似乎與更改Flags：= OFN_ENABLEHOOK爲Flags：= 0相關。當Flags設置爲0時，TOpenDialog.Wndproc被繞過，並且相應的CDN_xxxxxxx消息未被捕獲。

任何人都可以提出對D7 Dialogs.pas的進一步代碼修改，它將同時顯示較新的通用對話框並保持原始控件的事件功能？

謝謝...

來源

2009-12-12 JeffR

您應該使用IFileDialog Interface並調用其Advise()方法與IFileDialogEvents Interface的實現。 Delphi 7的Windows頭文件不包含必要的聲明，所以它們必須從SDK頭文件複製（或翻譯）（或者可能已經有了另一個頭文件翻譯？），但除了額外的努力之外，不應該有有沒有什麼問題可以從Delphi 7中調用（甚至更早的Delphi版本）。

編輯：

OK，因爲你沒有任何反應的答案，我會加入一些更多的信息。有關如何使用接口的C示例可以有here。如果你有必要的導入單元，很容易將它翻譯成Delphi代碼。

我一起扔一個小樣本的德爾福4.爲了簡單起見，我創建一個TOpenDialog後裔（你可能會修改原始類），並直接在其上實現的IFileDialogEvents：

type 
    TVistaOpenDialog = class(TOpenDialog, IFileDialogEvents) 
    private 
    // IFileDialogEvents implementation 
    function OnFileOk(const pfd: IFileDialog): HResult; stdcall; 
    function OnFolderChanging(const pfd: IFileDialog; 
     const psiFolder: IShellItem): HResult; stdcall; 
    function OnFolderChange(const pfd: IFileDialog): HResult; stdcall; 
    function OnSelectionChange(const pfd: IFileDialog): HResult; stdcall; 
    function OnShareViolation(const pfd: IFileDialog; 
     const psi: IShellItem; out pResponse: DWORD): HResult; stdcall; 
    function OnTypeChange(const pfd: IFileDialog): HResult; stdcall; 
    function OnOverwrite(const pfd: IFileDialog; const psi: IShellItem; 
     out pResponse: DWORD): HResult; stdcall; 
    public 
    function Execute: Boolean; override; 
    end; 

function TVistaOpenDialog.Execute: Boolean; 
var 
    guid: TGUID; 
    Ifd: IFileDialog; 
    hr: HRESULT; 
    Cookie: Cardinal; 
    Isi: IShellItem; 
    pWc: PWideChar; 
    s: WideString; 
begin 
    CLSIDFromString(SID_IFileDialog, guid); 
    hr := CoCreateInstance(CLSID_FileOpenDialog, nil, CLSCTX_INPROC_SERVER, 
    guid, Ifd); 
    if Succeeded(hr) then begin 
    Ifd.Advise(Self, Cookie); 
    // call DisableTaskWindows() etc. 
    // see implementation of Application.MessageBox() 
    try 
     hr := Ifd.Show(Application.Handle); 
    finally 
     // call EnableTaskWindows() etc. 
     // see implementation of Application.MessageBox() 
    end; 
    Ifd.Unadvise(Cookie); 
    if Succeeded(hr) then begin 
     hr := Ifd.GetResult(Isi); 
     if Succeeded(hr) then begin 
     Assert(Isi <> nil); 
     // TODO: just for testing, needs to be implemented properly 
     if Succeeded(Isi.GetDisplayName(SIGDN_NORMALDISPLAY, pWc)) 
      and (pWc <> nil) 
     then begin 
      s := pWc; 
      FileName := s; 
     end; 
     end; 
    end; 
    Result := Succeeded(hr); 
    exit; 
    end; 
    Result := inherited Execute; 
end; 

function TVistaOpenDialog.OnFileOk(const pfd: IFileDialog): HResult; 
var 
    pszName: PWideChar; 
    s: WideString; 
begin 
    if Succeeded(pfd.GetFileName(pszName)) and (pszName <> nil) then begin 
    s := pszName; 
    if AnsiCompareText(ExtractFileExt(s), '.txt') = 0 then begin 
     Result := S_OK; 
     exit; 
    end; 
    end; 
    Result := S_FALSE; 
end; 

function TVistaOpenDialog.OnFolderChange(const pfd: IFileDialog): HResult; 
begin 
    Result := S_OK; 
end; 

function TVistaOpenDialog.OnFolderChanging(const pfd: IFileDialog; 
    const psiFolder: IShellItem): HResult; 
begin 
    Result := S_OK; 
end; 

function TVistaOpenDialog.OnOverwrite(const pfd: IFileDialog; 
    const psi: IShellItem; out pResponse: DWORD): HResult; 
begin 
    Result := S_OK; 
end; 

function TVistaOpenDialog.OnSelectionChange(
    const pfd: IFileDialog): HResult; 
begin 
    Result := S_OK; 
end; 

function TVistaOpenDialog.OnShareViolation(const pfd: IFileDialog; 
    const psi: IShellItem; out pResponse: DWORD): HResult; 
begin 
    Result := S_OK; 
end; 

function TVistaOpenDialog.OnTypeChange(const pfd: IFileDialog): HResult; 
begin 
    Result := S_OK; 
end;

如果您在運行此Windows 7將顯示新的對話框，並只接受txt擴展名的文件。這是硬編碼，需要通過對話框的OnClose事件來實現。還有很多工作要做，但提供的代碼應該足以作爲一個起點。

來源

2009-12-12 20:25:48 mghie

謝謝。根據您的原始建議和其他帖子，我一直在組裝一個模擬原始的TOpenDialog和TSaveDialog屬性和事件的組件。和你一樣，我繼承了TOpenDialog，讓事情更快。我會盡快發佈我的組件的代碼... – JeffR 2009-12-20 22:37:23

我環視了一下，使這個快速補丁FPC /拉撒路，當然你可以用這個作爲D7升級太基礎：

（刪除，請使用電流FPC源，因爲錯誤修正爲適用於此功能）

注意：未經測試，可能包含不在D7中的符號。

來源

2009-12-13 00:05:07

這是Delphi 7 Vista/Win7對話框組件（以及調用它的單元）的框架。我試圖複製TOpenDialog的事件（例如，OnCanClose）。類型定義不包含在組件中，但可以在網上找到一些更新的ShlObj和ActiveX單元。

我有一個問題，試圖將舊的過濾器字符串轉換爲FileTypes數組（見下文）。所以現在，您可以按照圖示設置FileTypes數組。歡迎任何有關過濾器轉換問題或其他改進的幫助。

下面的代碼：

{Example of using the TWin7FileDialog delphi component to access the 
Vista/Win7 File Dialog AND handle basic events.} 

unit Unit1; 

interface 

uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    Dialogs, StdCtrls, Win7FileDialog; 

type 
    TForm1 = class(TForm) 
    btnOpenFile: TButton; 
    btnSaveFile: TButton; 
    procedure btnOpenFileClick(Sender: TObject); 
    procedure btnSaveFileClick(Sender: TObject); 
    private 
    { Private declarations } 
    public 
    { Public declarations } 
    procedure DoDialogCanClose(Sender: TObject; var CanClose: Boolean); 
    procedure DoDialogFolderChange(Sender: TObject); 
    end; 

var 
    Form1: TForm1; 

implementation 

{$R *.dfm} 


{Using the dialog to open a file} 
procedure TForm1.btnOpenFileClick(Sender: TObject); 
var 
    i: integer; 
    aOpenDialog: TWin7FileDialog; 
    aFileTypesArray: TComdlgFilterSpecArray; 
begin 
    aOpenDialog:=TWin7FileDialog.Create(Owner); 
    aOpenDialog.Title:='My Win 7 Open Dialog'; 
    aOpenDialog.DialogType:=dtOpen; 
    aOpenDialog.OKButtonLabel:='Open'; 
    aOpenDialog.DefaultExt:='pas'; 
    aOpenDialog.InitialDir:='c:\program files\borland\delphi7\source'; 
    aOpenDialog.Options:=[fosPathMustExist, fosFileMustExist]; 

    //aOpenDialog.Filter := 'Text files (*.txt)|*.TXT| 
    Pascal files (*.pas)|*.PAS|All Files (*.*)|*.*'; 

    // Create an array of file types 
    SetLength(aFileTypesArray,3); 
    aFileTypesArray[0].pszName:=PWideChar(WideString('Text Files (*.txt)')); 
    aFileTypesArray[0].pszSpec:=PWideChar(WideString('*.txt')); 
    aFileTypesArray[1].pszName:=PWideChar(WideString('Pascal Files (*.pas)')); 
    aFileTypesArray[1].pszSpec:=PWideChar(WideString('*.pas')); 
    aFileTypesArray[2].pszName:=PWideChar(WideString('All Files (*.*)')); 
    aFileTypesArray[2].pszSpec:=PWideChar(WideString('*.*')); 
    aOpenDialog.FilterArray:=aFileTypesArray; 

    aOpenDialog.FilterIndex:=1; 
    aOpenDialog.OnCanClose:=DoDialogCanClose; 
    aOpenDialog.OnFolderChange:=DoDialogFolderChange; 
    if aOpenDialog.Execute then 
    begin 
    showMessage(aOpenDialog.Filename); 
    end; 

end; 

{Example of using the OnCanClose event} 
procedure TForm1.DoDialogCanClose(Sender: TObject; 
    var CanClose: Boolean); 
begin 
    if UpperCase(ExtractFilename(TWin7FileDialog(Sender).Filename))= 
    'TEMPLATE.SSN' then 
    begin 
     MessageDlg('The Template.ssn filename is reserved for use by the system.', 
    mtInformation, [mbOK], 0); 
     CanClose:=False; 
    end 
    else 
     begin 
     CanClose:=True; 
     end; 
end; 

{Helper function to get path from ShellItem} 
function PathFromShellItem(aShellItem: IShellItem): string; 
var 
    hr: HRESULT; 
    aPath: PWideChar; 
begin 
    hr:=aShellItem.GetDisplayName(SIGDN_FILESYSPATH,aPath); 
    if hr = 0 then 
    begin 
     Result:=aPath; 
    end 
    else 
     Result:=''; 
end; 

{Example of handling a folder change} 
procedure TForm1.DoDialogFolderChange(Sender: TObject); 
var 
    aShellItem: IShellItem; 
    hr: HRESULT; 
    aFilename: PWideChar; 
begin 
    hr:=TWin7FileDialog(Sender).FileDialog.GetFolder(aShellItem); 
    if hr = 0 then 
    begin 
    // showmessage(PathFromShellItem(aShellItem)); 
    end; 
end; 

{Using the dialog to save a file} 
procedure TForm1.btnSaveFileClick(Sender: TObject); 
var 
    aSaveDialog: TWin7FileDialog; 
    aFileTypesArray: TComdlgFilterSpecArray; 
begin 
    aSaveDialog:=TWin7FileDialog.Create(Owner); 
    aSaveDialog.Title:='My Win 7 Save Dialog'; 
    aSaveDialog.DialogType:=dtSave; 
    aSaveDialog.OKButtonLabel:='Save'; 
    aSaveDialog.DefaultExt:='pas'; 
    aSaveDialog.InitialDir:='c:\program files\borland\delphi7\source'; 
    aSaveDialog.Options:=[fosNoReadOnlyReturn, fosOverwritePrompt]; 

    //aSaveDialog.Filter := 'Text files (*.txt)|*.TXT| 
    Pascal files (*.pas)|*.PAS'; 

    {Create an array of file types} 
    SetLength(aFileTypesArray,3); 
    aFileTypesArray[0].pszName:=PWideChar(WideString('Text Files (*.txt)')); 
    aFileTypesArray[0].pszSpec:=PWideChar(WideString('*.txt')); 
    aFileTypesArray[1].pszName:=PWideChar(WideString('Pascal Files (*.pas)')); 
    aFileTypesArray[1].pszSpec:=PWideChar(WideString('*.pas')); 
    aFileTypesArray[2].pszName:=PWideChar(WideString('All Files (*.*)')); 
    aFileTypesArray[2].pszSpec:=PWideChar(WideString('*.*')); 
    aSaveDialog.FilterArray:=aFileTypesArray; 

    aSaveDialog.OnCanClose:=DoDialogCanClose; 
    aSaveDialog.OnFolderChange:=DoDialogFolderChange; 
    if aSaveDialog.Execute then 
    begin 
    showMessage(aSaveDialog.Filename); 
    end; 


end; 

end. 


{A sample delphi 7 component to access the 
Vista/Win7 File Dialog AND handle basic events.} 

unit Win7FileDialog; 

interface 

uses 
    SysUtils, Classes, Forms, Dialogs, Windows,DesignIntf, ShlObj, 
    ActiveX, CommDlg; 

    {Search the internet for new ShlObj and ActiveX units to get necessary 
    type declarations for IFileDialog, etc.. These interfaces can otherwise 
    be embedded into this component.} 


Type 
    TOpenOption = (fosOverwritePrompt, 
    fosStrictFileTypes, 
    fosNoChangeDir, 
    fosPickFolders, 
    fosForceFileSystem, 
    fosAllNonStorageItems, 
    fosNoValidate, 
    fosAllowMultiSelect, 
    fosPathMustExist, 
    fosFileMustExist, 
    fosCreatePrompt, 
    fosShareAware, 
    fosNoReadOnlyReturn, 
    fosNoTestFileCreate, 
    fosHideMRUPlaces, 
    fosHidePinnedPlaces, 
    fosNoDereferenceLinks, 
    fosDontAddToRecent, 
    fosForceShowHidden, 
    fosDefaultNoMiniMode, 
    fosForcePreviewPaneOn); 

    TOpenOptions = set of TOpenOption; 

type 
    TDialogType = (dtOpen,dtSave); 

type 
    TWin7FileDialog = class(TOpenDialog) 
    private 
    { Private declarations } 
    FOptions: TOpenOptions; 
    FDialogType: TDialogType; 
    FOKButtonLabel: string; 
    FFilterArray: TComdlgFilterSpecArray; 
    procedure SetOKButtonLabel(const Value: string); 
    protected 
    { Protected declarations } 
    function CanClose(Filename:TFilename): Boolean; 
    function DoExecute: Bool; 
    public 
    { Public declarations } 
    FileDialog: IFileDialog; 
    FileDialogCustomize: IFileDialogCustomize; 
    FileDialogEvents: IFileDialogEvents; 
    constructor Create(AOwner: TComponent); override; 
    destructor Destroy; override; 
    function Execute: Boolean; override; 

    published 
    { Published declarations } 
    property DefaultExt; 
    property DialogType: TDialogType read FDialogType write FDialogType 
     default dtOpen; 
    property FileName; 
    property Filter; 
    property FilterArray: TComdlgFilterSpecArray read fFilterArray 
     write fFilterArray; 
    property FilterIndex; 
    property InitialDir; 
    property Options: TOpenOptions read FOptions write FOptions 
     default [fosNoReadOnlyReturn, fosOverwritePrompt]; 
    property Title; 
    property OKButtonLabel: string read fOKButtonLabel write SetOKButtonLabel; 
    property OnCanClose; 
    property OnFolderChange; 
    property OnSelectionChange; 
    property OnTypeChange; 
    property OnClose; 
    property OnShow; 
// property OnIncludeItem; 
    end; 

    TFileDialogEvent = class(TInterfacedObject, IFileDialogEvents, 
    IFileDialogControlEvents) 
    private 
    { Private declarations } 
    // IFileDialogEvents 
    function OnFileOk(const pfd: IFileDialog): HResult; stdcall; 
    function OnFolderChanging(const pfd: IFileDialog; 
     const psiFolder: IShellItem): HResult; stdcall; 
    function OnFolderChange(const pfd: IFileDialog): HResult; stdcall; 
    function OnSelectionChange(const pfd: IFileDialog): HResult; stdcall; 
    function OnShareViolation(const pfd: IFileDialog; const psi: IShellItem; 
     out pResponse: DWORD): HResult; stdcall; 
    function OnTypeChange(const pfd: IFileDialog): HResult; stdcall; 
    function OnOverwrite(const pfd: IFileDialog; const psi: IShellItem; 
     out pResponse: DWORD): HResult; stdcall; 
    // IFileDialogControlEvents 
    function OnItemSelected(const pfdc: IFileDialogCustomize; dwIDCtl, 
     dwIDItem: DWORD): HResult; stdcall; 
    function OnButtonClicked(const pfdc: IFileDialogCustomize; 
     dwIDCtl: DWORD): HResult; stdcall; 
    function OnCheckButtonToggled(const pfdc: IFileDialogCustomize; 
     dwIDCtl: DWORD; bChecked: BOOL): HResult; stdcall; 
    function OnControlActivating(const pfdc: IFileDialogCustomize; 
     dwIDCtl: DWORD): HResult; stdcall; 
    public 
    { Public declarations } 
    ParentDialog: TWin7FileDialog; 

end; 

procedure Register; 

implementation 

constructor TWin7FileDialog.Create(AOwner: TComponent); 
begin 
    inherited Create(AOwner); 
end; 

destructor TWin7FileDialog.Destroy; 
begin 
    inherited Destroy; 
end; 

procedure TWin7FileDialog.SetOKButtonLabel(const Value: string); 
begin 
    if Value<>fOKButtonLabel then 
    begin 
     fOKButtonLabel := Value; 
    end; 
end; 

function TWin7FileDialog.CanClose(Filename: TFilename): Boolean; 
begin 
    Result := DoCanClose; 
end; 

{Helper function to get path from ShellItem} 
function PathFromShellItem(aShellItem: IShellItem): string; 
var 
    hr: HRESULT; 
    aPath: PWideChar; 
begin 
    hr:=aShellItem.GetDisplayName(SIGDN_FILESYSPATH,aPath); 
    if hr = 0 then 
    begin 
     Result:=aPath; 
    end 
    else 
     Result:=''; 
end; 

function TFileDialogEvent.OnFileOk(const pfd: IFileDialog): HResult; stdcall 
var 
    aShellItem: IShellItem; 
    hr: HRESULT; 
    aFilename: PWideChar; 
begin 
    {Get selected filename and check CanClose} 
    aShellItem:=nil; 
    hr:=pfd.GetResult(aShellItem); 
    if hr = 0 then 
    begin 
     hr:=aShellItem.GetDisplayName(SIGDN_FILESYSPATH,aFilename); 
     if hr = 0 then 
     begin 
      ParentDialog.Filename:=aFilename; 
      if not ParentDialog.CanClose(aFilename) then 
      begin 
      result := s_FALSE; 
      Exit; 
      end; 
     end; 
    end; 

    result := s_OK; 
end; 

function TFileDialogEvent.OnFolderChanging(const pfd: IFileDialog; 
    const psiFolder: IShellItem): HResult; stdcall 
begin 
    {Not currently handled} 
    result := s_OK; 
end; 

function TFileDialogEvent.OnFolderChange(const pfd: IFileDialog): 
    HResult; stdcall 
begin 
    ParentDialog.DoFolderChange; 
    result := s_OK; 
end; 

function TFileDialogEvent.OnSelectionChange(const pfd: IFileDialog): 
    HResult; stdcall 
begin 
    ParentDialog.DoSelectionChange; 
    result := s_OK; 
end; 

function TFileDialogEvent.OnShareViolation(const pfd: IFileDialog; 
    const psi: IShellItem;out pResponse: DWORD): HResult; stdcall 
begin 
    {Not currently handled} 
    result := s_OK; 
end; 

function TFileDialogEvent.OnTypeChange(const pfd: IFileDialog): 
    HResult; stdcall; 
begin 
    ParentDialog.DoTypeChange; 
    result := s_OK; 
end; 

function TFileDialogEvent.OnOverwrite(const pfd: IFileDialog; 
    const psi: IShellItem;out pResponse: DWORD): HResult; stdcall; 
begin 
    {Not currently handled} 
    result := s_OK; 
end; 

function TFileDialogEvent.OnItemSelected(const pfdc: IFileDialogCustomize; 
    dwIDCtl,dwIDItem: DWORD): HResult; stdcall; 
begin 
    {Not currently handled} 
// Form1.Caption := Format('%d:%d', [dwIDCtl, dwIDItem]); 
    result := s_OK; 
end; 

function TFileDialogEvent.OnButtonClicked(const pfdc: IFileDialogCustomize; 
    dwIDCtl: DWORD): HResult; stdcall; 
begin 
    {Not currently handled} 
    result := s_OK; 
end; 

function TFileDialogEvent.OnCheckButtonToggled(const pfdc: IFileDialogCustomize; 
    dwIDCtl: DWORD; bChecked: BOOL): HResult; stdcall; 
begin 
    {Not currently handled} 
    result := s_OK; 
end; 

function TFileDialogEvent.OnControlActivating(const pfdc: IFileDialogCustomize; 
    dwIDCtl: DWORD): HResult; stdcall; 
begin 
    {Not currently handled} 
    result := s_OK; 
end; 

procedure ParseDelimited(const sl : TStrings; const value : string; 
    const delimiter : string) ; 
var 
    dx : integer; 
    ns : string; 
    txt : string; 
    delta : integer; 
begin 
    delta := Length(delimiter) ; 
    txt := value + delimiter; 
    sl.BeginUpdate; 
    sl.Clear; 
    try 
    while Length(txt) > 0 do 
    begin 
     dx := Pos(delimiter, txt) ; 
     ns := Copy(txt,0,dx-1) ; 
     sl.Add(ns) ; 
     txt := Copy(txt,dx+delta,MaxInt) ; 
    end; 
    finally 
    sl.EndUpdate; 
    end; 
end; 


//function TWin7FileDialog.DoExecute(Func: Pointer): Bool; 
function TWin7FileDialog.DoExecute: Bool; 
var 
    aFileDialogEvent: TFileDialogEvent; 
    aCookie: cardinal; 
    aWideString: WideString; 
    aFilename: PWideChar; 
    hr: HRESULT; 
    aShellItem: IShellItem; 
    aShellItemFilter: IShellItemFilter; 
    aComdlgFilterSpec: TComdlgFilterSpec; 
    aComdlgFilterSpecArray: TComdlgFilterSpecArray; 
    i: integer; 
    aStringList: TStringList; 
    aFileTypesCount: integer; 
    aFileTypesArray: TComdlgFilterSpecArray; 
    aOptionsSet: Cardinal; 

begin 
    if DialogType = dtSave then 
    begin 
    CoCreateInstance(CLSID_FileSaveDialog, nil, CLSCTX_INPROC_SERVER, 
     IFileSaveDialog, FileDialog); 
    end 
    else 
    begin 
    CoCreateInstance(CLSID_FileOpenDialog, nil, CLSCTX_INPROC_SERVER, 
     IFileOpenDialog, FileDialog); 
    end; 

// FileDialog.QueryInterface(
// StringToGUID('{8016B7B3-3D49-4504-A0AA-2A37494E606F}'), 
// FileDialogCustomize); 
// FileDialogCustomize.AddText(1000, 'My first Test'); 

    {Set Initial Directory} 
    aWideString:=InitialDir; 
    aShellItem:=nil; 
    hr:=SHCreateItemFromParsingName(PWideChar(aWideString), nil, 
    StringToGUID(SID_IShellItem), aShellItem); 
    FileDialog.SetFolder(aShellItem); 

    {Set Title} 
    aWideString:=Title; 
    FileDialog.SetTitle(PWideChar(aWideString)); 

    {Set Options} 
    aOptionsSet:=0; 
    if fosOverwritePrompt in Options then aOptionsSet:= 
    aOptionsSet + FOS_OVERWRITEPROMPT; 
    if fosStrictFileTypes in Options then aOptionsSet:= 
    aOptionsSet + FOS_STRICTFILETYPES; 
    if fosNoChangeDir in Options then aOptionsSet:= 
    aOptionsSet + FOS_NOCHANGEDIR; 
    if fosPickFolders in Options then aOptionsSet:= 
    aOptionsSet + FOS_PICKFOLDERS; 
    if fosForceFileSystem in Options then aOptionsSet:= 
    aOptionsSet + FOS_FORCEFILESYSTEM; 
    if fosAllNonStorageItems in Options then aOptionsSet:= 
    aOptionsSet + FOS_ALLNONSTORAGEITEMS; 
    if fosNoValidate in Options then aOptionsSet:= 
    aOptionsSet + FOS_NOVALIDATE; 
    if fosAllowMultiSelect in Options then aOptionsSet:= 
    aOptionsSet + FOS_ALLOWMULTISELECT; 
    if fosPathMustExist in Options then aOptionsSet:= 
    aOptionsSet + FOS_PATHMUSTEXIST; 
    if fosFileMustExist in Options then aOptionsSet:= 
    aOptionsSet + FOS_FILEMUSTEXIST; 
    if fosCreatePrompt in Options then aOptionsSet:= 
    aOptionsSet + FOS_CREATEPROMPT; 
    if fosShareAware in Options then aOptionsSet:= 
    aOptionsSet + FOS_SHAREAWARE; 
    if fosNoReadOnlyReturn in Options then aOptionsSet:= 
    aOptionsSet + FOS_NOREADONLYRETURN; 
    if fosNoTestFileCreate in Options then aOptionsSet:= 
    aOptionsSet + FOS_NOTESTFILECREATE; 
    if fosHideMRUPlaces in Options then aOptionsSet:= 
    aOptionsSet + FOS_HIDEMRUPLACES; 
    if fosHidePinnedPlaces in Options then aOptionsSet:= 
    aOptionsSet + FOS_HIDEPINNEDPLACES; 
    if fosNoDereferenceLinks in Options then aOptionsSet:= 
    aOptionsSet + FOS_NODEREFERENCELINKS; 
    if fosDontAddToRecent in Options then aOptionsSet:= 
    aOptionsSet + FOS_DONTADDTORECENT; 
    if fosForceShowHidden in Options then aOptionsSet:= 
    aOptionsSet + FOS_FORCESHOWHIDDEN; 
    if fosDefaultNoMiniMode in Options then aOptionsSet:= 
    aOptionsSet + FOS_DEFAULTNOMINIMODE; 
    if fosForcePreviewPaneOn in Options then aOptionsSet:= 
    aOptionsSet + FOS_FORCEPREVIEWPANEON; 
    FileDialog.SetOptions(aOptionsSet); 

    {Set OKButtonLabel} 
    aWideString:=OKButtonLabel; 
    FileDialog.SetOkButtonLabel(PWideChar(aWideString)); 

    {Set Default Extension} 
    aWideString:=DefaultExt; 
    FileDialog.SetDefaultExtension(PWideChar(aWideString)); 

    {Set Default Filename} 
    aWideString:=FileName; 
    FileDialog.SetFilename(PWideChar(aWideString)); 

    {Note: Attempting below to automatically parse an old style filter string into 
    the newer FileType array; however the below code overwrites memory when the 
    stringlist item is typecast to PWideChar and assigned to an element of the 
    FileTypes array. What's the correct way to do this??} 

    {Set FileTypes (either from Filter or FilterArray)} 
    if length(Filter)>0 then 
    begin 
    { 
    aStringList:=TStringList.Create; 
    try 
    ParseDelimited(aStringList,Filter,'|'); 
    aFileTypesCount:=Trunc(aStringList.Count/2)-1; 
    i:=0; 
    While i <= aStringList.Count-1 do 
    begin 
     SetLength(aFileTypesArray,Length(aFileTypesArray)+1); 
     aFileTypesArray[Length(aFileTypesArray)-1].pszName:= 
     PWideChar(WideString(aStringList[i])); 
     aFileTypesArray[Length(aFileTypesArray)-1].pszSpec:= 
     PWideChar(WideString(aStringList[i+1])); 
     Inc(i,2); 
    end; 
    FileDialog.SetFileTypes(length(aFileTypesArray),aFileTypesArray); 
    finally 
    aStringList.Free; 
    end; 
    } 
    end 
    else 
    begin 
    FileDialog.SetFileTypes(length(FilterArray),FilterArray); 
    end; 


    {Set FileType (filter) index} 
    FileDialog.SetFileTypeIndex(FilterIndex); 

    aFileDialogEvent:=TFileDialogEvent.Create; 
    aFileDialogEvent.ParentDialog:=self; 
    aFileDialogEvent.QueryInterface(IFileDialogEvents,FileDialogEvents); 
    FileDialog.Advise(aFileDialogEvent,aCookie); 

    hr:=FileDialog.Show(Application.Handle); 
    if hr = 0 then 
    begin 
     aShellItem:=nil; 
     hr:=FileDialog.GetResult(aShellItem); 
     if hr = 0 then 
     begin 
      hr:=aShellItem.GetDisplayName(SIGDN_FILESYSPATH,aFilename); 
      if hr = 0 then 
      begin 
       Filename:=aFilename; 
      end; 
     end; 
     Result:=true; 
    end 
    else 
    begin 
     Result:=false; 
    end; 

    FileDialog.Unadvise(aCookie); 
end; 

function TWin7FileDialog.Execute: Boolean; 
begin 
    Result := DoExecute; 
end; 


procedure Register; 
begin 
    RegisterComponents('Dialogs', [TWin7FileDialog]); 
end; 

end.

來源

2009-12-22 18:51:15 JeffR

僅供參考。我也有問題定義從舊樣式格式的過濾器，除非他們在代碼中一個接一個地硬編碼，如上所述。 '：我通過分配時值pszName和pszSpec使用StringToOleStr解決它<！ - 語言：朗-JS - > aFileTypesArray [工業] .pszName：= StringToOleStr（FilterList [IDX]）;' – FileVoyager 2012-05-18 15:31:10

請忽略「< ！ - 語言：lang-js - >「提及。錯誤的複製粘貼和版本超時;（ – FileVoyager 2012-05-18 16:28:22

JeffR - 與您的過濾代碼的問題涉及到鑄造的轉換WideString的的PWideChar。轉換後的寬字符串沒有被分配給任何東西，所以會被放在堆棧或堆上，將指針保存在堆棧或堆上的臨時值是固有的危險！

至於建議的loursonwinny，你可以使用StringToOleStr，但僅憑這將導致內存泄漏，因爲包含有創建OLESTR記憶永遠不會被釋放。

我修改了代碼，這部分的版本是：

{Set FileTypes (either from Filter or FilterArray)} 
    if length(Filter)>0 then 
    begin 
    aStringList:=TStringList.Create; 
    try 
     ParseDelimited(aStringList,Filter,'|'); 
     i:=0; 
     While i <= aStringList.Count-1 do 
     begin 
     SetLength(aFileTypesArray,Length(aFileTypesArray)+1); 
     aFileTypesArray[Length(aFileTypesArray)-1].pszName:= 
      StringToOleStr(aStringList[i]); 
     aFileTypesArray[Length(aFileTypesArray)-1].pszSpec:= 
      StringToOleStr(aStringList[i+1]); 
     Inc(i,2); 
     end; 
     FileDialog.SetFileTypes(length(aFileTypesArray),aFileTypesArray); 
    finally 
     for i := 0 to Length(aFileTypesArray) - 1 do 
     begin 
     SysFreeString(aFileTypesArray[i].pszName); 
     SysFreeString(aFileTypesArray[i].pszSpec); 
     end; 
     aStringList.Free; 
    end; 
    end 
    else 
    begin 
    FileDialog.SetFileTypes(length(FilterArray),FilterArray); 
    end;

非常感謝您的代碼示例，因爲它救了我很多工作！

來源

2013-01-14 00:07:47

Delphi 7和Vista/Windows 7通用對話框 - 事件不起作用

回答

相關問題