abview.inc

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

      if (LastModFileDate + LastModFileTime = 0) then
        Result := AbStrRes(AbUnknown)
      else begin
        LI := LongInt(LastModFileDate) shl 16 + LastModFileTime;
        Result := DateTimeToStr(FileDateToDateTime(LI));
      end;
    vaPath :
      Result := DiskPath;
  end;

  {now handle the zip specific attributes}
  if (aItem is TAbZipItem) then with TAbZipItem(aItem) do case Attr of
    vaFileType :
      if (InternalFileAttributes = 1) then
        Result := AbStrRes(AbText)
      else
        Result := AbStrRes(AbBinary);
    vaMethod :
      Result := FMethodStrings[CompressionMethod];
    vaRatio :
      Result := IntToStr(Round(CompressionRatio));
    vaVersionMade :
      Result := IntToStr(Round(Lo(VersionMadeBy)/ 10.0));
    vaVersionNeeded :
      Result := IntToStr(Round(Lo(VersionNeededToExtract)/ 10.0));
  end;
{$IFDEF LINUX}
  Result := ' ' + Result;
{$ENDIF}
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseViewer.BeginUpdate;
begin
  FAllowInvalidate := False;
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseViewer.EndUpdate;
begin
  FAllowInvalidate := True;
  Refresh;
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseViewer.ClearSelections;
var
  i : Longint;
begin
  if (FSelList.SelCount > 0) then begin
    i := FSelList.FindFirst;
    repeat
      InvalidateRow(FRowMap.InvRows[i]+1);
      i := FSelList.FindNext;
    until (i < 0);
    FSelList.Clear;
  end;
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseViewer.Click;
  {Here is the logic for MultiSelect}
var
  i : Longint;
begin
  inherited Click;
  if Assigned(FItemList) and (FItemList.Count > 0) then begin
    if (ssCtrl in FShiftState) and (doMultiSelect in FDisplayOptions) then
      Selected[ActiveRow] := not Selected[ActiveRow]
    else begin
      if not ((ssShift in FShiftState) and
             (doMultiSelect in FDisplayOptions)) then begin
        ClearSelections;
        Selected[ActiveRow] := True;
      end else begin
        ClearSelections;
        if (RowAnchor < ActiveRow) then
          for i := RowAnchor to ActiveRow do
            Selected[i] := True
        else
          for i := ActiveRow to RowAnchor do
            Selected[i] := True;
      end;
    end;
    Update;
    if Assigned(FOnClick) then
      FOnClick(Self);
  end;
end;
{ -------------------------------------------------------------------------- }
{$IFDEF UsingCLX}
procedure TAbBaseViewer.FontChanged;
{$ELSE}
procedure TAbBaseViewer.CMFontChanged(var Message: TMessage);
{$ENDIF}
begin
  inherited;
  if not (csLoading in ComponentState) then begin
    Canvas.Font := Font;
    DefaultRowHeight := Canvas.TextHeight('W') + 2;
    HeaderRowHeight := Canvas.TextHeight('W') + 4;
  end;
end;
{ -------------------------------------------------------------------------- }
function TAbBaseViewer.ColMap(ColNum : Integer) : Integer;
begin
  Result := FColMap[TAbViewAttribute(ColNum)];
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseViewer.ColorsChange(Sender : TObject);
begin
  Invalidate;
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseViewer.ColumnMoved(FromIndex, ToIndex : Longint);
begin
  MoveColumn(FromIndex, ToIndex);
  Invalidate;
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseViewer.DblClick;
  {Dont pass along the event if double click in header}
begin
  inherited DblClick;
  if (ViewMouseCoord.Y <> abHeaderRow) then
    if Assigned(FItemList) and (FItemList.Count > 0) then
      if Assigned(FOnDblClick) then
        FOnDblClick(Self);
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseViewer.DoChange;
begin
  RowCount := 2;   {HeaderRow + 1}
  FSelList.Clear;
  if Assigned(FItemList) then begin
    FRowMap.Init(FItemList.Count);
    if (FItemList.Count > 0) then
      RowCount := FItemList.Count + 1
    else begin
{      RefreshRow(1);}
      FSortCol := -1;
    end;
  end;
  if FAllowInvalidate then
    Refresh;
  if Assigned(FOnChange) then
    FOnChange(Self);
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseViewer.DoLoad;
begin
  FIcons.Clear;
  FSelList.Clear;
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseViewer.DoSorted(Attr : TAbViewAttribute);
begin
  DrawSortArrow;
  if Assigned(FOnSorted) then
    FOnSorted(Self, Attr);
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseViewer.DrawCell(ACol, ARow: Longint; ARect: TRect;
  AState: TGridDrawState);
const
  cStrSize = 255;
var
  s : array[0..cStrSize] of Char;                                   
  aItem : TAbArchiveItem;
  TxtRect : TRect;
  Attr : TAbViewAttribute;
  DTFormat : Word;
{$IFNDEF UsingClx}
  H : Integer;
  Icon : HIcon;
{$ENDIF}
begin
{$IFDEF LINUX}
  if not DefaultDrawing then
    DefaultDrawing := true;
{$ENDIF}

  fillchar( s, succ( cStrSize ), $00 );
  Canvas.Font := Font;
  if (ARow = AbHeaderRow) then begin
    StrPCopy(s, FHeadings[ColMap(ACol)]);
    DrawHeaderButton(ACol, s)
  end else if not FAllowInvalidate then  {waiting for EndUpdate}
    Exit
  else with Canvas do begin
    if not (doColLines in DisplayOptions) then
      ARect.Right := ARect.Right + 1;
    Brush.Color := clWindow;
    if (not Assigned(FItemList)) or (FItemList.Count = 0) then begin
      Canvas.FillRect(ARect);
      Exit;
    end;

    aItem := FItemList.Items[FRowMap[ARow-1]];
    Attr := TAbViewAttribute(ColMap(ACol));

    StrPCopy(s, AttrToStr(Attr, aItem));
    if FSelList.IsSelected(FRowMap[ARow-1]) then begin
      Brush.Color := FColors.Selected;
      Font.Color  := FColors.SelectedText;
    end else if aItem.Action = aaDelete then begin
      Brush.Color := FColors.Deleted;
      Font.Color  := FColors.DeletedText;
    end else if ((doAlternateColors in FDisplayOptions) and
    not Odd(ARow)) then begin
      Brush.Color := FColors.Alternate;
      Font.Color  := FColors.AlternateText;
    end;
    TxtRect := ARect;
{$IFNDEF UsingCLX}
    Icon := 0;
    if (Attr = vaItemName) then
      Icon := GetIcon(aItem.Filename);
    if (Icon <> 0) then begin
      H := ARect.Bottom - ARect.Top;
      Canvas.FillRect(ARect);
      Canvas.Brush.Style := bsClear;
      DrawIconEx(Canvas.Handle, ARect.Left+1, ARect.Top+1, Icon,
        H - 2, H - 2, 0, 0, DI_NORMAL);
      TxtRect.Left := TxtRect.Left + H;
    end else begin
      Canvas.FillRect(ARect);
      Canvas.Brush.Style := bsClear;
    end;
{$ELSE}
    Canvas.FillRect( CellRect( ACol, ARow ));
{$ENDIF}

    DTFormat := DrawTextFormat(Attr, TxtRect);
{$IFNDEF UsingCLX}
    DrawText(Canvas.Handle, s, -1, TxtRect, DTFormat);
{$ELSE}
    Canvas.TextRect(TxtRect, TxtRect.Left, TxtRect.Top, s, DTFormat);
{$ENDIF}
  end;
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseViewer.DrawHeaderButton(ACol : Integer; Text : PChar);
var
  ARect : TRect;
  DTFormat : Word;
begin
  ARect := CellRect(ACol, 0);
  with Canvas do begin
    Brush.Style := bsSolid;
    Brush.Color := clBtnface;
    FillRect(ARect);
    if FButtonDown then
      Pen.Color := clHighlight
    else
      Pen.Color := clBtnShadow;
      MoveTo(ARect.Left, ARect.Bottom - 1);
      LineTo(ARect.Right - 1, ARect.Bottom - 1);
      LineTo(ARect.Right - 1, ARect.Top -1);
    if FButtonDown then
      Pen.Color := clBtnShadow
    else
      Pen.Color := clBtnHighlight;
    MoveTo(ARect.Left, ARect.Bottom - 2);
    LineTo(ARect.Left, ARect.Top);
    LineTo(ARect.Right - 1, ARect.Top);
    Brush.Style := bsClear;
  end;
  ARect.Right := ARect.Left + ColWidths[ACol];
  if FSortCol = ACol then
    ARect.Right := ARect.Right - 5 - (2 * (ARect.Bottom - ARect.Top) div 10);
{$IFDEF UsingCLX}
  { prefix is off by default in Qt}
  DTFormat := Integer(AlignmentFlags_AlignVCenter) or
              Integer(AlignmentFlags_SingleLine) or
              Integer(AlignmentFlags_AlignHCenter);
{$ELSE}
  DTFormat := DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX or DT_CENTER;
{$ENDIF}
  if FButtonDown then
    ARect := Rect(ARect.Left+1, ARect.Top+1, ARect.Right, ARect.Bottom);
{$IFDEF UsingCLX}
  Canvas.TextRect(ARect, ARect.Left, ARect.Top, Text, DTFormat);
{$ELSE}
  DrawText(Canvas.Handle, Text, -1, ARect, DTFormat);
{$ENDIF}
  if FSortCol = ACol then
    DrawSortArrow;
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseViewer.DrawSortArrow;
var
  ARect : TRect;
  SavedColor : TColor;
begin
  if (FSortCol > -1) then begin
    { set up Rect for the OnDrawSortArrow event }
    ARect := CellRect(FSortCol, 0);
    ARect.Top := (ARect.Bottom - ARect.Top) div 10;
    ARect.Bottom := ARect.Bottom - ARect.Top;
    ARect.Right := ARect.Left + ColWidths[FSortCol] - 5;
    ARect.Left := ARect.Right - ((ARect.Bottom - ARect.Top));

    if Assigned(FOnDrawSortArrow) then begin
      FOnDrawSortArrow(Self, FSortCol, FRowMap.SortAscending, Canvas, ARect);
      Exit;
    end;
    { make ARect smaller for our own drawing }
    inc(ARect.Left, 10);
    inc(ARect.Top, 5);
    dec(ARect.Bottom, 5);

    with Canvas do begin
      Pen.Color := clBtnShadow;

      SavedColor := Brush.Color;
      Brush.Color := clBtnFace;
      with ARect do
        if FRowMap.SortAscending then begin
           Polygon([Point(((Right-Left)div 2)+Left, Bottom), Point(Right, Top),
             Point(Left, Top)]);
{$IFNDEF UsingCLX}
          if Ctl3D then begin
            Pen.Color := clBtnHighlight;
            MoveTo(((Right-Left)div 2)+Left, Bottom);
            LineTo(Right, Top);
          end;
{$ENDIF}
        end else begin
          Polygon([Point(((Right-Left)div 2)+Left, Top), Point(Right, Bottom),
            Point(Left, Bottom)]);
{$IFNDEF UsingCLX}
          if Ctl3D then begin
            Pen.Color := clBtnHighlight;
            MoveTo(((Right-Left)div 2)+Left, Top);
            LineTo(Right, Bottom);
            LineTo(Left, Bottom);
            Pen.Color := clBtnShadow;
            LineTo(((Right-Left)div 2)+Left, Top);
          end;
{$ENDIF}
        end;
      Brush.Color := SavedColor;
    end;
  end;
end;
{ -------------------------------------------------------------------------- }
function TAbBaseViewer.DrawTextFormat(Attr : TAbViewAttribute;
  var Rect : TRect) : Word;
begin
{$IFDEF MSWINDOWS}
  Result := DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX;
  case Attr of
    vaItemname       : Result := Result or DT_LEFT;
    vaPacked         : Result := Result or DT_RIGHT;
    vaFileSize       : Result := Result or DT_RIGHT;
    vaMethod         : Result := Result or DT_CENTER;
    vaRatio          : Result := Result or DT_CENTER;
    vaCRC            : Result := Result or DT_CENTER;
    vaFileAttributes : Result := Result or DT_CENTER;
    vaFileType       : Result := Result or DT_CENTER;
    vaEncryption     : Result := Result or DT_CENTER;
    vaTimeStamp      : Result := Result or DT_LEFT;
    vaVersionMade    : Result := Result or DT_CENTER;
    vaVersionNeeded  : Result := Result or DT_CENTER;
    vaPath           : Result := Result or DT_LEFT;
  end;
  if (Result and 3) = DT_LEFT then
    OffsetRect(Rect, 5, 0)
  else if (Result and 3) = DT_RIGHT then
    OffsetRect(Rect, -5, 0);
{$ENDIF}
{$IFDEF LINUX}
  Result := Integer(AlignmentFlags_AlignVCenter) or
            Integer(AlignmentFlags_SingleLine);
  case Attr of
    vaItemname       : Result := Result or Integer(AlignmentFlags_AlignLeft);
    vaPacked         : Result := Result or Integer(AlignmentFlags_AlignRight);
    vaFileSize       : Result := Result or Integer(AlignmentFlags_AlignRight);
    vaMethod         : Result := Result or Integer(AlignmentFlags_AlignCenter);
    vaRatio          : Result := Result or Integer(AlignmentFlags_AlignCenter);
    vaCRC            : Result := Result or Integer(AlignmentFlags_AlignCenter);
    vaFileAttributes : Result := Result or Integer(AlignmentFlags_AlignCenter);
    vaFileType       : Result := Result or Integer(AlignmentFlags_AlignCenter);
    vaEncryption     : Result := Result or Integer(AlignmentFlags_AlignCenter);
    vaTimeStamp      : Result := Result or Integer(AlignmentFlags_AlignLeft);
    vaVersionMade    : Result := Result or Integer(AlignmentFlags_AlignCenter);
    vaVersionNeeded  : Result := Result or Integer(AlignmentFlags_AlignCenter);
    vaPath           : Result := Result or Integer(AlignmentFlags_AlignLeft);
  end;
{$ENDIF}
end;

{ -------------------------------------------------------------------------- }
function TAbBaseViewer.GetActiveRow : Longint;
begin
  Result := Row - 1;
end;
{ -------------------------------------------------------------------------- }
function TAbBaseViewer.GetCount : Longint;
begin
  if Assigned(FItemList) then
    Result := FItemList.Count
  else
    Result := 0;
end;