vlistview.pas

ziptv为delphi控件

// **************************************************************************
// NOTE: We are not the authors of the virtual listview code.  We simply took
// the code and adapted it to work in conjunction with the ZipTV components.
//
// This demo does not peer indepth the functionality of the ZipTV Components.
// It's simply a demo in how to incorporate the TZipTV component into a
// TListView in virtual mode.  For a more indepth demo of ZipTV, see the demo
// demos\zipview\zptvdemo.dpr.
//
// We have the original code, but there is no author's name to give credit. It
// may have been a Delphi example of how to use a Tlistview component in
// virtual mode for greatly enhanced speed.
// **************************************************************************
Unit VListView;

Interface

Uses
   Windows,
   Messages,
   SysUtils,
   Classes,
   Graphics,
   Controls,
   Forms,
   Dialogs,
   ImgList,
   ComCtrls,
   ExtCtrls,
   MMSystem,
   Menus,
   ShellAPI,
   ztvRegister,
   ztvBase,
   ztvGbls,
   ztvZipTV,
   Err_Msgs,
   ztvStreams;

Type
   PShellItem = ^TShellItem;
   TShellItem = Record
      ID: Integer;
      Empty: Boolean;
      DisplayName,
         TypeName,
         Lib: String;
      ModDate: TDate;
      ImageIndex,
         Size,
         Attributes: Integer;
   End;

   TForm1 = Class(TForm)
      ListView: TListView;
      ImageList1: TImageList;
      ZipTV1: TZipTV;
      MainMenu1: TMainMenu;
      mnuFile1: TMenuItem;
      mnuNew1: TMenuItem;
      mnuOpen1: TMenuItem;
      mnuClose1: TMenuItem;
      mnuN1: TMenuItem;
      mnuUUEncode1: TMenuItem;
      mnuFileSpec1: TMenuItem;
      mnuN2: TMenuItem;
      mnuExit1: TMenuItem;
      mnuAction1: TMenuItem;
      mnuAddFiles1: TMenuItem;
      mnuDelete1: TMenuItem;
      mnuExtract1: TMenuItem;
      mnuRefresh1: TMenuItem;
      mnuView1: TMenuItem;
      mnuBlankDirs1: TMenuItem;
      mnuSort1: TMenuItem;
      mnuDisplayElapsedTime1: TMenuItem;
      ErrorMessages1: TMenuItem;
      OpenDialog1: TOpenDialog;
      StatusBar1: TStatusBar;
      ProgressBar1: TProgressBar;
      ProgressBar2: TProgressBar;
      pbxLed: TPaintBox;
      imgLed: TImage;
      Procedure FormCreate(Sender: TObject);
      Procedure ListViewData(Sender: TObject; Item: TListItem);
      Procedure ListViewDataHint(Sender: TObject; StartIndex,
         EndIndex: Integer);
      Procedure ListViewSelectItem(Sender: TObject; Item: TListItem;
         Selected: Boolean);
      Procedure ListViewDataFind(Sender: TObject; Find: TItemFind;
         Const FindString: String; Const FindPosition: TPoint;
         FindData: Pointer; StartIndex: Integer; Direction: TSearchDirection;
         Wrap: Boolean; Var Index: Integer);
      Procedure ListViewColumnClick(Sender: TObject; Column: TListColumn);
      Procedure mnuOpen1Click(Sender: TObject);
      Procedure ZipTV1Read(Sender: TObject; Offset, Filenum: Integer);
      Procedure SetLedColor(lColor: TColor);
      Procedure pbxLedPaint(Sender: TObject);
      Procedure mnuExit1Click(Sender: TObject);
      Procedure ZipTV1Activate(Sender: TObject);
      Procedure ZipTV1Deactivate(Sender: TObject);
      Procedure ZipTV1Totals(Sender: TObject; UnpackSize, PackSize: Int64;
         Ratio, NumFiles: Integer);
   Private
      FIDList: TList;
      fSortColumn: Integer;
      Procedure GetSmallImages;
      Procedure ClearIDList;
      Procedure SortOnColumn;
      Procedure ApplicationBusy;
      Procedure ApplicationWaiting;
      Procedure EnableMenus;
      Procedure DisplayFile;
      Function ShellItem(Index: Integer): PShellItem;
      Function GetIconIndex(Const aFile: String; Attrs: DWord): Integer;
   End;

Var
   Form1: TForm1;
   fSortForward: Boolean;

Implementation

{$R *.DFM}

Uses
   CommCtrl;

Const
   (* Column Headers *)
   COLUMN_FILENAME = 0;
   COLUMN_DATETIME = 1;
   COLUMN_PACKED = 2;
   COLUMN_UNPACKED = 3;
   COLUMN_RATIO = 4;
   COLUMN_METHOD = 5;
   COLUMN_ATTR = 6;
   COLUMN_FOLDER = 7;
   COLUMN_FILETYPE = 8;
   COLUMN_CRC = 9;
   COLUMN_OFFSET = 10;
   COLUMN_ENCRYPTED = 11;
   COLUMN_VOLUMENAME = 12;
   COLUMN_COMMENT = 13;

Const
   TOTALS = 0;
   Selected = 1;

Var
   Start: Word;
   SelectedPackedSize,
      SelectedUnpackedSize: Integer;

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

   //Function TForm1.ListView_SetExtendedListViewStyle(LVWnd: HWnd; ExStyle: LPARAM): Dword;
   //Begin
   //  Result := SendMessage(LVWnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0, ExStyle);
   //End;
   //-------------------------------------------------------------

Function CompareInt(I1, I2: Integer): Integer;
Begin
   If I1 > I2 Then
      Result := 1
   Else
      If I1 < I2 Then
         Result := -1
      Else
         Result := 0;
End;
//-------------------------------------------------------------

Function ValidDate(Const s: String): Boolean;
Var
   d: TDateTime;
Begin
   Try
      d := StrToDate(s);
      If d <> 0 Then
         ;                              //satisfy compiler
      Result := True;
   Except
      Result := False;
   End;
End;
//-------------------------------------------------------------

Function NameSort(Item1, Item2: Pointer): Integer;
Begin
   Result := AnsiCompareText(PShellItem(Item1).DisplayName,
      PShellItem(Item2).DisplayName);
   If Not fSortForward Then
      Result := -Result;
End;
//-------------------------------------------------------------

Function SizeSort(Item1, Item2: Pointer): Integer;
Begin
   Result := CompareInt(PShellItem(Item1).Size, PShellItem(Item2).Size);
   If Not fSortForward Then
      Result := -Result;
End;
//-------------------------------------------------------------

Function TypeSort(Item1, Item2: Pointer): Integer;
Begin
   Result := AnsiCompareText(PShellItem(Item1).TypeName, PShellItem(Item2).TypeName);
   If Not fSortForward Then
      Result := -Result;
End;
//-------------------------------------------------------------

Function DateSort(Item1, Item2: Pointer): Integer;
Begin
   If PShellItem(Item1).ModDate > PShellItem(Item2).ModDate Then
      Result := 1
   Else
      If PShellItem(Item1).ModDate < PShellItem(Item2).ModDate Then
         Result := -1
      Else
         Result := 0;

   If Not fSortForward Then
      Result := -Result;
End;
//-------------------------------------------------------------

Function LibSort(Item1, Item2: Pointer): Integer;
Begin
   Result := AnsiCompareText(PShellItem(Item1).Lib,
      PShellItem(Item2).Lib);
   If Not fSortForward Then
      Result := -Result;
End;
//-------------------------------------------------------------

Procedure TForm1.GetSmallImages;
Var
   SysIL: HImageList;
   SFI: TSHFileInfo;
Begin
   // Get the small system image list.  Replace SHGFI_SMALLICON with
   // SHGFI_LARGEICON for large images.
   SysIL := SHGetFileInfo('', 0, SFI, SizeOf(SFI),
      SHGFI_SYSICONINDEX Or SHGFI_SMALLICON);
   If SysIL <> 0 Then
   Begin
      // Assign the system list to the components
      ImageList1.Handle := SysIL;
      // The following prevents the image list handle from being
      // destroyed when the component is.
      ImageList1.ShareImages := True;
   End;
End;
//-------------------------------------------------------------

Function TForm1.GetIconIndex(Const aFile: String; Attrs: DWord): Integer;
Var
   SFI: TSHFileInfo;
Begin
   SHGetFileInfo(Pchar(aFile), Attrs, SFI, SizeOf(TSHFileInfo),
      SHGFI_SYSICONINDEX Or SHGFI_USEFILEATTRIBUTES);
   Result := SFI.iIcon;
End;
//-------------------------------------------------------------

Procedure TForm1.FormCreate(Sender: TObject);
Begin
   ShortDateFormat := 'dd-mm-yyyy';
   GetSmallImages;
   FIDList := TList.Create;
End;
//-------------------------------------------------------------

Function TForm1.ShellItem(Index: Integer): PShellItem;
Begin
   Result := PShellItem(FIDList[Index]);
End;
//-------------------------------------------------------------

//SHELL-RELATED ROUTINES.

Procedure TForm1.ClearIDList;
Var
   i: Integer;
Begin
   For i := 0 To FIDList.Count - 1 Do
      Dispose(ShellItem(i));

   FIDList.Clear();
End;

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