vlistview.pas

ziptv为delphi控件

//ROUTINES FOR MANAGING VIRTUAL DATA
//-------------------------------------------------------------
//-------------------------------------------------------------

Procedure TForm1.ListViewDataHint(Sender: TObject; StartIndex,
   EndIndex: Integer);
Begin
   //OnDataHint is called before OnData. This gives you a chance to
   //initialize only the data structures that need to be drawn.
   //You should keep track of which items have been initialized so no
   //extra work is done.
   If (StartIndex > FIDList.Count) Or (EndIndex > FIDList.Count) Then
      Exit;
End;
//-------------------------------------------------------------

Procedure TForm1.ListViewData(Sender: TObject; Item: TListItem);
Begin
   //OnData gets called once for each item for which the ListView needs
   //data. If the ListView is in Report View, be sure to add the subitems.
   //Item is a "dummy" item whose only valid data is it's index which
   //is used to index into the underlying data.
   If (Item.Index > FIDList.Count) Then
      Exit;

   With ShellItem(Item.Index)^ Do
   Begin
      Item.Caption := DisplayName;
      Item.ImageIndex := ImageIndex;
      If ListView.ViewStyle <> vsReport Then
         Exit;
      Item.SubItems.Add(Format('%d kB', [Size]));
   End;
End;
//-------------------------------------------------------------

Procedure TForm1.ListViewSelectItem(Sender: TObject; Item: TListItem;
   Selected: Boolean);
Begin
   If Selected Then
      Form1.Caption := Item.Caption;
End;
//-------------------------------------------------------------

Procedure TForm1.ListViewDataFind(Sender: TObject; Find: TItemFind;
   Const FindString: String; Const FindPosition: TPoint; FindData: Pointer;
   StartIndex: Integer; Direction: TSearchDirection; Wrap: Boolean;
   Var Index: Integer);
//OnDataFind gets called in response to calls to FindCaption, FindData,
//GetNearestItem, etc. It also gets called for each keystroke sent to the
//ListView (for incremental searching)
Var
   i: Integer;
   Found: Boolean;
Begin
   i := StartIndex;
   If (Find = ifExactString) Or (Find = ifPartialString) Then
   Begin
      Repeat
         If (i = FIDList.Count - 1) Then
            If Wrap Then
               i := 0
            Else
               Exit;

         Found := Pos(UpperCase(FindString), UpperCase(ShellItem(i)^.DisplayName)) = 1;
         Inc(i);
      Until Found Or (i = StartIndex);

      If Found Then
         Index := i - 1;
   End;
End;
//-------------------------------------------------------------

Procedure TForm1.ListViewColumnClick(Sender: TObject;
   Column: TListColumn);
Var
   required_column: Integer;
Begin
   Screen.Cursor := crHourGlass;
   required_column := Column.Index;

   If required_column = fSortColumn Then
      fSortForward := Not fSortForward
   Else
   Begin
      fSortColumn := required_column;
      fSortForward := True;
   End;

   SortOnColumn();
   Screen.Cursor := crDefault;
End;
//-------------------------------------------------------------

Procedure TForm1.SortOnColumn;
Begin
   Case fSortColumn Of
      0: FIDList.Sort(NameSort);
      1: FIDList.Sort(SizeSort);
      2: FIDList.Sort(TypeSort);
      3: FIDList.Sort(DateSort);
      4: FIDList.Sort(LibSort);
   End;

   //ListView.Items.Count := FIDList.Count;
   ListView.Repaint();
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;
//-------------------------------------------------------------

// Little light in right corner of form

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;
//-------------------------------------------------------------

Procedure TForm1.ApplicationBusy;
Begin
   Cursor := crHourGlass;
   SetLedColor(clRed);
End;
//-------------------------------------------------------------

Procedure TForm1.ApplicationWaiting;
Begin
   SetLedColor(clGreen);
   Cursor := crDefault;
End;
//-------------------------------------------------------------

// Menu - File/Enable & File/Disable

Procedure TForm1.EnableMenus;
Var
   CompressSupported,
      DecompressSupported: Boolean;
Begin
   mnuAction1.Visible := True;

   CompressSupported := ZipTV1.IsArcCompressable(ZipTV1.ArcType);
   DecompressSupported := ZipTV1.IsArcDecompressable(ZipTV1.ArcType);

   (* Currently can't add files to a CAB archive... only create new *)
   If CompressSupported And (ZipTV1.ArcType = atCab) Then
      CompressSupported := False;

   mnuAddFiles1.Enabled := CompressSupported;
   mnuDelete1.Enabled := CompressSupported;
   mnuExtract1.Enabled := DecompressSupported;
End;
//-------------------------------------------------------------

Procedure TForm1.DisplayFile;
Begin
   SetCurrentDir(ExtractFileDir(OpenDialog1.FileName));

   ZipTV1.FileSpec.Clear();

   ApplicationBusy();
   Try
      If ZipTV1.FileSpec.Count = 0 Then
         ZipTV1.FileSpec.Add('*.*');

      ListView.Items.Clear();

      If OpenDialog1.FileName <> '' Then
      Begin
         ZipTV1.ArchiveFile := OpenDialog1.FileName;
         ZipTV1.Activate();
         ListView.SetFocus();
      End;
   Finally
      ApplicationWaiting();
   End;

   If (ZipTV1.ArcType = atUUE) Then
      //   DoUueDecode;

      EnableMenus();
   mnuClose1.Enabled := True;
   If (ZipTV1.IsArcValid(ZipTV1.ArcType)) And (ZipTV1.FileSpec.Count > 0) Then
      Caption := OpenDialog1.FileName + '    (' + ZipTV1.FileSpec[0] + ')'
   Else
      Caption := '';
End;
//-------------------------------------------------------------

Procedure TForm1.mnuOpen1Click(Sender: TObject);
Begin
   OpenDialog1.InitialDir := GetCurrentDir;
   OpenDialog1.Filter := LoadStr(F_TZIPTV);
   OpenDialog1.Title := 'Open Archive...';
   OpenDialog1.Options := [ofHideReadOnly, ofFileMustExist, ofPathMustExist];

   If OpenDialog1.Execute Then
      DisplayFile()
   Else
      Caption := '';
End;
//-------------------------------------------------------------

(* OnRead event *)

Procedure TForm1.ZipTV1Read(Sender: TObject; Offset, Filenum: Integer);
Var
   ShellItem: PShellItem;
   ZipCommon: TZipCommon;
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);

   ShellItem := New(PShellItem);
   ShellItem.Empty := False;
   ShellItem.DisplayName := ExtractFilename(ZipCommon.FileName);
   ShellItem.Size := ZipCommon.PackedSize;
   ShellItem.ImageIndex := GetIconIndex(ZipCommon.FileName, FILE_ATTRIBUTE_NORMAL);
   FIDList.Add(ShellItem);
End;
//-------------------------------------------------------------

Procedure TForm1.mnuExit1Click(Sender: TObject);
Begin
   Close();
End;
//-------------------------------------------------------------

Procedure TForm1.ZipTV1Activate(Sender: TObject);
Begin
   Start := TimeGetTime();
   ClearIDList();
   SelectedPackedSize := 0;
   SelectedUnpackedSize := 0;
End;
//-------------------------------------------------------------

Procedure TForm1.ZipTV1Deactivate(Sender: TObject);
Begin
   ListView.Items.Count := FIDList.Count;
   ListView.Repaint();
   Caption := Format('%d ms', [TimeGetTime - Start]);
End;
//-------------------------------------------------------------

// OnTotals event

Procedure TForm1.ZipTV1Totals(Sender: TObject; UnpackSize,
   PackSize: Int64; Ratio, NumFiles: Integer);
Begin
   With StatusBar1 Do
   Begin
      If ZipTV1.Count > 0 Then
         Panels[0].Text := ArcTypeNames[ZipTV1.ArcType]
      Else
         Panels[0].Text := '';

      Panels[1].Text := 'Files: ' + IntToStr(ZipTV1.Count);
      Panels[2].Text := 'Packed: ' + FloatToStr(ZipTV1.TotalPackedSize);
      Panels[3].Text := 'Unpacked: ' + FloatToStr(ZipTV1.TotalUnpackedSize);
      Panels[4].Text := 'Ratio: ' + IntToStr(ZipTV1.TotalRatio) + '%';
   End;

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

End.