(保存对话框)如何在Vista/Win7文件过滤器更改中自动更改文件扩展名?

问题描述:

显示保存对话框时,我想要钩住用户的过滤器类型更改并自动更改文件扩展名。 (例如,像MSPaint的“另存为”操作。)(保存对话框)如何在Vista/Win7文件过滤器更改中自动更改文件扩展名?

With TSaveDialog and setting UseLatestCommonDialogs:= False, 我可以通过以下代码处理该问题。 (不包括最新的通用对话框支持五言的,。)

procedure TForm1.SaveDialog1TypeChange(Sender: TObject); 
var 
    FName, Ext: string; 
begin 
    with TSaveDialog(Sender) do 
    begin 
    if DirectoryExists(FileName) then // FileName is Empty 
     exit; 
    case FilterIndex of 
    1: Ext := '.png'; 
    2: Ext := '.bmp'; 
    3: Ext := '.jpg'; 
    end; 
    FName := ChangeFileExt(ExtractFileName(FileName), Ext); 
    SendMessage(Windows.GetParent(Handle), CDM_SETCONTROLTEXT, 1152, LongInt(PChar(FName))); 
    end; 
end; 

我想同时支持XP和Vista/7德尔福2007年

我应该使用TFileSaveDialog代替TSaveDialog与内部包裹? (我必须努力使用IFileDialogControlEvents COM编程?)

或者我可以实现这与TFileSaveDialog和它的标准属性只? (我的发展环境仍然是XP的机器上,所以我从来没有尝试过。抱歉。)

我认为这是很常见的事,但我找不到任何的示例代码支持Vista/7的...

据我所知,TFileSaveDialog会在XP上引发异常。它需要Vista或更高版本。

更新:一些D2010代码为TFileSaveDialog改编自事件处理程序....
(我没有在Vista D2007;用PWideChar代替PChar类型)

procedure TForm1.FileSaveDialog1TypeChange(Sender: TObject); 
var 
    FName, Ext: string; 
    pName: PChar; 
begin 
    with TFileSaveDialog(Sender) do 
    begin 
    if DirectoryExists(FileName) then // FileName is Empty 
     exit; 
    case FileTypeIndex of 
    1: Ext := '.png'; 
    2: Ext := '.bmp'; 
    3: Ext := '.jpg'; 
    end; 
    Dialog.GetFileName(pName); 
    FName := ChangeFileExt(ExtractFileName(pName), Ext); 
    Dialog.SetFileName(PChar(FName)); 
    end; 
end; 

凡FileSaveDialog是:

object FileSaveDialog1: TFileSaveDialog 
    FavoriteLinks = <> 
    FileTypes = < 
    item 
     DisplayName = 'png files' 
     FileMask = '*.png' 
    end 
    item 
     DisplayName = 'bmp files' 
     FileMask = '*.bmp' 
    end 
    item 
     DisplayName = 'jpg files' 
     FileMask = '*.jpg' 
    end> 
    Options = [] 
    OnTypeChange = FileSaveDialog1TypeChange 
end 
+0

谢谢! 但我通常在运行时创建这些对话框,所以我可以用操作系统版本检查来切换TSaveDialog和TFileSaveDialog。 – benok 2010-01-27 11:03:04

+0

它适用于D2007。我只是改变PChar /字符串 - > PWideChar/WideString。(可能它适用于D2009或更高版本与自动类型转换。)。谢谢! 附: 我试着在“* SaveDialog1 * TypeChange”内部切换,使用类似于“if Parent.ClassName ='TFileSaveDialogWrapper'”。(它比切换对话框类更方便)但我无法破解包装器,因为它在实现部分中定义了...... – benok 2010-01-28 02:05:08

你写,你不能破解包装。我将此代码用于我的XLSX/XLS/ODS导出库,以更改XP和Vista +上的文件扩展名。

一个缺点:类助手无法访问Delphi 2007中的私有字段,因此此代码只能在Delphi 2009+中运行。如果你想兼容Delphi 2007,那么就像我在这个例子中使用的TFileDialogWrapper一样,使用TOpenDialog的相同黑客技术。

{ interface } 

    //some hacking needed to change the file extension at type change, 
    //empty class is just fine... 
    TFileDialogWrapper = class(TObject) 
    private 
    {$HINTS OFF} 
    procedure AssignFileTypes; 
    procedure AssignOptions; 
    function GetFileName: TFileName; 
    function GetHandle: HWND; 
    procedure HandleShareViolation(Sender: TObject; 
     var Response: TFileDialogShareViolationResponse); 
    procedure OnFileOkEvent(Sender: TObject; var CanClose: Boolean); 
    procedure OnFolderChangeEvent(Sender: TObject); 
    procedure OnSelectionChangeEvent(Sender: TObject); 
    procedure OnTypeChangeEvent(Sender: TObject); 
    protected 
    FFileDialog: TCustomFileDialog; 
    {$HINTS ON} 
    end; 
    TOpenDialogHelper = class helper for TOpenDialog 
    public 
    function GetInternalWrapper: TFileDialogWrapper; 
    end; 

{ implementation } 

{ TOpenDialogHelper } 

function TOpenDialogHelper.GetInternalWrapper: TFileDialogWrapper; 
begin 
    Result := TFileDialogWrapper(Self.FInternalWrapper); 
end; 

{ TFileDialogWrapper } 

procedure TFileDialogWrapper.AssignFileTypes; 
begin 
end; 

procedure TFileDialogWrapper.AssignOptions; 
begin 
end; 

function TFileDialogWrapper.GetFileName: TFileName; 
begin 
end; 

function TFileDialogWrapper.GetHandle: HWND; 
begin 
end; 

procedure TFileDialogWrapper.HandleShareViolation(Sender: TObject; 
    var Response: TFileDialogShareViolationResponse); 
begin 
end; 

procedure TFileDialogWrapper.OnFileOkEvent(Sender: TObject; 
    var CanClose: Boolean); 
begin 
end; 

procedure TFileDialogWrapper.OnFolderChangeEvent(Sender: TObject); 
begin 
end; 

procedure TFileDialogWrapper.OnSelectionChangeEvent(Sender: TObject); 
begin 
end; 

procedure TFileDialogWrapper.OnTypeChangeEvent(Sender: TObject); 
begin 
end; 

//use this for OnTypeChane event of a "normal" TOpenDialog/TSaveDialog 

procedure TForm1.DialogTypeChange(Sender: TObject); 
var 
    xFN: WideString; 
    xExporter: TOCustomExporter; 
    xFileName: PWideChar; 
    xFD: TFileDialogWrapper; 
    xFilterIndex: UINT; 
begin 
    if Sender is TOpenDialog then 
    with TOpenDialog(Sender) do begin 
    xFD := GetInternalWrapper; 
    if (xFD <> nil) and (xFD.FFileDialog <> nil) 
    then begin 
     //Vista file dialog 

     xFD.FFileDialog.Dialog.GetFileName(xFileName); 
     if xFileName = '' then 
     exit; 
     xFN := xFileName; 
     xFD.FFileDialog.Dialog.GetFileTypeIndex(xFilterIndex); 

     // DO WHATEVER YOU WANT WITH THE FILENAME HERE // 

     xFD.FFileDialog.Dialog.SetFileName(PWideChar(xFN)); 
    end else begin 
     //Old dialog 
     xFN := ExtractFileName(FileName); 
     if xFN = '' then 
     exit; 

     // DO WHATEVER YOU WANT WITH THE FILENAME HERE // 

     {$HINTS OFF} 
     SendMessage(Windows.GetParent(Handle), CDM_SETCONTROLTEXT, 1152, LongInt(PWideChar(xFN))); 
     {$HINTS ON} 
    end; 
    end; 
end; 

编辑:其实,如果你设置了DefaultExt属性,德尔福/ Windows的关心你的文件扩展名更改。在这种情况下,您不必在OnTypeChange事件中做任何事情。

+0

实际上,我现在检查了它 - 因为Dialogs单元体系结构,它只能在Delphi XE +中运行。 – oxo 2012-11-01 01:23:53

+0

谢谢你的回答。我刚刚注意到了。我不再使用D2007,我会阅读你的代码。谢谢。 – benok 2012-12-13 00:48:49

此功能在Delphi中实现,但在默认情况下禁用。

为了激活它,只需输入DefaultExt属性的默认扩展名。