division_unit.pas

Delphi7编程80例(完全版)

{++++++++++++++++++++++++++++++++++++}
{                                    }
{ Division 文件分割/合并控件演示程序 }
{                                    }
{          作者：杜伟(vber)          }
{                                    }
{    欢迎访问伟博软件工作室网站      }
{        http://www.vbersoft.net     }
{    伟博软件技术论坛                }
{        http://wujita.yeah.net      }
{                                    }
{++++++++++++++++++++++++++++++++++++}




unit Division_Unit;

interface

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

type
  TfrmDivision = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Label1: TLabel;
    Edit1: TEdit;
    Button1: TButton;
    Label2: TLabel;
    Edit2: TEdit;
    Button2: TButton;
    Label3: TLabel;
    Edit3: TEdit;
    CheckBox1: TCheckBox;
    Label4: TLabel;
    Label5: TLabel;
    ProgressBar1: TProgressBar;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Button3: TButton;
    Division1: TDivision;
    Button4: TButton;
    GroupBox1: TGroupBox;
    RadioButton1: TRadioButton;
    Edit4: TEdit;
    SpeedButton1: TSpeedButton;
    RadioButton2: TRadioButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    ProgressBar2: TProgressBar;
    Label6: TLabel;
    ListBox1: TListBox;
    TabSheet3: TTabSheet;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Division1BeginCombine(FileCount: Integer);
    procedure Division1BeginDivision(SectionTotal: Integer);
    procedure Division1DoingCombine(Sender: TObject);
    procedure Division1DoingDivision(Sender: TObject);
    procedure Division1EndCombine(Sender: TObject);
    procedure Division1EndDivision(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
    procedure RadioButton2Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmDivision: TfrmDivision;

implementation

{$R *.DFM}

// 浏览文件夹
function SelectDirectory(var InitPath : String;szTitle: String) : Boolean;
var BROWSEINFO:TBROWSEINFO;
    vPath : PItemIDList;
    Path : PChar;
begin
   BROWSEINFO.hwndOwner := Application.Handle;
   BROWSEINFO.lpfn := nil;
   BROWSEINFO.lpszTitle := PChar(szTitle);
   BROWSEINFO.pidlRoot := nil;
   BROWSEINFO.pszDisplayName := nil;
   BROWSEINFO.lParam := BFFM_INITIALIZED;
   BROWSEINFO.ulFlags := BIF_RETURNONLYFSDIRS;
   vPath := SHBrowseForFolder(BROWSEINFO);
   Result := False;
   if vPath <> nil then begin
      GetMem(Path, 255);
      SHGetPathFromIDList(vPath, Path);
      InitPath := StrPas(Path);
      FreeMem(Path);
      Result := True;
   end;
end;

procedure TfrmDivision.Button1Click(Sender: TObject);
begin
  with OpenDialog1 do
    begin
      if Execute then
        Edit1.Text := FileName;
    end;
end;

procedure TfrmDivision.Button2Click(Sender: TObject);
begin
  with SaveDialog1 do
    begin
      if Execute then
        begin
          Edit2.Text := ChangeFileExt(FileName, ExtractFileExt(Edit1.Text));
        end;
    end;
end;

procedure TfrmDivision.Edit1Change(Sender: TObject);
begin
  if Edit1.Text <> '' then
    Edit2.Text := Edit1.Text;
end;

procedure TfrmDivision.CheckBox1Click(Sender: TObject);
begin
  if CheckBox1.Checked then Division1.CreateType := ctBat
  else Division1.CreateType := ctNone;
end;

procedure TfrmDivision.Button3Click(Sender: TObject);
begin
  Button3.Enabled := False;
  Screen.Cursor := crHourGlass;
  // 开始分割
  Division1.DivisionSize := StrToInt(Edit3.Text);
  Division1.FileName := Edit1.Text;
  Division1.SavePathName := Edit2.Text;
  Division1.Execute;
end;

procedure TfrmDivision.Division1BeginCombine(FileCount: Integer);
begin
  ProgressBar2.Max := FileCount;
end;

procedure TfrmDivision.Division1BeginDivision(SectionTotal: Integer);
begin
  ProgressBar1.Max := SectionTotal;
end;

procedure TfrmDivision.Division1DoingCombine(Sender: TObject);
begin
  ProgressBar2.StepIt;
end;

procedure TfrmDivision.Division1DoingDivision(Sender: TObject);
begin
  ProgressBar1.StepIt;
end;

procedure TfrmDivision.Division1EndCombine(Sender: TObject);
begin
  Button4.Enabled := True;
  Screen.Cursor := crDefault;
  ProgressBar2.Position := 0;
  Application.MessageBox('合并完成!', '信息', MB_OK + MB_ICONINFORMATION);
end;

procedure TfrmDivision.Division1EndDivision(Sender: TObject);
begin
  Button3.Enabled := True;
  Screen.Cursor := crDefault;
  ProgressBar1.Position := 0;
  Application.MessageBox('分割完成!', '信息', MB_OK + MB_ICONINFORMATION);
end;

procedure TfrmDivision.FormShow(Sender: TObject);
begin
  ProgressBar1.Step := 1;
  ProgressBar2.Step := 1;  
end;

procedure TfrmDivision.SpeedButton3Click(Sender: TObject);
begin
  ListBox1.Clear;
end;

procedure TfrmDivision.SpeedButton1Click(Sender: TObject);
var
  sPath: String;
begin
  if SelectDirectory(sPath, '浏览文件夹:') then
    Edit4.Text := sPath;
end;

procedure TfrmDivision.RadioButton1Click(Sender: TObject);
begin
  if RadioButton1.Checked then
    begin
      Edit4.Enabled := True;
      SpeedButton1.Enabled := True;
      SpeedButton2.Enabled := False;
      SpeedButton3.Enabled := False;
      ListBox1.Enabled := False;
    end
  else
    begin
      SpeedButton2.Enabled := True;
      SpeedButton3.Enabled := True;
      ListBox1.Enabled := True;    
      Edit4.Enabled := False;
      SpeedButton1.Enabled := False;
    end;
end;

procedure TfrmDivision.RadioButton2Click(Sender: TObject);
begin
  if RadioButton2.Checked then
    begin
      Edit4.Enabled := False;
      SpeedButton1.Enabled := False;
      SpeedButton2.Enabled := True;
      SpeedButton3.Enabled := True;
      ListBox1.Enabled := True;
    end
  else
    begin
      SpeedButton2.Enabled := False;
      SpeedButton3.Enabled := False;
      ListBox1.Enabled := False;    
      Edit4.Enabled := True;
      SpeedButton1.Enabled := True;
    end;
end;

procedure TfrmDivision.SpeedButton2Click(Sender: TObject);
var i: Integer;
begin
  with OpenDialog1 do
    begin
      Options := [ofAllowMultiSelect];
      if Execute then
        begin
          ListBox1.Clear;
          for i:=0 to Files.Count-1 do
            ListBox1.Items.Add(Files.Strings[i]);
        end;
    end;
end;

procedure TfrmDivision.Button4Click(Sender: TObject);
begin
  // 开始合并
  Button4.Enabled := False;
  Screen.Cursor := crHourGlass;

  if RadioButton1.Checked then
    begin
      Division1.WorkType := ttCombine;
      Division1.CombineSource := csPath;
      Division1.CombinePath := Edit4.Text;
      Division1.Execute;
    end
  else if RadioButton2.Checked then
    begin
      Division1.WorkType := ttCombine;
      Division1.CombineSource := csFiles;
      Division1.CombineFileList.Assign(ListBox1.Items);
      Division1.Execute;
    end;
end;

procedure TfrmDivision.PageControl1Change(Sender: TObject);
begin
  if PageControl1.ActivePageIndex = 2 then
    begin
      Division1.About;
      PageControl1.ActivePageIndex := 0;
    end;
end;

end.