umain.pas

来自「用于Delphi和BCB的高速压缩组件库」· PAS 代码 · 共 140 行

unit uMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, FileCtrl, FlexCompress;

type
  TfrmMain = class(TForm)
    OpenDialog1: TOpenDialog;
    Archiver: TFlexCompress;
    SaveDialog1: TSaveDialog;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Label1: TLabel;
    eSrcDir: TEdit;
    Button3: TButton;
    Label2: TLabel;
    eDstDir: TEdit;
    Button4: TButton;
    btnSpanning: TButton;
    btnSplitting: TButton;
    eUnpackDir: TEdit;
    Label3: TLabel;
    btnUnpack: TButton;
    eArcName: TEdit;
    Label4: TLabel;
    Button5: TButton;
    Button6: TButton;
    ProgressBar1: TProgressBar;
    Label5: TLabel;
    cbVolumeSize: TComboBox;
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure btnSpanningClick(Sender: TObject);
    procedure btnUnpackClick(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure ArchiverFileProgress(Sender: TObject; FileName: String;
      Progress: Double; Operation: TFXCProcessOperation;
      ProgressPhase: TFXCProgressPhase; var Cancel: Boolean);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.Button3Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    eSrcDir.Text := OpenDialog1.FileName;
end;

procedure TfrmMain.Button4Click(Sender: TObject);
begin
  if SaveDialog1.Execute then
    eDstDir.Text := SaveDialog1.FileName;
end;

procedure TfrmMain.Button5Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    eArcName.Text := OpenDialog1.FileName;
end;

procedure TfrmMain.Button6Click(Sender: TObject);
var Dir: String;
begin
  Dir := '';
  if SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt],0) then
    eUnpackDir.Text := dir;
end;

procedure TfrmMain.btnSpanningClick(Sender: TObject);
begin
  with Archiver do begin
    case cbVolumeSize.ItemIndex of
       0:  SpanningOptions.VolumeSize := vsAutoDetect;
       1:  SpanningOptions.VolumeSize := vs1_44MB;
       2:  SpanningOptions.VolumeSize := vs100MB;
       3:  SpanningOptions.VolumeSize := vs200MB;
       4:  SpanningOptions.VolumeSize := vs600MB;
       5:  SpanningOptions.VolumeSize := vs650MB;
       6:  SpanningOptions.VolumeSize := vs700MB;
       else
           begin
             SpanningOptions.VolumeSize := vsCustom;
             SpanningOptions.CustomVolumeSize := StrToInt(cbVolumeSize.Text);
           end;
    end;
    if (Sender as TButton).Tag = 1 then
      SpanningMode := smSpanning
    else
      SpanningMode := smSplitting;
    FileName := eDstDir.Text;
    OpenArchive(fmCreate);
    AddFiles(eSrcDir.Text);
    CloseArchive;
    ShowMessage('Archive Creating completed');
    ProgressBar1.Position := 0;
  end;
end;

procedure TfrmMain.btnUnpackClick(Sender: TObject);
begin
  with Archiver do begin
    FileName := eArcName.Text;
    OpenArchive(fmOpenRead + fmShareDenyWrite);
    BaseDir := eUnpackDir.Text;
    ExtractFiles('*.*');
    CloseArchive;
    ShowMessage('Files extracted successfully');
    ProgressBar1.Position := 0;
  end;
end;

procedure TfrmMain.ArchiverFileProgress(Sender: TObject;
  FileName: String; Progress: Double; Operation: TFXCProcessOperation;
  ProgressPhase: TFXCProgressPhase; var Cancel: Boolean);
begin
  ProgressBar1.Position := trunc(Progress);
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  cbVolumeSize.ItemIndex := 0;
end;

end.