abview.inc

Lazarus is a free and open source development tool for the FreePascal Compiler. The purpose of the p

  if (Value <> FSelected) then begin
    FSelected := Value;
    DoOnChange;
  end;
end;
{ -------------------------------------------------------------------------- }
procedure TAbColors.SetSelectedText(Value : TColor);
begin
  if (Value <> FSelectedText) then begin
    FSelectedText := Value;
    DoOnChange;
  end;
end;
{ -------------------------------------------------------------------------- }
procedure TAbColors.SetAlternate(Value : TColor);
begin
  if (Value <> FAlternate) then begin
    FAlternate := Value;
    DoOnChange;
  end;
end;
{ -------------------------------------------------------------------------- }
procedure TAbColors.SetAlternateText(Value : TColor);
begin
  if (Value <> FAlternateText) then begin
    FAlternateText := Value;
    DoOnChange;
  end;
end;
{ -------------------------------------------------------------------------- }
procedure TAbColors.SetDeleted(Value : TColor);
begin
  if (Value <> FDeleted) then begin
    FDeleted := Value;
    DoOnChange;
  end;
end;
{ -------------------------------------------------------------------------- }
procedure TAbColors.SetDeletedText(Value : TColor);
begin
  if (Value <> FDeletedText) then begin
    FDeletedText := Value;
    DoOnChange;
  end;
end;


{ ===== TAbSelList ========================================================= }
constructor TAbSelList.Create;
begin
  FList := TList.Create;
  FCurrent := -1;
end;
{ -------------------------------------------------------------------------- }
destructor TAbSelList.Destroy;
begin
  FList.Free;
  inherited Destroy;
end;
{ -------------------------------------------------------------------------- }
procedure TAbSelList.Clear;
begin
  FList.Clear;
  FCurrent := -1;
end;
{ -------------------------------------------------------------------------- }
procedure TAbSelList.Select(Index: Longint);
begin
  if FList.IndexOf(Pointer(Index)) < 0 then
    FList.Add(Pointer(Index));
end;
{ -------------------------------------------------------------------------- }
procedure TAbSelList.Deselect(Index: Longint);
var
  i : Longint;
begin
  i := FList.IndexOf(Pointer(Index));
  if (i >= 0) then
    FList.Delete(i);
end;
{ -------------------------------------------------------------------------- }
function TAbSelList.IsSelected(Index : Longint) : Boolean;
begin
  Result := FList.IndexOf(Pointer(Index)) >= 0;
end;
{ -------------------------------------------------------------------------- }
procedure TAbSelList.Toggle(Index: Longint);
begin
  if IsSelected(Index) then
    Deselect(Index)
  else
    Select(Index);
end;
{ -------------------------------------------------------------------------- }
function TAbSelList.SelCount : Longint;
begin
  Result := FList.Count;
end;
{ -------------------------------------------------------------------------- }
procedure TAbSelList.SelectAll(Count : Longint);
var
  i : Longint;
begin
  for i := 0 to Pred(Count) do
    Select(i);
end;
{ -------------------------------------------------------------------------- }
function TAbSelList.FindFirst : Longint;
begin
  FCurrent := -1;
  if (FList.Count > 0) then
    Result := FindNext
  else
    Result := -1;
end;
{ -------------------------------------------------------------------------- }
function TAbSelList.FindNext : Longint;
begin
  if (FList.Count > 0) and (FCurrent < Pred(FList.Count)) then begin
    Inc(FCurrent);
    Result := Longint(FList[FCurrent]);
  end else
    Result := -1;
end;


{ ===== TAbRowMap ========================================================== }
procedure TAbRowMap.Clear;
begin
  FRows.Clear;
  FInvRows.Clear;
end;
{ -------------------------------------------------------------------------- }
function TAbRowMap.GetRow(RowNum : Longint) : Longint;
begin
  if (RowNum >= 0) and (RowNum < FRows.Count) then
    Result := Longint(FRows[RowNum])
  else
    Result := 0;
end;
{ -------------------------------------------------------------------------- }
function TAbRowMap.GetInvRow(RowNum : Longint) : Longint;
begin
  if (RowNum >= 0) and (RowNum < FInvRows.Count) then
    Result := Longint(FInvRows[RowNum])
  else
    Result := 0;
end;
{ -------------------------------------------------------------------------- }
constructor TAbRowMap.Create;
begin
  inherited Create;
  FRows := TList.Create;
  FInvRows := TList.Create;
end;
{ -------------------------------------------------------------------------- }
procedure TAbRowMap.Init(RowCount : Longint);
var
  i : Longint;
begin
  Clear;
  if (RowCount > 0) then
    for i := 0 to Pred(RowCount) do begin
      FRows.Add(Pointer(i));
      FInvRows.Add(Pointer(i));
    end;
end;
{ -------------------------------------------------------------------------- }
destructor TAbRowMap.Destroy;
begin
  FRows.Free;
  FInvRows.Free;
  inherited Destroy;
end;
{ -------------------------------------------------------------------------- }
procedure TAbRowMap.SortBy(Attr : TAbSortAttribute; ItemList : TAbArchiveList);
type
  PSortRec = ^TSortRec;
  TSortRec = record
    Val : Double;
    Index : Longint;
  end;
var
  i, LI : Longint;
  SL : TList;
  RowCount : Longint;
  P : PSortRec;
  DT : TDateTime;
  aItem : TAbArchiveItem;

  procedure QuickSort(SL : TList; L, R: Integer);
  var
    i, j: Integer;
    P: PSortRec;
  begin
    i := L;
    j := R;
    P := SL[(L + R) shr 1];
    repeat
      while PSortRec(SL[i])^.Val < P^.Val do Inc(i);
      while PSortRec(SL[j])^.Val > P^.Val do Dec(j);
      if (i <= j) then
      begin
        SL.Exchange(i, j);
        Inc(i);
        Dec(j);
      end;
    until i > j;
    if L < j then QuickSort(SL, L, j);
    if i < R then QuickSort(SL, i, R);
  end;

begin
  if (ItemList.Count <= 0) then
    Exit;
  if (Attr = saItemName) then
    SortOnItemName(ItemList)
  else begin
    RowCount := ItemList.Count;
    SL := TList.Create;
    try {SL}
      SL.Capacity := RowCount;
      for i := 0 to Pred(RowCount) do begin
        GetMem(P, SizeOf(TSortRec));
        aItem := TAbArchiveItem(ItemList.Items[i]);
        case Attr of
          saPacked   : P^.Val := aItem.CompressedSize;
          saRatio :
            begin
              if (aItem is TAbZipItem) then
                P^.Val := TAbZipItem(aItem).CompressionRatio
              else
                P^.Val := 0;
            end;
          saFileSize : P^.Val := aItem.UnCompressedSize;
          saTimeStamp : begin
            LI := LongInt(aItem.LastModFileDate) shl 16 +
              aItem.LastModFileTime;
            DT := FileDateToDateTime(LI);
            P^.Val := Double(DT);
          end;
        end;
        P^.Index := i;
        SL.Add(P);
      end;
      QuickSort(SL, 0, Pred(SL.Count));
      for i := 0 to Pred(SL.Count) do begin
        if FSortAscending then
          P := SL[i]
        else
          P := SL[Pred(SL.Count) - i];
        FRows[i] := Pointer(P^.Index)
      end;
    finally {SL}
      while (SL.Count > 0) do begin
        FreeMem(SL[0], Sizeof(TSortRec));
        SL.Delete(0);
      end;
      SL.Free;
    end; {SL}
  end;

  FSortAscending := not FSortAscending;
  for i := 0 to Pred(ItemList.Count) do
    FInvRows[Rows[i]] := Pointer(i);
end;
{ -------------------------------------------------------------------------- }
procedure TAbRowMap.SortOnItemName(ItemList : TAbArchiveList);
var
  i, RowCount : Longint;
  SL : TStringList;
  FN : string;
begin
  RowCount := ItemList.Count;
  SL := TStringList.Create;
  try {SL}
    for i := 0 to Pred(RowCount) do begin
      FN := TAbArchiveItem(ItemList.Items[i]).Filename;
      AbUnFixName(FN);
      SL.AddObject(ExtractFilename(FN), Pointer(i));
    end;
    SL.Sort;
    for i := 0 to Pred(RowCount) do begin
      if FSortAscending then
        FRows[i] := SL.Objects[i]
      else
        FRows[i] := SL.Objects[Pred(RowCount) - i];
    end;
  finally {SL}
    SL.Free;
  end; {SL}
end;


{===== TAbBaseViewer ===============================================}
constructor TAbBaseViewer.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);

  FItemList := TAbArchiveList.Create;                        

  RowCount := 2;
  FixedCols := 0;
  FixedRows := 1;   {Header Row}
  FSortCol := -1;
  Color := clWindow;
  FColors := TAbColors.Create;
  FColors.OnChange := ColorsChange;
  FColors.Selected := AbDefSelColor;
  FColors.SelectedText := AbDefSelTextColor;
  FColors.Alternate := AbDefHighColor;
  FColors.AlternateText := AbDefHighTextColor;
  FColors.Deleted := AbDefDelColor;
  FColors.DeletedText := AbDefDelTextColor;
  DefaultColWidth := AbDefColWidth;
  DefaultRowHeight := AbDefRowHeight;
  DefaultDrawing := False;
  ParentColor := False;
{$IFNDEF UsingCLX}
  ParentCtl3D := True;
{$ENDIF}
  ParentFont := True;
  ParentShowHint := True;
  FHeadings := TAbColHeadings.Create;
  InitColMap;
  FColSizing := False;
  FAllowInvalidate := True;
  FRowMap := TAbRowMap.Create;
  FIcons := TStringList.Create;
  FSelList := TAbSelList.Create;
  Attributes :=  [vaItemname, vaPacked, vaTimeStamp, vaFileSize, vaPath];
  SetDisplayOptions([doColSizing]);
  Visible := True;
end;
{ -------------------------------------------------------------------------- }
destructor TAbBaseViewer.Destroy;
begin
  FRowMap.Free;
  FHeadings.Free;
  FColors.Free;
  FIcons.Free;
  FSelList.Free;
  FItemList.Free;                                                        
  inherited Destroy;
end;
{ -------------------------------------------------------------------------- }
function TAbBaseViewer.AttrToSortAttribute(Attr : TAbViewAttribute;
  var SortAttr : TAbSortAttribute) : Boolean;
begin
  Result := True;
  case Attr of
    vaItemName  : SortAttr := saItemName;
    vaPacked    : SortAttr := saPacked;
    vaFileSize  : SortAttr := saFileSize;
    vaRatio     : SortAttr := saRatio;
    vaTimeStamp : SortAttr := saTimeStamp;
  else
    Result := False;
  end;
end;
{ -------------------------------------------------------------------------- }
function TAbBaseViewer.AttrToStr(Attr : TAbViewAttribute;
  aItem : TAbArchiveItem) : string;
var
  FN : string;
  LI : Longint;
begin
  Result := '';
  if Attr in [vaItemName, vaPath] then begin
    FN := aItem.Filename;
    AbUnFixName(FN);
  end;

  {first take care of common attributes}
  with aItem do case Attr of
    vaCRC :
      Result := IntToHex(CRC32, 8);
    vaItemname :
      Result := ExtractFilename(FN);
    vaPacked :
      Result := IntToStr(CompressedSize);
    vaFileSize :
      Result := IntToStr(UncompressedSize);
    vaFileAttributes :
      begin
{$IFNDEF LINUX}
{$IFDEF Version6} {$WARN SYMBOL_PLATFORM OFF} {$ENDIF}
        if (faReadOnly and ExternalFileAttributes) = faReadOnly then
          Result := Result + AbStrRes(AbReadOnly);
        if (faHidden and ExternalFileAttributes) = faHidden then
          Result := Result + AbStrRes(AbHidden);
        if (faSysFile and ExternalFileAttributes) = faSysFile then
          Result := Result + AbStrRes(AbSystem);
        if (faArchive and ExternalFileAttributes) = faArchive then
          Result := Result + AbStrRes(AbArchived);
{$IFDEF Version6} {$WARN SYMBOL_PLATFORM OFF} {$ENDIF}
{$ENDIF LINUX}
      end;
    vaEncryption :
      if IsEncrypted then
        Result := AbStrRes(AbEncrypted);
    vaTimeStamp :