(Диалог сохранения) Как автоматически изменить расширение файла при изменении фильтра файлов в Vista/Win7?

StackOverflow https://stackoverflow.com/questions/2145299

Вопрос

При отображении диалогового окна сохранения я хочу автоматически перехватить изменение типа фильтра пользователя и изменить расширение файла.(например.например, операция MSPaint «Сохранить как».)

С tsavedialog и установлением 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 с Delphi 2007.

Должен ли я использовать TFileSaveDialog вместо TSaveDialog с внутренней оболочкой?(И мне приходится бороться с COM-программированием, используя Ифиледиалогконтролевентс ?)

Или я могу добиться этого с помощью TFileSaveDialog и только его стандартных свойств?(Моя среда разработки все еще находится на машине с XP, поэтому я никогда не пробовал.извини.)

Я думаю, что это очень распространенная задача, но я не смог найти ни одного примера кода, поддерживающего Vista/7...

Это было полезно?

Решение

Насколько я знаю, TFileSaveDialog вызовет исключение в XP.Требуется Vista или выше.

Обновлять:некоторый Код D2010 для Тфилесаведиалог адаптировано из вашего обработчика событий....
(У меня нет D2007 в Vista;используйте 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

Другие советы

Вы написали, что не смогли взломать обертку.Я использую этот код для своей библиотеки экспорта XLSX/XLS/ODS, чтобы изменить расширение файла как в XP, так и в Vista+.

Один недостаток:Помощники класса не могут получить доступ к закрытым полям в Delphi 2007, поэтому этот код работает только в Delphi 2009+.Если вам нужна совместимость с Delphi 2007, используйте для TOpenDialog тот же хак, который я использовал для TFileDialogWrapper в этом примере.

{ 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 свойство, Delphi/Windows позаботится об изменении расширения файла за вас.В этом случае вам не нужно ничего делать в OnTypeChange событие.

Эта функция реализована в Delphi, но по умолчанию отключена.

Чтобы активировать его, просто введите расширение по умолчанию в DefaultExt свойство.

Лицензировано под: CC-BY-SA с атрибуция
Не связан с StackOverflow
scroll top