abview.inc

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

{ -------------------------------------------------------------------------- }
function TAbBaseViewer.GetHeaderRowHeight : Integer;
begin
  Result := RowHeights[AbHeaderRow];
end;
{ -------------------------------------------------------------------------- }
{$IFDEF MSWINDOWS}
function TAbBaseViewer.GetIcon(ItemName : string) : HIcon;
var
  i : Longint;
  n : Word;
  s : array[0..255] of Char;
  t : string;
begin
  Result := 0;
  if not (doShowIcons in FDisplayOptions) then
    Exit;
  t := '*' + ExtractFileExt(ItemName);
  StrPCopy(s, t);
  i := FIcons.IndexOf(t);
  if (i > -1) then
    Result := HIcon(FIcons.Objects[i])
  else begin
    n := 1;
    Result := ExtractAssociatedIcon(HInstance, s, n);
    FIcons.AddObject(t, Pointer(Result));
  end;
end;
{$ENDIF}
{$IFDEF UsingCLX }
  { no file type icons in CLX }
{$ENDIF}
{ -------------------------------------------------------------------------- }
function TAbBaseViewer.GetSelCount : Longint;
begin
  Result := FSelList.SelCount;
end;
{ -------------------------------------------------------------------------- }
function TAbBaseViewer.GetSelected(RowNum : Longint) : Boolean;
begin
  if Assigned(FItemList) then
    Result := FSelList.IsSelected(FRowMap[RowNum])
  else
    Result := False;
end;
{ -------------------------------------------------------------------------- }
function TAbBaseViewer.GetVersion : string;
begin
  Result := AbVersion;
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseViewer.InitColMap;
var
  i : TAbViewAttribute;
begin
  FHeadings.Clear;
  for i := Low(TAbViewAttribute) to High(TAbViewAttribute) do begin
    FHeadings.Add(AbStrRes(AbDefColHeadings + Ord(i)));
    FColMap[i] := Ord(i);
  end;
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseViewer.InitMethodStrings;
var
  i : TAbZipCompressionMethod;
begin
  for i := Low(TAbZipCompressionMethod) to High(TAbZipCompressionMethod) do
    FMethodStrings[i] := AbStrRes(AbMethod + Ord(i));
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseViewer.InvalidateRow(ARow: Longint);
var
  Rect: TRect;
begin
  if not HandleAllocated then
    Exit;
  if ((ARow < TopRow) or (ARow > TopRow + VisibleRowCount)) and (ARow <> 0) then
    Exit;
  Rect := CellRect(0, ARow);
  Rect.Right := ClientWidth;
{$IFDEF UsingCLX}
  InvalidateRect(Rect, False);
{$ELSE}
  InvalidateRect(Handle, @Rect, True);
{$ENDIF}
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseViewer.KeyDown(var Key: Word; Shift: TShiftState);
begin
  FShiftState := Shift;
  inherited KeyDown(Key, Shift);
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseViewer.KeyUp(var Key: Word; Shift: TShiftState);
begin
  FShiftState := Shift;
  inherited KeyUp(Key, Shift);
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseViewer.Loaded;
begin
  inherited Loaded;
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseViewer.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y : Integer);

  function GetMinLen(Col: Integer): Word;
  var
    I, L : Integer;
    s : String;
    aItem : TAbArchiveItem;
    Attr : TAbViewAttribute;
    Sorted : Boolean;
  begin
    Attr := TAbViewAttribute(ColMap(Col));
    Result := Canvas.TextWidth(FHeadings[ColMap(Col)]);
    case Attr of
      vaItemName : Sorted := saItemName in FSortAttributes;
      vaPacked   : Sorted := saPacked in FSortAttributes;
      vaRatio    : Sorted := saRatio in FSortAttributes;
      vaTimeStamp: Sorted := saTimeStamp in FSortAttributes;
      vaFileSize : Sorted := saFileSize in FSortAttributes;
      else Sorted := False;
    end;
    if Sorted then
      Result := Result + RowHeights[0] + 16
    else
      Result := Result + 8;

    if Assigned(FItemList) then
    for I := 0 to (FItemList.Count-1) do begin
      aItem := FItemList.Items[I];
      S := AttrToStr(Attr, aItem);
      L := Canvas.TextWidth(S) + 8;
      if (doShowIcons in FDisplayOptions) and (Attr = vaItemName) then
        inc(L, RowHeights[I]);
      if L > Result then
        Result := L;
    end;
  end;

var
  ACol : Longint;
  ARow : Longint;
  Rect : TRect;
begin
  ViewMouseCoord := MouseCoord(X, Y);
  inherited MouseDown(Button, Shift, X, Y);

  FShiftState := Shift;
  { handle double clicks on header row dividers }
  if (ssDouble in FShiftState) and (ViewMouseCoord.Y = AbHeaderRow) then begin
    FColSizing := True;
    Rect := CellRect(ViewMouseCoord.X, ViewMouseCoord.Y);
    Rect.Left := Rect.Right - 3;
    if PtInRect(Rect, Point(X, Y)) then begin
      ColWidths[MouseCoord(Rect.Left, Y).X] :=
        GetMinLen(MouseCoord(Rect.Left, Y).X)
    end
    else begin
      Rect := CellRect(ViewMouseCoord.X, ViewMouseCoord.Y);
      Rect.Right := Rect.Left + 4;
      if PtInRect(Rect, Point(X, Y)) then
        ColWidths[MouseCoord(Rect.Left, Y).X-1] :=
          GetMinLen(MouseCoord(Rect.Left, Y).X-1);
    end;
  end;

  { if grid is being resized }
  if (FGridState = gsColSizing) then begin
    FColSizing := True;
    Exit;  {dont press button when resizing column}
  end;

  { refresh the headers}
  if Assigned(FItemList) then
    if (FItemList.Count > 0) then begin
      ARow := ViewMouseCoord.Y;
      ACol := ViewMouseCoord.X;
      if (ARow = abHeaderRow) then begin
        {if not (doColMove in FDisplayOptions) then}
        if not (doColMove in FDisplayOptions) and not FColSizing then
          FButtonDown := True;
        RefreshCell(0, ACol);
      end else if not (ssShift in Shift) then
        RowAnchor := ActiveRow;
    end;
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseViewer.MouseUp(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  ACol   : Longint;
  ARow   : Longint;
  Attr   : TAbViewAttribute;
  SortAttribute : TAbSortAttribute;
begin
  inherited MouseUp(Button, Shift, X, Y);
  if csDesigning in ComponentState then Exit;

  FShiftState := Shift;
  FButtonDown := False;

  if FColSizing then begin
    Refresh;
    FColSizing := False;
  end else
    if Assigned(FItemList) then
      if (FItemList.Count > 0) then begin
        ARow := ViewMouseCoord.Y;
        ACol := ViewMouseCoord.X;
        if (ARow = abHeaderRow) then begin
          Attr := TAbViewAttribute(ColMap(ACol));
          if not FColMoving and                                       {!!.02}
            {not (doColMove in FDisplayOptions) and}                  {!!.02}
            AttrToSortAttribute(Attr, SortAttribute) and
            (SortAttribute in FSortAttributes) then begin
            FSortCol := ACol;
            FItemIndex := FRowMap[Row-1];
            FRowMap.SortBy(SortAttribute, FItemList);
            FButtonDown := False;
            RefreshCell(0, ACol);
            if (doTrackActiveRow in FDisplayOptions) then
              Row := FRowMap.InvRows[FItemIndex] + 1;
            Refresh;
            DoSorted(Attr);
          end else begin
            FButtonDown := False;
            RefreshCell(0, ACol);
          end;
        end else
          Paint;
      end;

  FColMoving := False;                                                {!!.02}
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseViewer.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseMove(Shift, X, Y);

  if (FGridState = gsColMoving) then                                  {!!.02}
    FColMoving := True;                                               {!!.02}
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseViewer.MoveColumn(FromCol, ToCol : Integer);
var
  temp, i : Integer;
begin
  Temp := ColMap(FromCol);
  if (FromCol < ToCol) then begin
    for i := (FromCol + 1) to ToCol do
      FColMap[TAbViewAttribute(i-1)] := FColMap[TAbViewAttribute(i)]; {Shift left}
  end else begin
    for i := (FromCol - 1) downto ToCol do
      FColMap[TAbViewAttribute(i+1)] := FColMap[TAbViewAttribute(i)]; {Shift right}
  end;
  FColMap[TAbViewAttribute(ToCol)] := Temp;
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseViewer.RefreshCell(ARow, ACol: Longint);
var
  Rect: TRect;
begin
  if not HandleAllocated then
    Exit;
  Rect := CellRect(ACol, ARow);
{$IFDEF UsingCLX}
  InvalidateRect(Rect, False);
{$ELSE}
  InvalidateRect(Handle, @Rect, False);
{$ENDIF}
  Update;
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseViewer.RefreshRow(ARow: Longint);
begin
  InvalidateRow(ARow);
  Update;
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseViewer.SelectAll;
begin
  if Assigned(FItemList) then
    if (FItemList.Count > 0) then begin
      FSelList.SelectAll(FItemList.Count);
      Invalidate;
    end;
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseViewer.SetActiveRow(RowNum : Longint);
begin
  if Assigned(FItemList) then
    if (RowNum >= 0) and (RowNum < FItemList.Count) then
       Row := RowNum + 1;
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseViewer.SetAttributes(Value : TAbViewAttributes);
begin
  FAttributes := Value;
  ColCount := UpdateColCount(FAttributes);
  DoChange(Self);
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseViewer.SetDisplayOptions(Value : TAbDisplayOptions);
  {maps DisplayOptions to TGridOptions}
begin
  FDisplayOptions := Value;
  Options := [goFixedVertLine, goFixedHorzLine, goRowSelect];

  if (doColLines in Value) then
    Options := Options + [goVertLine];
  if (doColMove in Value) then
    Options := Options + [goColMoving];
  if (doColSizing in Value) then
    Options := Options + [goColSizing];
  if (doRowLines in Value) then
    Options := Options + [goHorzLine];
  if (doThumbTrack in Value) then
    Options := Options + [goThumbTracking];
  DoChange(nil);
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseViewer.SetHeaderRowHeight(Value : Integer);
begin
  RowHeights[abHeaderRow] := Value;
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseViewer.SetHeadings(Value: TAbColHeadings);
begin
  Headings.Assign(Value);
  Refresh;
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseViewer.SetSortAttributes(Value : TAbSortAttributes);
begin
  FSortAttributes := Value;
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseViewer.SetSelected(RowNum : Longint; Value: Boolean);
begin
  if Assigned(FItemList) then
    case Value of
      True  : FSelList.Select(FRowMap[RowNum]);
      False : FSelList.Deselect(FRowMap[RowNum]);
    end;
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseViewer.SetVersion(const Value : string);
begin
  {NOP}
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseViewer.TopLeftChanged;
begin
  if FAllowInvalidate then
    Invalidate;
end;
{ -------------------------------------------------------------------------- }
function TAbBaseViewer.UpdateColCount(Attributes : TAbViewAttributes) : Integer;
var
  i : TAbViewAttribute;
begin
  Result := 0;
  for i := Low(TAbViewAttribute) to High(TAbViewAttribute) do begin
    if (i in Attributes) then begin
      FColMap[TAbViewAttribute(Result)] := Ord(i);
      Inc(Result);
    end;
  end;
end;
{ -------------------------------------------------------------------------- }
{$IFDEF UsingCLX}
procedure TAbBaseViewer.SizeChanged(OldColCount, OldRowCount: Longint);
begin
  inherited SizeChanged(OldColCount, OldRowCount);
  Refresh;
end;
{$ELSE}
procedure TAbBaseViewer.WMSize(var Msg: TWMSize);
begin
  inherited;
  Refresh;
end;
{$ENDIF}
{ -------------------------------------------------------------------------- }
{$IFNDEF UsingCLX}
procedure TAbBaseViewer.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
begin
  Msg.Result := -1;
end;
{$ENDIF}

end.