kaziplistview.pas

Complete Zip Program

unit KAZipListView;

interface

uses
  Windows,
  Masks,
  Messages,
  SysUtils,
  ShellAPI,
  Classes,
  Graphics,
  Controls,
  ComCtrls,
  CommCtrl;

type
  TLVSortType      = (Ascending, Descending);
  Columns          = (scPath, scDate, scUnCompressedSize, scCompressedSize, scRatio, scComment, scCRC, scEncryption, scAttributes);
  TShowColumns     = SET OF Columns;

  TKAZipListView = class(TListView)
  private
    { Private declarations }
    FShowIcons          : Boolean;
    FImageList          : TImageList;
    FDirList            : TStringList;
    FColList            : TStringList;
    FAutoSizeColumns    : Boolean;

    FInCreate           : Boolean;

    FLastSortType       : TLVSortType;
    FZipItems           : TStringList;
    FExtList            : TStringList;
    FSortColumn         : Integer;
    FLastColumn         : Integer;
    BMP_Up              : TBitmap;
    BMP_Down            : TBitmap;
    BMP_Folder_Small    : TBitmap;
    BMP_Folder_Big      : TBitmap;
    FShowSortGlyph      : Boolean;
    FMultiselect        : Boolean;
    FFilterFolder       : String;
    FFiltered           : Boolean;
    FShowFolders        : Boolean;
    FShowColumns        : TShowColumns;
    FFilterWildcard     : String;
    procedure SetShowColumns(const Value: TShowColumns);
    procedure SetShowFolders(const Value: Boolean);
    procedure SetFiltered(const Value: Boolean);
    procedure SetFilterFolder(const Value: String);
    procedure SetShowIcons(const Value: Boolean);
    procedure SetShowSortGlyph(const Value: Boolean);
    procedure SetAutoSizeColumns(const Value: Boolean);
    function  GetViewStyle: TViewStyle;
    procedure SetFilterWildcard(const Value: String);
  protected
    { Protected declarations }
    Procedure InitColumns;
    Function  GetID(I:Integer):Integer;
    function  GetDelphiTempFileName: String;
    Function  GetFileIcon(FileName:String;SmallIcon: Boolean):TIcon;
    Procedure BuildIcons;
    Procedure ClearIcons;
    Procedure ResizeListView;
    Procedure DoCompare(Sender: TObject; Item1, Item2: TListItem; Data : Integer; var Compare: Integer);
    Procedure DoSort;

    procedure   SetMultiSelect(Value: Boolean); override;
    procedure   ColClick(Column: TListColumn); override;
    procedure   WndProc(var Message: TMessage); override;
    procedure   SetViewStyle(Value: TViewStyle);override;
    Procedure   Loaded;Override;
  public
    { Public declarations }
    Procedure   FillListView(List:TStringList);
    Constructor Create(AOwner:TComponent);Override;
    Destructor  Destroy;Override;
  published
    { Published declarations }
    Property ShowIcons         : Boolean      read FShowIcons          write SetShowIcons;
    Property ShowSortGlyph     : Boolean      read FShowSortGlyph      write SetShowSortGlyph;
    Property ShowFolders       : Boolean      read FShowFolders        write SetShowFolders;
    Property ShowColumns       : TShowColumns read FShowColumns        write SetShowColumns;
    Property MultiSelect       : Boolean      read FMultiselect        write SetMultiSelect;
    Property AutoSizeColumns   : Boolean      read FAutoSizeColumns    write SetAutoSizeColumns;
    Property FilterFolder      : String       Read FFilterFolder       Write SetFilterFolder;
    Property FilterWildcard    : String       Read FFilterWildcard     Write SetFilterWildcard; 
    Property Filtered          : Boolean      Read FFiltered           Write SetFiltered;
    Property ViewStyle         : TViewStyle   Read GetViewStyle        Write SetViewStyle;
    Property Items             Stored False;
  end;

procedure Register;

implementation
{$R KAZipListViewRC.res}

procedure Register;
begin
  RegisterComponents('KA', [TKAZipListView]);
end;

{ TKAZipListView }


constructor TKAZipListView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FInCreate        := True;

  FShowIcons       := True;
  FImageList       := Nil;
  FAutoSizeColumns := False;
  FLastSortType    := Ascending;
  FSortColumn      := -1;
  FLastColumn      := -1;
  FShowSortGlyph   := True;
  FMultiselect     := False;
  BMP_Up           := TBitmap.Create;
  BMP_Down         := TBitmap.Create;
  BMP_Folder_Small := TBitmap.Create;
  BMP_Folder_Big   := TBitmap.Create;

  FShowColumns     := [scPath, scDate, scUnCompressedSize, scCompressedSize, scRatio, scComment, scCRC, scEncryption, scAttributes];

  FZipItems        := TStringList.Create;
  FExtList         := TStringList.Create;
  FDirList         := TStringList.Create;
  FColList         := TStringList.Create;
  FDirList.Sorted  := True;

  BMP_Up.LoadFromResourceName(Hinstance,'LVUP');
  BMP_Down.LoadFromResourceName(Hinstance,'LVDOWN');
  BMP_Folder_Small.LoadFromResourceName(Hinstance,'FOLDER_SMALL');
  BMP_Folder_Big.LoadFromResourceName(Hinstance,'FOLDER_BIG');

  HideSelection    := False;
  RowSelect        := True;
  FInCreate        := False;
end;

destructor TKAZipListView.Destroy;
begin
  BMP_Up.Free;
  BMP_Down.Free;
  BMP_Folder_Small.Free;
  BMP_Folder_Big.Free;
  FExtList.Free;
  FZipItems.Free;
  FDirList.Free;
  FColList.Free;
  inherited Destroy;
end;

procedure TKAZipListView.Loaded;
begin
  inherited Loaded;
  if Columns.Count=0 Then InitColumns;
  if FShowIcons Then BuildIcons;
  SetMultiSelect(FMultiSelect); 
end;


procedure TKAZipListView.WndProc(var Message: TMessage);
Var
  Draw     : TNMLVCustomDraw;
  Rect     : TRect;
  DC       : HDC;
  ColNo    : Integer;
  X        : Integer;
  Y        : Integer;
Begin
  if Message.Msg = WM_ERASEBKGND then
    DefaultHandler(Message)
  Else
    Inherited WndProc(Message);
  if (Message.Msg=WM_NOTIFY) Then
     Begin
        Try
         with TWMNotify(Message) do
           Begin
             Case NMHdr.code of
               NM_CUSTOMDRAW     : Begin
                                     Message.Result := CDRF_DODEFAULT;
                                     Draw := PNMLVCustomDraw(Message.lParam)^;
                                     Case Draw.nmcd.dwDrawStage of
                                          CDDS_PREPAINT     : Begin
                                                                Message.Result := CDRF_NOTIFYITEMDRAW;
                                                              End;
                                          CDDS_ITEMPREPAINT : Begin
                                                                Message.Result :=  CDRF_NOTIFYPOSTPAINT;
                                                              End;
                                          CDDS_ITEMPOSTPAINT : Begin
                                                                  ColNo := Draw.nmcd.dwItemSpec;
                                                                  if (FSortColumn=ColNo) And (FShowSortGlyph) Then
                                                                     Begin
                                                                       Rect  := Draw.nmcd.rc;
                                                                       DC    := Draw.nmcd.hdc;
                                                                       if FLastSortType = Descending Then
                                                                          Begin
                                                                            X := Rect.Right-(BMP_Up.Width+4);
                                                                            Y := ((Rect.Bottom-Rect.Top)-BMP_Up.Height) Div 2;
                                                                            if (Draw.nmcd.uItemState and CDIS_SELECTED > 0) Then
                                                                               Begin
                                                                                 Inc(X,2);
                                                                                 Inc(Y,2);
                                                                               End;
                                                                            BitBlt(DC,X,Y,BMP_Up.Width,BMP_Up.Height,BMP_UP.Canvas.Handle,0,0,SRCCOPY);
                                                                          End;
                                                                       if FLastSortType = Ascending Then
                                                                          Begin
                                                                            X := Rect.Right-(BMP_Down.Width+4);
                                                                            Y := ((Rect.Bottom-Rect.Top)-BMP_Down.Height) Div 2;
                                                                            if (Draw.nmcd.uItemState and CDIS_SELECTED > 0) Then
                                                                               Begin
                                                                                 Inc(X,2);
                                                                                 Inc(Y,2);
                                                                               End;
                                                                            BitBlt(DC,X,y,BMP_Down.Width,BMP_Down.Height,BMP_Down.Canvas.Handle,0,0,SRCCOPY);
                                                                          End;
                                                                     End;
                                                                  Message.Result := CDRF_NOTIFYSUBITEMDRAW;
                                                               End;
                                     End;
                                   End;
              End;
          End;
        Finally
        End;
     End;
End;

Procedure TKAZipListView.InitColumns;
var
  Col  : TListColumn;
Begin
  Columns.Clear;
  FColList.Clear;
  Col          := Columns.Add;
  Col.Caption  := 'File Name';
  Col.Width    := 150;
  Col.Tag      := 0;

  if scPath In FShowColumns Then
     Begin
       Col          := Columns.Add;
       Col.Caption  := 'File Path';
       Col.Width    := 150;
       Col.Tag      := 1;
     End;

  if scDate In FShowColumns Then
     Begin
        Col          := Columns.Add;
        Col.Caption  := 'File Date';
        Col.Width    := 120;
        Col.Tag      := 2;
     End;

  if scUnCompressedSize In FShowColumns Then
     Begin
        Col          := Columns.Add;
        Col.Caption  := 'File Size';
        Col.Width    := 100;
        Col.Tag      := 3;
     End;

  if scCompressedSize In FShowColumns Then
     Begin
       Col          := Columns.Add;
       Col.Caption  := 'Compressed Size';
       Col.Width    := 100;
       Col.Tag      := 4;
     End;

  if scRatio In FShowColumns Then
     Begin
        Col          := Columns.Add;
        Col.Caption  := 'Ratio';
        Col.Width    := 100;
        Col.Tag      := 5;
     End;

  if scComment In FShowColumns Then
     Begin
       Col          := Columns.Add;
       Col.Caption  := 'Comment';
       Col.Width    := 100;
       Col.Tag      := 6;
     End;

  if scCRC In FShowColumns Then
     Begin
       Col          := Columns.Add;
       Col.Caption  := 'CRC';
       Col.Width    := 100;
       Col.Tag      := 7;
     End;

  if scEncryption In FShowColumns Then
     Begin
        Col          := Columns.Add;
        Col.Caption  := 'Encrypted';
        Col.Width    := 100;
        Col.Tag      := 8;
     End;

  if scAttributes In FShowColumns Then
     Begin
       Col          := Columns.Add;
       Col.Caption  := 'Attributes';
       Col.Width    := 50;
       Col.Tag      := 9;
     End;
End;

function TKAZipListView.GetDelphiTempFileName: String;
Var
 TmpDir : Array[0..1000] of Char;
 TmpFN  : Array[0..1000] of Char;
Begin
 Result := GetCurrentDir;
 if GetTempPath(1000,TmpDir) <> 0 Then
    Begin
     if GetTempFileName(TmpDir,'',0,TmpFN) <> 0 Then Result := StrPas(TmpFN);
    End;
End;


Function TKAZipListView.GetFileIcon(FileName:String;SmallIcon: Boolean):TIcon;
Var
  SHFI    : TSHFileInfo;
Begin
  Result := TIcon.Create;
  if SmallIcon then
     Begin
      Try
        ShGetFileInfo(PChar(Filename), FILE_ATTRIBUTE_NORMAL, SHFI, SizeOf(TShFileInfo), SHGFI_ICON or SHGFI_SMALLICON or SHGFI_USEFILEATTRIBUTES);
        Result.Handle := SHFI.hIcon;
       Except
        Result.Handle := 0;
       End;
     End
  Else
     Begin
      Try
        ShGetFileInfo(PChar(Filename), FILE_ATTRIBUTE_NORMAL, SHFI, SizeOf(TShFileInfo), SHGFI_ICON or SHGFI_USEFILEATTRIBUTES);
        Result.Handle := SHFI.hIcon;
      Except
       Result.Handle := 0;
      End;
     End;
End;

procedure TKAZipListView.BuildIcons;
Var
  X    : Integer;
  I    : Integer;
  Icon : TIcon;
  Ext  : String;
begin
   if NOT Assigned(LargeImages) Then Exit;
   if NOT Assigned(SmallImages) Then Exit;
   if ViewStyle=vsIcon Then
     Begin
        FImageList        :=  TImageList(LargeImages);
        FImageList.Clear;
        FExtList.Clear;
        FImageList.Width  := 32;
        FImageList.Height := 32;
        FImageList.AddMasked(BMP_Folder_Big,clWhite);
     End
  Else
     Begin
       FImageList        :=  TImageList(SmallImages);
       FImageList.Clear;
       FExtList.Clear;
       FImageList.Width  := 16;
       FImageList.Height := 16;
       FImageList.AddMasked(BMP_Folder_Small,clWhite);
     End;

   For X := 0 To Items.Count-1 do
      Begin
        if Items[X].Data=TObject(-1) Then
           Begin
             Items[X].ImageIndex := 0;
           End
        Else
           Begin
              Ext := ExtractFileExt(Items[X].Caption);
              I   := FExtList.IndexOf(Ext);
              If I = -1 Then
                 Begin
                   Icon                := GetFileIcon(Items[X].Caption, ViewStyle<>vsIcon);
                   Items[X].ImageIndex := FImageList.AddIcon(Icon);
                   Icon.Free;
                 End
              Else
                 Begin
                   Items[X].ImageIndex := I;
                 End;
           End;
      End;
end;

procedure TKAZipListView.ClearIcons;
Var
  X : Integer;
begin
  For X := 0 To Items.Count-1 do
      Begin
        Items[X].ImageIndex := -1;
      End;
end;


Function TKAZipListView.GetID(I:Integer):Integer;
Var
  X : Integer;
Begin
  Result := -1;
  For X := 0 To Columns.Count-1 do
      Begin
        if Column[X].Tag=I Then
           Begin
             Result := X-1;
             Exit;
           End;
      End;
End;

procedure TKAZipListView.FillListView(List:TStringList);
var
  X    : Integer;
  Y    : Integer;
  P    : Integer;
  BR   : Integer;
  ID   : Integer;
  Item : TListItem;
  SL   : TStringList;
  S    : String;
  FF   : String;
  FN   : String;
  Can  : Boolean;
begin
  FDirList.Clear;
  SL  := TStringList.Create;
  LockWindowUpdate(Handle);
  Try
    FF := AnsiLowerCase(FFilterFolder);
    FZipItems.Assign(List);
    For X := 0 To FZipItems.Count-1 do
      Begin
        Can := True;
        if (FFiltered) Then
             Begin
               If AnsiCompareText(FZipItems.Names[X],FFilterFolder)<>0 Then Can := False;
               if (NOT Can) And (FShowFolders) Then
                  Begin
                    If (Pos(FF,AnsiLowerCase(FZipItems.Names[X]))=1) Then
                       Begin