kaziplistview.pas

Complete Zip Program

                         S   := FZipItems.Strings[X];
                         P := Pos('=',S);
                         S := Copy(S,1,P-1);
                         System.Delete(S,1,Length(FF));
                         S := ExcludeTrailingBackslash(S);
                         P := Pos('\',S);
                         if P > 0 Then S := Copy(S,1,P-1);
                         FDirList.Add(S);
                       End
                    Else
                    If (FF='') Then
                       Begin
                         S   := FZipItems.Strings[X];
                         P := Pos('=',S);
                         S := Copy(S,1,P-1);
                         P := Pos('\',S);
                         if P > 0 Then S := Copy(S,1,P-1);
                         FDirList.Add(S);
                       End;
                  End;
             End;
        if (Can) And (FFilterWildCard <> '') And (FFilterWildCard <> '*.*') Then
           Begin
             S   := FZipItems.Strings[X];
             P   := Pos('=',S);
             System.Delete(S,1,P);
             S   := Copy(S,1,Pos(#9,S)-1);
             Can := MatchesMask(S,FFilterWildCard);
           End;
        if Can Then
           Begin
             S   := FZipItems.Strings[X];
             P   := Pos('=',S);
             System.Delete(S,1,P);
             SL.AddObject(S,TObject(X));
           End;
      End;
    Items.Clear;
    For X := 0 To SL.Count-1 do
        Begin
           S  := SL.Strings[X];
           P  := Pos(#9,S);
           if P > 0 Then
              Begin
                FN           := Copy(S,1,P-1);
                IF FN<>'' Then
                   Begin
                    Item         := Items.Add;
                    Item.Caption := Copy(S,1,P-1);
                    Item.Data    := SL.Objects[X];
                    System.Delete(S,1,P);
                    For Y := 0 To Columns.Count-1 do Item.SubItems.Add('');
                    P  := Pos(#9,S);
                    BR := 1;
                    While P > 0 Do
                      Begin
                        ID := GetID(BR);
                        Case BR Of
                             1 : if scPath In FShowColumns Then
                                    Begin
                                      Item.SubItems.Strings[ID] := Copy(S,1,P-1);
                                    End;
                             2 :  if scDate In FShowColumns Then
                                    Begin
                                      Item.SubItems.Strings[ID] := Copy(S,1,P-1);
                                      Item.SubItems.Objects[ID] := FZipItems.Objects[X];
                                    End;
                             3 :  if scUnCompressedSize In FShowColumns Then
                                    Begin
                                      Item.SubItems.Strings[ID] := Copy(S,1,P-1);
                                    End;
                             4 :  if scCompressedSize In FShowColumns Then
                                    Begin
                                      Item.SubItems.Strings[ID] := Copy(S,1,P-1);
                                    End;
                             5 :  if scRatio In FShowColumns Then
                                    Begin
                                      Item.SubItems.Strings[ID] := Copy(S,1,P-1);
                                    End;
                             6 :  if scComment In FShowColumns Then
                                    Begin
                                      Item.SubItems.Strings[ID] := Copy(S,1,P-1);
                                    End;
                             7 :  if scCRC In FShowColumns Then
                                    Begin
                                      Item.SubItems.Strings[ID] := Copy(S,1,P-1);
                                    End;
                             8 :  if scEncryption In FShowColumns Then
                                    Begin
                                      Item.SubItems.Strings[ID] := Copy(S,1,P-1);
                                    End;
                        End;
                        System.Delete(S,1,P);
                        Inc(BR);
                        P := Pos(#9,S);
                      End;
                    if scAttributes In FShowColumns Then
                       Begin
                         ID := GetID(BR);
                         Item.SubItems.Strings[ID] := S;
                       End;
                  End;
              End;
        End;
    If FShowFolders Then
       Begin
          if (FF <> '') Then FDirList.Add('..');
          FDirList.Sort;
          For X := FDirList.Count-1 downto 0 do
             Begin
               Item         := Items.Insert(0);
               Item.Caption := FDirList.Strings[X];
               Item.Data    := TObject(-1);
             End;
       End;
    FLastSortType    := Ascending;
    FSortColumn      := 0;
    FLastColumn      := 0;
    DoSort;
    FSortColumn      := -1;
    FLastColumn      := -1;
    if FShowIcons Then BuildIcons;
    if (FAutoSizeColumns) And (Items.Count > 0) Then ResizeListView;
  Finally
    LockWindowUpdate(0);
    SL.Free;
  End;
end;

procedure TKAZipListView.SetFilterFolder(const Value: String);
Var
  SL : TStringList;
begin
  FFilterFolder := Value;
  if (FFiltered) Then
     Begin
       SL := TStringList.Create;
       Try
         SL.Assign(FZipItems);
         FillListView(SL);
       Finally
         SL.Free;
       End;
     End;
end;

procedure TKAZipListView.SetFilterWildcard(const Value: String);
Var
  SL : TStringList;
begin
  FFilterWildcard := Value;
  SL := TStringList.Create;
  Try
    SL.Assign(FZipItems);
    FillListView(SL);
  Finally
    SL.Free;
  End;
end;


procedure TKAZipListView.SetFiltered(const Value: Boolean);
Var
  SL : TStringList;
begin
  FFiltered := Value;
  SL := TStringList.Create;
  Try
    SL.Assign(FZipItems);
    FillListView(SL);
  Finally
    SL.Free;
  End;
end;

procedure TKAZipListView.SetShowFolders(const Value: Boolean);
Var
  SL : TStringList;
begin
  FShowFolders := Value;
  if (FFiltered) Then
     Begin
       SL := TStringList.Create;
       Try
         SL.Assign(FZipItems);
         FillListView(SL);
       Finally
         SL.Free;
       End;
     End;
end;


procedure TKAZipListView.ResizeListView;
Var
  X            : Integer;
  Y            : Integer;
  W            : Integer;
  MaxWidth     : TList;
  TempCanvas   : TControlCanvas;
  Column       : TListColumn;
  GlyphAdd     : Integer;
begin
 MaxWidth                           := TList.Create;
 TempCanvas                         := TControlCanvas.Create;
 TControlCanvas(TempCanvas).Control := Self;
 GlyphAdd                           := 4;
 Try
   For X := 0 To Columns.Count-1 do
       Begin
         MaxWidth.Add(TObject(Columns.Items[X].Width));
       End;
   For X := 0 To Columns.Count-1 do
       Begin
         Column  := Columns.Items[X];
         W := TempCanvas.TextWidth('W'+Column.Caption+'W');
         if FShowSortGlyph Then W := W+BMP_Up.Width+GlyphAdd;
         if W > Integer(MaxWidth.Items[X]) Then MaxWidth.Items[X] := TObject(W);
       End;
   For Y := 0 To Items.Count-1 do
       Begin
         For X := 0 To Columns.Count-1 do
             Begin
               if X = 0 Then
                  Begin
                    W := TempCanvas.TextWidth('W'+Items[Y].Caption+'W')
                  End
               Else
                  Begin
                    if X-1 < Items[Y].Subitems.Count Then
                       W := TempCanvas.TextWidth('W'+Items[Y].Subitems[X-1]+'W')
                    Else
                       W := 0;
                  End;
               if FShowSortGlyph Then W := W+BMP_Up.Width+GlyphAdd;
               if W > Integer(MaxWidth.Items[X]) Then MaxWidth.Items[X] := TObject(W);
             End;
       End;
   if (Checkboxes) Then MaxWidth.Items[0] := TObject(Integer(MaxWidth.Items[0])+30);
   For X := 0 To Columns.Count-1 do
       Begin
         If FAutoSizeColumns Then Columns[X].Width := Integer(MaxWidth.Items[X]);
       End;
  Finally
    MaxWidth.Free;
    TempCanvas.Free;
  End;
end;


Procedure TKAZipListView.DoCompare(Sender: TObject; Item1, Item2: TListItem; Data : Integer; var Compare: Integer);
Var
  S1  : String;
  S2  : String;
  D1  : Double;
  D2  : Double;
  C1  : Cardinal;
  C2  : Cardinal;
  Err : Integer;
Begin
  S1 := '';
  S2 := '';
  if  (Item1.Data=TObject(-1))
  And (Item2.Data<>TObject(-1)) Then
      Begin
        Compare := 0;
        Exit;
      End
  Else
  if  (Item1.Data<>TObject(-1))
  And (Item2.Data=TObject(-1)) Then
      Begin
        Compare := 0;
      End
  Else
  if  (Item1.Data=TObject(-1))
  And (Item2.Data=TObject(-1)) Then
      Begin
        if FSortColumn=0 Then
           Begin
             S1      := Item1.Caption;
             S2      := Item2.Caption;
             if S1='..' Then S2:='..';
             if S2='..' Then S1:='..';
             Compare := WideCompareStr(S1, S2);
             if FLastSortType=Descending Then Compare := Compare*-1;
           End
        Else
           Begin
             Compare := 0;
           End;
        Exit;
      End;

  if FSortColumn=0 Then
     Begin
       S1      := Item1.Caption;
       S2      := Item2.Caption;
       Compare := WideCompareStr(S1, S2);
     End
  Else
     Begin
       S1 := Item1.SubItems.Strings[FSortColumn-1];
       S2 := Item2.SubItems.Strings[FSortColumn-1];
       if Columns[FSortColumn].Tag In [3,4,5] Then
          Begin
             Val(S1,D1,Err);
             Val(S2,D2,Err);
             if D1 > D2 Then Compare :=  1;
             if D2 > D1 Then Compare := -1;
             if D2 = D1 Then Compare :=  0;
          End
       Else
       if Columns[FSortColumn].Tag = 7 Then
          Begin
             C1 := StrToInt('$'+S1);
             C2 := StrToInt('$'+S2);
             if C1 > C2 Then Compare :=  1;
             if C2 > C1 Then Compare := -1;
             if C2 = C1 Then Compare :=  0;
          End
       Else
          Begin
            Compare := WideCompareStr(S1, S2);
          End;
     End;
  if FLastSortType=Descending Then Compare := Compare*-1;
End;



Procedure TKAZipListView.DoSort;
Var
 OCT  : TLVCompareEvent;
Begin
    Begin
      OCT       := OnCompare;
      OnCompare := DoCompare;
      AlphaSort;
      OnCompare := OCT;
    End;
End;

procedure TKAZipListView.ColClick(Column: TListColumn);
Var
  OS : Integer;
  C  : String;
begin
  inherited ColClick(Column);
  OS             := FSortColumn;
  FSortColumn    := Column.Index;
  if FLastColumn = Column.Index Then
     Begin
        if FLastSortType=Ascending Then FLastSortType  := Descending
        Else
        if FLastSortType=Descending Then FLastSortType := Ascending
     End
  Else
     Begin
       FLastSortType   := Ascending;
     End;
  FLastColumn := Column.Index;
  DoSort;
  if (OS <> FSortColumn) And (OS > -1) Then
     Begin
       C := Columns.Items[OS].Caption;
       Columns.Items[OS].Caption := C+' ';
       Columns.Items[OS].Caption := C;
     End;
end;



procedure TKAZipListView.SetShowIcons(const Value: Boolean);
begin
  if FShowIcons <> Value Then
     Begin
       FShowIcons := Value;
       if FShowIcons Then
          Begin
            BuildIcons;
          End
       Else
          Begin
            ClearIcons;
          End;
     End;
end;


procedure TKAZipListView.SetAutoSizeColumns(const Value: Boolean);
begin
  FAutoSizeColumns := Value;
  if csLoading in ComponentState Then Exit;
end;



procedure TKAZipListView.SetShowSortGlyph(const Value: Boolean);
begin
  FShowSortGlyph := Value;
end;


procedure TKAZipListView.SetMultiSelect(Value: Boolean);
Var
 WL : LongInt;
Begin
  FMultiselect := Value;
  if (HandleAllocated) Then
     Begin
       WL           := GetWindowLong(Handle,GWL_STYLE);
       if FMultiselect Then
          WL           := WL - LVS_SINGLESEL
       Else
          WL           := WL + LVS_SINGLESEL;
       SetWindowLong(Handle,GWL_STYLE,WL);
     End;
End;


function TKAZipListView.GetViewStyle: TViewStyle;
begin
  Result := Inherited ViewStyle;
end;

procedure TKAZipListView.SetViewStyle(Value: TViewStyle);
Var
  OVS : TViewStyle;
begin
  OVS := Inherited ViewStyle;
  Inherited SetViewStyle(Value);
  if OVS <> Value Then
     Begin
       if FShowIcons Then BuildIcons;
     End;
end;

procedure TKAZipListView.SetShowColumns(const Value: TShowColumns);
Var
  SL  : TStringList;
  OSC : TShowColumns;
begin
  OSC          := FShowColumns;
  FShowColumns := Value;
  if OSC <> FShowColumns Then
     Begin
       if Not (csLoading in ComponentState) Then
          Begin
            SL           := TStringList.Create;
            Try
              SL.Assign(FZipItems);
              FillListView(SL);
            Finally
              SL.Free;
            End;
          End;
     End;
end;


end.