10

Delphi 7 Dialogs.pas を変更して、新しい Windows 7 の [開く/保存] ダイアログ ボックスにアクセスしようとしています (「Delphi を使用した Windows Vista 対応アプリケーションの作成」を参照)。提案された変更を使用してダイアログを表示できます。ただし、OnFolderChange や OnCanClose などのイベントは機能しなくなりました。

これは、Flags:= OFN_ENABLEHOOK を Flags:=0 に変更したことに関連しているようです。Flags が 0 に設定されている場合、TOpenDialog.Wndproc はバイパスされ、適切な CDN_xxxxxxx メッセージはトラップされません。

新しい共通ダイアログを表示し、元のコントロールのイベント機能を維持する D7 Dialogs.pas のコード変更を提案できる人はいますか?

ありがとう...

4

4 に答える 4

6

IFileDialog Interfaceを使用し、そのAdvise()メソッドをIFileDialogEvents Interfaceの実装で呼び出す必要があります。Delphi 7 Windows ヘッダー ユニットには必要な宣言が含まれていないため、SDK ヘッダー ファイルからコピー（および変換）する必要があります（または、別のヘッダー変換が既に利用可能である可能性があります）。これを Delphi 7 (またはそれ以前の Delphi バージョン) から呼び出すのは問題ありません。

編集：

わかりました。回答にまったく反応しなかったので、さらに情報を追加します。インターフェイスの使用方法に関する AC サンプルは、ここにあります。必要なインポート ユニットがあれば、Delphi コードに変換するのは簡単です。

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-12T20:25:48.543 に答える
4

Delphi 7 Vista / Win7ダイアログコンポーネント（およびそれを呼び出すユニット）のフレームワークは次のとおりです。TOpenDialogのイベント（OnCanCloseなど）を複製しようとしました。タイプ定義はコンポーネントに含まれていませんが、ネット上のいくつかの新しいShlObjおよびActiveXユニットで見つけることができます。

古いスタイルのFilter文字列を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-22T18:51:15.487 に答える
2

JeffR - フィルタリング コードの問題は、WideString への変換の PWideChar へのキャストに関連していました。Converted ワイド文字列は何にも割り当てられていないため、スタックまたはヒープ上にあるはずです。スタックまたはヒープ上の一時的な値へのポインターを保存することは、本質的に危険です!

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-14T00:07:47.077 に答える
0

私は少し調べていて、FPC/Lazarus 用のこのクイック パッチを作成しましたが、もちろん、これを D7 アップグレードの基礎としても使用できます。

(この機能にバグ修正が適用されたため、削除されました。現在の FPC ソースを使用してください)

注: テストされておらず、D7 にないシンボルが含まれている可能性があります。

于 2009-12-13T00:05:07.787 に答える