unitsaveas.pas

界面精美

unit UnitSaveAs;

interface

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

type
  TFrmSaveAsFile = class(TForm)
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    SBtnOpen: TSpeedButton;
    SbtnSaveAs: TSpeedButton;
    ProgressBar1: TProgressBar;
    Label3: TLabel;
    BBtnSaveAs: TBitBtn;
    BBtnExit: TBitBtn;
    SaveDialog1: TSaveDialog;
    OpenDialog1: TOpenDialog;
    procedure FormCreate(Sender: TObject);
    procedure SBtnOpenClick(Sender: TObject);
    procedure SbtnSaveAsClick(Sender: TObject);
    procedure BBtnExitClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure BBtnSaveAsClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmSaveAsFile: TFrmSaveAsFile;
  Copying:Boolean; //用于判断拷贝过程是否完成
implementation

{$R *.dfm}

procedure TFrmSaveAsFile.FormCreate(Sender: TObject);
begin
  OpenDialog1.FileName:='';
  OpenDialog1.InitialDir:=ExtractFileDir(Application.ExeName);
  SaveDialog1.FileName:='';
  SaveDialog1.InitialDir:=ExtractFileDir(Application.ExeName);
  BBtnSaveAs.Enabled:=False;
  Copying:=False;
end;

procedure TFrmSaveAsFile.SBtnOpenClick(Sender: TObject);
begin
  With OpenDialog1 do
   if Execute then
     Edit1.Text:=Opendialog1.FileName;
   if ((Edit1.Text<>'') and (Edit2.Text<>'')) then
     BBtnSaveAs.Enabled:=True
   else
     BBtnSaveAs.Enabled:=False;
end;

procedure TFrmSaveAsFile.SbtnSaveAsClick(Sender: TObject);
begin
  With SaveDialog1 do
   if Execute then
     Edit2.Text:=SaveDialog1.FileName;
  if ((Edit1.Text<>'') and (Edit2.Text<>'')) then
    BBtnSaveAs.Enabled:=True
  else
    BBtnSaveAs.Enabled:=False;
end;

procedure TFrmSaveAsFile.BBtnExitClick(Sender: TObject);
begin
  Close;
end;

procedure TFrmSaveAsFile.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  if Copying then
    CanClose:=False
  else
    CanClose:=True;  
end;

procedure TFrmSaveAsFile.BBtnSaveAsClick(Sender: TObject);
var
  FromFile,ToFile:File;       //声明两个无类型文件的变量
  NumRead,NumWrite:Integer;   //存储实际读取和写入的字节数
  Buf:Array[1..2048] of byte; //定义内存缓冲区
begin
  AssignFile(FromFile,Opendialog1.FileName); //关联源文件
  Reset(FromFile,1);                         //只读打开源文件
  AssignFile(ToFile,SaveDialog1.FileName);   //关联目标文件
  Rewrite(ToFile,1);                         //覆盖写入方式打开目标文件

  progressBar1.Max:=(FileSize(FromFile)*2 div sizeof(buf));

  //以下内容是从源文件读取内容，然后写入目标文件
  repeat
    BlockRead(FromFile,buf,Sizeof(buf),NumRead);
    ProgressBar1.StepIt;
    BlockWrite(ToFile,buf,NumRead,NumWrite);
    ProgressBar1.StepIt;
    Copying:=True;
    Application.ProcessMessages;
  until ((NumRead = 0) or (NumWrite <> NumRead));  //注意循环退出条件

  //最后注意关闭文件，一定不可以省略，否则会造成数据丢失
  CloseFile(FromFile);
  CloseFile(ToFile);

  ProgressBar1.Position:=0;
  Copying:=False;
  ShowMessage('文件另存为过程完成。');
end;

end.