unit1.pas

ziptv为delphi控件

Unit Unit1;

Interface

{$I compiler.inc}
{$IFDEF DEL6_OR_HIGHER}
{$WARN UNIT_PLATFORM OFF}
{$ENDIF}

Uses
   Windows,
   Messages,
   SysUtils,
   Classes,
   Graphics,
   Controls,
   Forms,
   Dialogs,
   OleCtrls,
   StdCtrls,
   FileCtrl,
   ExtCtrls,
   ComCtrls,
   Grids,
   Buttons,
   Menus,
   ztvBase,
   ztvFileScan;

Type
   TForm1 = Class(TForm)
      cArchive: TCheckBox;
      cArchiveEx: TCheckBox;
      cDirectory: TCheckBox;
      cDirectoryEx: TCheckBox;
      cHidden: TCheckBox;
      cHiddenEx: TCheckBox;
      cReadonly: TCheckBox;
      cReadonlyEx: TCheckBox;
      cSysFile: TCheckBox;
      cSysFileEx: TCheckBox;
      cRecurseCheck: TCheckBox;
      cUpdateListCheck: TCheckBox;
      cVolumeID: TCheckBox;
      cVolumeIDEx: TCheckBox;
      cZeroAttr: TCheckBox;
      cZeroAttrEx: TCheckBox;
      OpenDialog1: TOpenDialog;
      ztvFileScan1: TztvFileScan;
      RadioGroup1: TRadioGroup;
      RadioGroup2: TRadioGroup;
      GroupBox1: TGroupBox;
      GroupBox2: TGroupBox;
      GroupBox3: TGroupBox;
      Panel1: TPanel;
      Panel2: TPanel;
      Panel3: TPanel;
      Panel4: TPanel;
      Label1: TLabel;
      Edit1: TEdit;
      ListBox1: TListBox;
      BitBtn1: TBitBtn;
      Button1: TButton;
      Button2: TButton;
      Button3: TButton;
      Button4: TButton;
      CheckBox1: TCheckBox;
      StringGrid1: TStringGrid;
      Procedure Button1Click(Sender: TObject);
      Procedure Button2Click(Sender: TObject);
      Procedure Button3Click(Sender: TObject);
      Procedure BitBtn1Click(Sender: TObject);
      Procedure ClearGrid(Sender: TObject);
      Procedure Edit1KeyPress(Sender: TObject; Var Key: Char);
      Procedure FillProperyValues;
      Procedure FormActivate(Sender: TObject);
      Procedure FormCreate(Sender: TObject);
      Procedure RadioGroup1Click(Sender: TObject);
      Procedure ztvFileScan1Finished(Sender: TObject; FilesCount: Longint;
         FilesSize: Int64);
      Procedure ztvFileScan1Process(Sender: TObject; Dir: String;
         FilesCount: Longint; FilesSize: Double);
      Procedure ztvFileScan1RecurseDir(Sender: TObject; Directory: String);
   Private
      Procedure WMDropFiles(Var Msg: {TMessage} TWMDropFiles); Message WM_DROPFILES;
   Public
   End;

Var
   Form1: TForm1;

Implementation

Uses
	ztvConsts,
   ShellAPI;

{$R *.DFM}

//-------------------------------------------------------------

Procedure TForm1.BitBtn1Click(Sender: TObject);
Begin
   //OpenDialog1.InitialDir := ;
   OpenDialog1.FileName := '*.*';
   OpenDialog1.Options := [ofAllowMultiSelect, ofFileMustExist];
   OpenDialog1.Filter := 'All files (*.*)|*.*';
   OpenDialog1.Title := 'Select file(s) to add ( Ctrl+Click or Shift+Click )';
   If OpenDialog1.Execute Then
   Begin
      ListBox1.Items.Assign(OpenDialog1.files);
      OpenDialog1.files.Clear();
   End;
End;
//-------------------------------------------------------------

Procedure TForm1.Button1Click(Sender: TObject);
Begin
   Label1.Caption := 'Total files 0 size 0';
   Label1.Update();
   Cursor := crHourGlass;
   With ztvFileScan1 Do
   Begin
      FillProperyValues();
      FileSpec := ListBox1.Items;
      Scan();
   End;
   Cursor := crDefault;
End;
//-------------------------------------------------------------

Procedure TForm1.Button2Click(Sender: TObject);
Begin
   ztvFileScan1.Stop;
End;
//-------------------------------------------------------------

Procedure TForm1.Button3Click(Sender: TObject);
Begin
   ListBox1.Clear();
   Edit1.SetFocus();
End;
//-------------------------------------------------------------

Procedure TForm1.FillProperyValues;
Begin
   With ztvFileScan1 Do
   Begin
   	Files.CLearList();
      UpdateList := cUpdateListCheck.Checked;
      RecurseDirs := cRecurseCheck.Checked;
      Sorted := TztvSortOptions(RadioGroup1.ItemIndex);
      ScanOptions := TfsScanOptions(RadioGroup2.ItemIndex);
      IncludeHiddenDirs := CheckBox1.Checked;

      (* define the Attributes property *)
      SetAttribute(fsZeroAttr, cZeroAttr.Checked);
      SetAttribute(fsArchive, cArchive.Checked);
      SetAttribute(fsDirectory, cDirectory.Checked);
      SetAttribute(fsHidden, cHidden.Checked);
      SetAttribute(fsReadOnly, cReadonly.Checked);
      SetAttribute(fsSysFile, cSysFile.Checked);
      //SetAttribute( fsVolumeID, cVolumeID.Checked );

      (* define the AttributesExclude property *)
      SetAttributeEx(fsZeroAttr, cZeroAttrEx.Checked);
      SetAttributeEx(fsArchive, cArchiveEx.Checked);
      SetAttributeEx(fsDirectory, cDirectoryEx.Checked);
      SetAttributeEx(fsHidden, cHiddenEx.Checked);
      SetAttributeEx(fsReadOnly, cReadonlyEx.Checked);
      SetAttributeEx(fsSysFile, cSysFileEx.Checked);
      //SetAttributeEx( fsVolumeID, cVolumeIDEx.Checked );
   End;
End;
//-------------------------------------------------------------

Procedure PutIntoGrid(AGrid: TStringGrid; Col, Row: Longint; s: String);
Var
   l: Integer;
Begin
   l := AGrid.Canvas.TextWidth(s) + 10;
   If l > AGrid.ColWidths[Col] Then
      AGrid.ColWidths[Col] := l;
   AGrid.Cells[Col, Row] := s;
End;
//-------------------------------------------------------------

Procedure EmptyRow(AGrid: TStringGrid; ARow, AColCount: Longint);
Var
   i: Longint;
Begin
   For i := 0 To AColCount Do
      AGrid.Cells[i, ARow] := '';
End;
//-------------------------------------------------------------

Procedure TForm1.FormActivate(Sender: TObject);
Begin
   With StringGrid1 Do
   Begin
      Cells[0, 0] := 'File name';
      Cells[1, 0] := 'Size';
      Cells[2, 0] := 'Date';
      Cells[3, 0] := 'Attr';
      Cells[4, 0] := 'Full path';
   End;
End;
//-------------------------------------------------------------

Procedure TForm1.FormCreate(Sender: TObject);
Begin
   DragAcceptFiles(Handle, True);
End;
//-------------------------------------------------------------

Procedure TForm1.ztvFileScan1Finished(Sender: TObject; FilesCount: Longint;
   FilesSize: Int64);
Var
   i: Cardinal;
   f: TFileObject;
   FormattedStr: String;
Begin
   If (FilesSize <= 0) Then
      FormattedStr := Format('%.2n KB', [0.0])
      //FormattedStr := '0'
   Else
      If (FilesSize < 1024) Then
         FormattedStr := Format('%.2n KB', [1.0])
         //FormattedStr := FormatFloat(',#######', 1) + ' KB'
      Else
         If FilesSize <= 1024000 (*99999*) Then
            FormattedStr := Format('%.2n KB', [FilesSize / 1024])
            //FormattedStr := FormatFloat(',#######', FilesSize / 1024) + ' KB'
         Else
            If FilesSize <= 1024000000 Then
               FormattedStr := Format('%.2n MB', [FilesSize / 1024000])
               //FormattedStr := FormatFloat(',#######', FilesSize / 1024000) + ' MB'
            Else
               FormattedStr := Format('%.2n GB', [FilesSize / 1024000000]);
   				//FormattedStr := FormatFloat(',#######', FilesSize / 1024000000) + ' GB';

   Label1.Caption := 'Total files ' + IntToStr(FilesCount) + ' size ' + FormattedStr;

   //Label3.Caption :=
     //	Format( '%s: %3d %s: %.0n',
     //   	['Total files ', FilesCount, ' Size ', FilesSize] );

   With StringGrid1 Do
   Begin
      RowCount := 2;
      FixedRows := 1;
      EmptyRow(StringGrid1, 1, 4);
      ColWidths[1] := 200;              //DefaultColWidth * 2;

      If ztvFileScan1.files.Count = 0 Then
         Exit
      Else
         StringGrid1.RowCount := ztvFileScan1.files.Count + 1;

      For i := 0 To Pred(ztvFileScan1.files.Count) Do
      Begin
         //If ztvFileScan1.Cancel Then Break;
         f := TFileObject(ztvFileScan1.files.Items[i]);
         PutIntoGrid(StringGrid1, 0, i + 1, f.FileName);

         PutIntoGrid(StringGrid1, 1, i + 1, IntToStr(
         	Int64(f.FileSizeHigh Shl 32) Or f.FileSizeLow
          	));

         PutIntoGrid(StringGrid1, 2, i + 1,  DateTimeToStr(FileDateToDateTime(f.FileTime)));
         PutIntoGrid(StringGrid1, 3, i + 1, ztvFileScan1.GetFileAttrStr(f.FileAttr));
         PutIntoGrid(StringGrid1, 4, i + 1, f.FullPath);
      End;
      Update;
   End;
End;
//-------------------------------------------------------------

Procedure TForm1.ztvFileScan1Process(Sender: TObject; Dir: String;
   FilesCount: Longint; FilesSize: Double);
Begin
   Label1.Caption := Dir;
End;
//-------------------------------------------------------------

Procedure TForm1.ztvFileScan1RecurseDir(Sender: TObject;
   Directory: String);
Begin
   Label1.Caption := Directory;
End;
//-------------------------------------------------------------

Function AppendDirTail(Path: String): String;
Begin
   If Path = '' Then
   Begin
      Result := '';
      Exit;
   End;
   If Path[Length(Path)] <> '\' Then
      Path := Path + '\';
   Result := Path;
End;
//-------------------------------------------------------------

Procedure TForm1.WMDropFiles(Var Msg: TWMDropFiles);
Var
   HDrop: THandle;
   FileName: Pchar;
   i, NumFiles: Integer;
Begin
   HDrop := Msg.Drop;
   GetMem(FileName, 255);
   NumFiles := DragQueryFile(HDrop, $FFFFFFFF, FileName, 255);
   Try
      For i := 0 To Pred(NumFiles) Do
      Begin
         DragQueryFile(HDrop, i, FileName, 255);
         If DirectoryExists(FileName) Then
            If StrEnd(FileName)^ <> '\' Then
               StrLCat(StrEnd(FileName), '\*.*'#0, 5);

         ListBox1.Items.Add(FileName);
      End;
   Finally
      DragFinish(HDrop);
      FreeMem(FileName, 255);
   End;
   Msg.Result := 0;
End;
//-------------------------------------------------------------

Procedure TForm1.RadioGroup1Click(Sender: TObject);
Begin
   ztvFileScan1.Sorted := TztvSortOptions(RadioGroup1.ItemIndex);
End;
//-------------------------------------------------------------

Procedure TForm1.ClearGrid(Sender: TObject);
Var
   i: Integer;
Begin
   For i := 0 To StringGrid1.ColCount - 1 Do
      StringGrid1.Cols[i].Clear;
End;
//-------------------------------------------------------------

Procedure TForm1.Edit1KeyPress(Sender: TObject; Var Key: Char);
Begin
   If Key = #13 Then
   Begin
      If Length(Edit1.Text) > 0 Then
      Begin
         ListBox1.Items.Add(Edit1.Text);
         Edit1.Text := '';
      End;
      Edit1.SetFocus();
   End;
End;
//-------------------------------------------------------------

End.