unit1.pas

ziptv为delphi控件

   FieldSpacing: String;
Begin
   crlf := Char(13) + Char(10);
   If CommaDelimited Then
      FieldSpacing := ','
   Else
      FieldSpacing := Char(9);
   j := 0;
   With DragDropListView Do
   Begin
      For i := 0 To Items.Count - 1 Do
         If Items[i].Selected Then
         Begin
            k := Length(Items[i].Caption);
            Move(Items[i].Caption[1], Buffer[j], k);
            j := j + k;                 {left justify}
            If Not CommaDelimited Then
            Begin
               FillChar(Buffer[j], FieldLen[0] - k, ' ');
               j := j + FieldLen[0] - k;
            End;

            p := 0;
            For q := 1 To MaxColumn Do
               If mnuView1.Items[q].Checked Then
               Begin
                  Move(FieldSpacing[1], Buffer[j], Length(FieldSpacing));
                  j := j + Length(FieldSpacing);
                  k := Length(Items[i].SubItems[p]);
                  Case q Of
                     1, 6:
                        Begin
                           Move(Items[i].SubItems[p][1], Buffer[j], k);
                           j := j + k;  {left justify}
                           If Not CommaDelimited Then
                           Begin
                              FillChar(Buffer[j], FieldLen[q] - k, ' ');
                              j := j + FieldLen[q] - k;
                           End;
                        End;
                     2..5:
                        Begin
                           If Not CommaDelimited Then
                           Begin
                              FillChar(Buffer[j], FieldLen[q] - k, ' ');
                              j := j + FieldLen[q] - k;
                           End;
                           Move(Items[i].SubItems[p][1], Buffer[j], k);
                           j := j + k;  {right justify}
                        End;
                  End;
                  Inc(p);
               End;
            Move(crlf[1], Buffer[j], 2);
            j := j + 2;
         End;
      Buffer[j] := Char(0);
   End;
End;
//-------------------------------------------------------------

Procedure TForm1.CopyList(dest: TDest);
Var
   Text: TextFile;
Begin
   If Busy Then
      Exit;

   Busy := True;
   CalcBuffer;
   Try
      GetMem(Buffer, BufferSize + 1);
      MakeBuffer;
      Case dest Of
         ToClipboard: Clipboard.SetTextBuf(Buffer);

         ToPrinter:
            Begin
               AssignPrn(Text);
               Rewrite(Text);
               Write(Text, Buffer);
               System.Close(Text);
            End;

         ToFile:
            Try
               AssignFile(Text, SaveDialog1.FileName);
               Rewrite(Text);
               Write(Text, Buffer);
            Finally
               System.Close(Text);
            End;
      End;
   Finally
      FreeMem(Buffer, BufferSize + 1);
      Busy := False;
   End;
End;
//-------------------------------------------------------------
// Intercepted compressor component's event

Procedure TCompBase_EventHandlers.ArcOnCompressBegin(Sender: TObject; FName: String;
   Count:
   Integer; Var Extract: Boolean);
Var
   FileName: String;
Begin
   FileName := MinimizeName('Processing: ' + FName, Form1.StatusBar1.Canvas,
      Form1.StatusBar1.Width);
   With Form1 Do
   Begin
      StatusBar1.SimpleText := FileName;
      StatusBar1.Update();
   End;
End;
//-------------------------------------------------------------
// Intercepted compressor component's event

Procedure TCompBase_EventHandlers.ArcOnCompressEnd(Sender: TObject; FName: String;
   CRC_PASS: Boolean);
Begin
   With Form1 Do
   Begin
      StatusBar1.SimpleText := '';
      ProgressBar1.Update();
      ProgressBar2.Update();
   End;
End;
//-------------------------------------------------------------
// Intercepted compressor component's event

Procedure TCompBase_EventHandlers.ArcOnCompressFileExists(Sender: TObject; FileName:
   String;
   FileDate: TDateTime; Var OverwriteMode: TOverwriteMode);
Var
   Msg: String;
Begin
   Msg := 'Filename: ' + FileName + #13#13 + 'File already exists, overwrite?';

   If MessageDlg(Msg, mtInformation, [mbYes, mbNo], 0) = mrNo Then
      OverwriteMode := omSkip
   Else
      OverwriteMode := omOverwrite;

End;
//-------------------------------------------------------------
// Intercepted compressor component's event

Procedure TCompBase_EventHandlers.ArcOnError(Sender: TObject; FileName, ExtendedMsg,
   VolumeID: String; ECode: Integer);
Begin
   Form1.ZipTV1.OnError(Sender, FileName, ExtendedMsg, VolumeID, ECode);
End;
//-------------------------------------------------------------
// Intercepted compressor component's event

Procedure TCompBase_EventHandlers.ArcOnGetPassword(Sender: TObject; FName: String;
   Var Password: String; Var TryAgain: Boolean);
Begin
End;
//-------------------------------------------------------------
// Intercepted compressor component's event

Procedure TCompBase_EventHandlers.ArcOnProgress(Sender: TObject; ProgressByFile,
   ProgressByArchive: Byte);
Begin
   With Form1 Do
   Begin
      ProgressBar1.Position := Integer(ProgressByFile);
      ProgressBar2.Position := Integer(ProgressByArchive);
      ProgressBar1.Update;
      ProgressBar2.Update;
   End;
End;
//-------------------------------------------------------------
// Intercepted compressor component's event

Procedure TCompBase_EventHandlers.ArcOnRenameDupeFile(Sender: TObject;
   OldFilename: String; Var NewFileName: String; Var Rename: Boolean);
Begin
   Rename := False;
End;
//-------------------------------------------------------------
// Intercepted compressor component's event

Procedure TCompBase_EventHandlers.ArcOnReplaceFile(Sender: TObject; FileName,
   NewFileName: AnsiString; Date, NewDate: TDateTime; FileSize, NewFileSize:
   Int64; Attr, NewAttr: Integer; Var Replace: Boolean);
Begin
   Replace := False;
End;
//-------------------------------------------------------------
// TZipTV: OnError event

Procedure TForm1.ZipTV1Error(Sender: TObject; FileName, ExtendedMsg,
   VolumeID: String; ECode: Integer);
Begin
   ShowMessage(FileName + #13#13 +
      'Error#: ' + IntToStr(ECode) + #13 +
      'Error: ' + LoadStr(ECode) + #13#13 +
      'Extended: ' + ExtendedMsg + #13#13 +
      'OnError event...');

End;
//-------------------------------------------------------------
// TZipTV: OnRead event

Procedure TForm1.ZipTV1Read(Sender: TObject; Offset, Filenum: Integer);
Var
   ZipCommon: TZipCommon;
   NewItem: TListItem;
Begin

   (* ZipCommon is the parent class to all ZipTV components.		*)
   (* Typecast the 'Sender' parameter as type TZipCommon to share	*)
   (* properties with all components.										*)
   ZipCommon := TZipCommon(Sender);

   NewItem := DragDropListView.Items.Add; (* Create a new row *)

   With NewItem Do
   Begin

      Data := Pointer(Offset);          (* For future use *)

      (* Add associated image to list.  The system image list  *)
      (* MUST first be initialized before using this property!	*)
      (* See method InitializeImageList.								*)
      ImageIndex := GetImageIndex(ZipCommon.FileName);

      //Caption := ExtractFilename( ZipCommon.Filename ); (* Filename property		*)
      Caption := ZipCommon.FileName;    (* Filename property		*)
      With SubItems Do
      Begin

         Add(FormatDateTime('mm' + DateSeparator +
            'dd' + DateSeparator +
            'yy hh:mm', ZipCommon.Date)); (* Date property 			*)

         //one way...
         //Add( Format('%d kB', [ZipCommon.PackedSize]) );
         //...or another
         Add(IntToStr(ZipCommon.PackedSize)); (* PackedSize property 	*)

         //one way...
         //Add( Format('%d kB', [ZipCommon.UnpackedSize]) );
         //...or another
         Add(IntToStr(ZipCommon.UnpackedSize)); (* UnpackedSize property*)

         Add(IntToStr(ZipCommon.Ratio) + '%'); (* Ratio						*)

         Add(ZipCommon.sCompressionMethod); (* Method - string		*)
         //or
         //Add( IntToStr( ZipCommon.wCompressionMethod ) );		(* Method - word			*)

         Add(ZipCommon.FileAttrToString(ZipCommon.ExternalAttr, Byte('_')) +
            ' (' + IntToStr(ZipCommon.ExternalAttr) + ')');

         Add(ExtractFilePath(ZipCommon.FileName));

         Add(ZipCommon.GetFileType(ZipCommon.FileName)); (* Windows associated filetype *)

         Add(IntToHex(ZipCommon.CRC, 8)); (* CRC Property *)

         (* Beginning offset into compressed file  *)
         Add(IntToStr(Offset));

         If ZipCommon.Encrypted Then    (* Encrypted property	*)
            Add('Yes')
         Else
            Add('No');

      End;
   End;
End;
//-------------------------------------------------------------
// TZipTV: OnTotals event

Procedure TForm1.ZipTV1Totals(Sender: TObject; UnpackSize, PackSize: Double;
   Ratio, NumFiles: Integer);
Begin
   If NumFiles > 0 Then
   Begin
      Ratio := CalcRatio(ZipTV1.TotalPackedSize, ZipTV1.TotalUnpackedSize);

      With StatusBar1 Do
      Begin

         If NumFiles > 0 Then
            Panels[0].Text := ArcTypeNames[ZipTV1.ArcType]
         Else
            Panels[0].Text := '';

         Panels[1].Text := 'Files: ' + IntToStr(NumFiles);
         Panels[2].Text := 'Packed: ' + Format('%.0n', [ZipTV1.TotalPackedSize]);
         Panels[3].Text := 'Unpacked: ' + Format('%.0n', [ZipTV1.TotalUnpackedSize]);
         Panels[4].Text := 'Ratio: ' + IntToStr(Ratio) + '%';
      End;
   End
   Else
      StatusBar1.SimpleText := '';

   ProgressBar1.Position := 0;
   ProgressBar2.Position := 0;
   ProgressBar1.Visible := False;
   ProgressBar2.Visible := False;
   StatusBar1.SimplePanel := False;
   StatusBar1.Update();
End;
//-------------------------------------------------------------

Procedure TForm1.BitBtn1Click(Sender: TObject);
Begin
   OpenDialog1.FileName := Edit1.Text;
   OpenDialog1.Title := 'Select file(s) to add ( Ctrl+Click or Shift+Click )';
   OpenDialog1.Options := [ofHideReadOnly, ofPathMustExist];

   If OpenDialog1.Execute Then
      Edit1.Text := OpenDialog1.FileName;
End;
//-------------------------------------------------------------

Procedure TForm1.pbxLedClick(Sender: TObject);
Var
   DoCancel: Boolean;
Begin
   DoCancel := True;
   If fCompBase <> Nil Then
      fCompBase.Cancel := True
   Else
      DoCancel := False;

   If DoCancel Then
   Begin
      StatusBar1.SimpleText := 'Aborting...';
      StatusBar1.Update();
      DragDropListView.Cursor := crDefault;
   End;
End;
//-------------------------------------------------------------

Procedure TForm1.pbxLedPaint(Sender: TObject);
Begin
   With Sender As TPaintBox Do
      Canvas.Draw((Width - imgLed.Width) Div 2,
         (Height - imgLed.Height) Div 2,
         imgLed.Picture.Graphic);
End;
//-------------------------------------------------------------
// Change colors of little light in corner of form

Procedure TForm1.SetLedColor(lColor: TColor);
Begin
   With imgLed.Canvas Do
   Begin
      Brush.Color := lColor;
      FloodFill(6, 6, Pixels[6, 6], fsSurface);
   End;
   pbxLed.Repaint;
End;
//-------------------------------------------------------------

Procedure TForm1.FormActivate(Sender: TObject);
Begin
   ComboBox1.ItemIndex := Ord(sdRelative);
   ComboBox2.ItemIndex := 6;            // .zip format as default
   ComboBox3.ItemIndex := Ord(cmTempFile); // write to temp-file as default
   ComboBox4.ItemIndex := Ord(daFileDate);  // set compressed file's date as the disk file's date
End;
//-------------------------------------------------------------

End.