fmcansav.pas

来自「Delphi direct support for GIF files」· PAS 代码 · 共 75 行

unit FmCanSav;
{
 3 Nov 97: - added CanSaveDialog.Free in finalization
 9 Nov 97: - ifdef'd that statement out for Delphi 1
}

interface

uses WinProcs, WinTypes, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls, 
  Buttons, ExtCtrls, Dialogs;

type
  TCanSaveDialog = class(TForm)
    Button1: TButton;
    FilenameLabel: TLabel;
    SaveAsButton: TButton;
    Button3: TButton;
    SaveDialog: TSaveDialog;
    Label2: TLabel;
    Image1: TImage;
    procedure SaveAsButtonClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    Filename: String;
    function Execute(Filename: String): Boolean;
  end;

var
  CanSaveDialog: TCanSaveDialog;

implementation

{$R *.DFM}


procedure TCanSaveDialog.SaveAsButtonClick(Sender: TObject);
begin { TCanSaveDialog.SaveAsButtonClick }
  SaveDialog.Filename := Filename;
  if SaveDialog.Execute
  then begin
    ModalResult := mrOK;
    filename := SaveDialog.Filename
  end
  else ModalResult := mrAbort
end;  { TCanSaveDialog.SaveAsButtonClick }

function TCanSaveDialog.Execute(Filename: String): Boolean;
begin { TCanSaveDialog.Execute }
  Self.Filename := Filename;
  if not FileExists(Filename)
  then Result := True
  else begin
    FilenameLabel.Caption := Filename + ' already exists.';
    Self.ClientWidth := FilenameLabel.Left +  FilenameLabel.Width + 30;
    SaveDialog.Filename := Filename;
    Self.ShowModal;
    if ModalResult = mrOK
    then begin
      Result := True;
      Self.Filename := SaveDialog.Filename;
    end
    else Result := False;
  end;
end;  { TCanSaveDialog.Execute }

initialization
  CanSaveDialog := TCanSaveDialog.Create(nil);
{$ifndef ver80}
finalization
  CanSaveDialog.Free;
{$endif ver80}
end. { Unit FmCanSav }