abview.inc

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

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower Abbrevia
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1997-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{* ABBREVIA: AbView.inc 3.05                             *}
{*********************************************************}
{* ABBREVIA: Base archive viewer component (Source)      *}
{*   See AbView.pas for the VCL header                   *}
{*   See AbQView.pas for the CLX header                  *}
{*********************************************************}

{$I AbDefine.inc}

interface

uses
  SysUtils,
  Classes,
{$IFDEF MSWINDOWS}
  Windows,
  Messages,
  ShellApi,
{$ENDIF}
{$IFDEF LINUX}
  Libc,
  typesarchive,
{$ENDIF}
{$IFDEF UsingCLX }
  Qt,
  QControls,
  QGraphics,
  QForms,
  QGrids,
{$ELSE}
  Controls,
  Graphics,
  Forms,
  Grids,
{$ENDIF}
  AbExcept,
  AbUtils,
  AbConst,
  AbArcTyp,
  AbZipTyp;

type
  TAbViewAttribute =
    (vaItemName, vaPacked, vaMethod, vaRatio, vaCRC,
     vaFileAttributes, vaFileType, vaEncryption, vaTimeStamp,
     vaFileSize, vaVersionMade, vaVersionNeeded, vaPath);
  TAbViewAttributes = set of TAbViewAttribute;

  TAbDisplayOption =
    (doAlternateColors, doColLines, doColMove, doColSizing, doMultiSelect,
     doRowLines, doShowIcons, doThumbTrack, doTrackActiveRow);
  TAbDisplayOptions = set of TAbDisplayOption;

  TAbSortAttribute =
    (saItemName, saPacked, saRatio, saTimeStamp, saFileSize);
  TAbSortAttributes = set of TAbSortAttribute;

const
  AbDefColWidth = 150;
  AbDefRowHeight = 24;
  AbHeaderRow = 0;
  AbDefSelColor = clHighlight;
  AbDefSelTextColor = clHighlightText;
  AbDefHighColor = clAqua;
  AbDefHighTextColor = clRed;
  AbDefDelColor = clYellow;
  AbDefDelTextColor = clNavy;


{ ===== TAbColors ========================================================== }
type
  TAbColors = class(TPersistent)
  protected {private}
    FSelected : TColor;
    FSelectedText : TColor;
    FAlternate : TColor;
    FAlternateText : TColor;
    FDeleted : TColor;
    FDeletedText : TColor;
    FUpdating  : Boolean;
    FOnChange  : TNotifyEvent;
    procedure DoOnChange;
    procedure SetSelected(Value : TColor);
    procedure SetSelectedText(Value : TColor);
    procedure SetAlternate(Value : TColor);
    procedure SetAlternateText(Value : TColor);
    procedure SetDeleted(Value : TColor);
    procedure SetDeletedText(Value : TColor);
  public
    procedure BeginUpdate;
    procedure EndUpdate;
    property OnChange : TNotifyEvent
      read FOnChange
      write FOnChange;
  published
    property Selected : TColor
      read FSelected
      write SetSelected;
    property SelectedText : TColor
      read FSelectedText
      write SetSelectedText;
    property Alternate : TColor
      read FAlternate
      write SetAlternate;
    property AlternateText : TColor
      read FAlternateText
      write SetAlternateText;
    property Deleted : TColor
      read FDeleted
      write SetDeleted;
    property DeletedText : TColor
      read FDeletedText
      write SetDeletedText;
  end;


{ ===== TAbSelList ========================================================= }
type
  TAbSelList = class
  protected {private}
    FList  : TList;
    FCurrent : Longint;
  public {methods}
    constructor Create;
    destructor Destroy;
      override;
    procedure Clear;
    procedure Deselect(Index : Longint);
    function IsSelected(Index : Longint) : Boolean;
    procedure Select(Index : Longint);
    procedure SelectAll(Count : Longint);
    function SelCount : Longint;
    procedure Toggle(Index : Longint);
    function FindFirst : Longint;
    function FindNext : Longint;
  end;


{ ===== TAbRowMap ========================================================== }
type
  TAbRowMap = class
  protected {private}
    FRows : TList;
    FInvRows : TList;
    FSortAscending : Boolean;
    function GetRow(RowNum : Longint) : Longint;
    function GetInvRow(RowNum : Longint) : Longint;
    procedure SortOnItemName(ItemList : TAbArchiveList);
  public {methods}
    constructor Create;
    destructor Destroy;
      override;
    procedure Clear;
    procedure Init(RowCount : Longint);
    procedure SortBy(Attr : TAbSortAttribute; ItemList : TAbArchiveList);
  public {properties}
    property Rows[RowNum : Longint] : Longint
      read GetRow; default;
    property InvRows[RowNum : Longint] : Longint
      read GetInvRow;
    property SortAscending : Boolean
      read FSortAscending;
  end;


{ ===== TAbBaseViewer ==================================================== }
type
  TAbColHeadings = class(TStringList)
    end;
  TAbSortedEvent =
    procedure (Sender : TObject; Attr : TAbViewAttribute) of object;
  TAbDrawSortArrowEvent =
    procedure (Sender : TObject; Column : Integer; Ascending: Boolean;
      Cnv: TCanvas; Rect : TRect) of object;

  TAbBaseViewer = class(TCustomGrid)
  protected {private}
    FAllowInvalidate : Boolean;
    FAttributes : TAbViewAttributes;
    FDisplayOptions : TAbDisplayOptions;
    FSortAttributes : TAbSortAttributes;
    FColMap : array[TAbViewAttribute] of Integer;
    FColSizing : Boolean;
    FColMoving : Boolean;                                             {!!.02}
    FHeadings : TAbColHeadings;
    FItemList : TAbArchiveList;
    FRowMap : TAbRowMap;
    FFileName : string;
    FFontSize : Integer;
    FItemIndex : Longint;
    FColors : TAbColors;
    FMethodStrings : array [TAbZipCompressionMethod] of string;
    FButtonDown : Boolean;
    FIcons : TStringList;
    FSelList : TAbSelList;
    FMultiSelecting : Boolean;
    FShiftState : TShiftState;
    FSortCol : Integer;
    RowAnchor : Longint;
    ViewMouseCoord : TGridCoord;

    FOnChange : TNotifyEvent;
    FOnClick : TNotifyEvent;
    FOnDblClick : TNotifyEvent;
    FOnSorted : TAbSortedEvent;
    FOnDrawSortArrow : TAbDrawSortArrowEvent;

    function AttrToSortAttribute(Attr : TAbViewAttribute;
      var SortAttr : TAbSortAttribute) : Boolean;
    function AttrToStr(Attr : TAbViewAttribute; aItem : TAbArchiveItem) : string;
    function ColMap(ColNum : Integer) : Integer;
    procedure ColorsChange(Sender : TObject);
    procedure DrawHeaderButton(ACol : Integer; Text : PChar);
    procedure DrawSortArrow;
    function DrawTextFormat(Attr : TAbViewAttribute; var Rect : TRect) : Word;
    function GetCount : Longint;
    function GetActiveRow : Longint;
    function GetHeaderRowHeight : Integer;
{$IFDEF MSWINDOWS}
    function GetIcon(ItemName : string) : HIcon;
{$ENDIF}
{$IFDEF UsingClx}
  { no file type icons in Clx }
{$ENDIF}
    function GetSelCount : Longint;
    function GetSelected(RowNum : Longint) : Boolean;
    function GetVersion : string;
    procedure InitColMap;
    procedure InitMethodStrings;
    procedure InvalidateRow(ARow: Longint);
    procedure MoveColumn(FromCol, ToCol : Integer);
    procedure RefreshCell(ARow, ACol: Longint);
    procedure RefreshRow(ARow: Longint);
    procedure SetActiveRow(RowNum : Longint);
    procedure SetAttributes(Value : TAbViewAttributes);
    procedure SetDisplayOptions(Value : TAbDisplayOptions);
    procedure SetSortAttributes(Value : TAbSortAttributes);
    procedure SetHeaderRowHeight(Value : Integer);
    procedure SetHeadings(Value: TAbColHeadings);
    procedure SetSelected(RowNum : Longint; Value : Boolean);
    procedure SetVersion(const Value : string);
    function UpdateColCount(Attributes : TAbViewAttributes) : Integer;
{$IFDEF UsingCLX}
    procedure FontChanged; override;
    procedure SizeChanged(OldColCount, OldRowCount: Longint); override;
{$ELSE}
    procedure WMSize(var Msg: TWMSize);
      message WM_SIZE;
    procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd);
      message WM_ERASEBKGND;
    procedure CMFontChanged(var Message: TMessage);
      message CM_FONTCHANGED;
{$ENDIF UsingCLX}

  protected {overridden methods}
    procedure Click;
      override;
    procedure DblClick;
      override;
    procedure KeyDown(var Key: Word; Shift: TShiftState);
      override;
    procedure KeyUp(var Key: Word; Shift: TShiftState);
      override;
    procedure Loaded;
      override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y : Integer);
      override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
      override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer);
      override;
    procedure ColumnMoved(FromIndex, ToIndex: Longint);
      override;
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
      override;
    procedure TopLeftChanged;
      override;

  protected {virtual methods}
    procedure DoChange(Sender : TObject);
      virtual;
    procedure DoLoad(Sender : TObject);
      virtual;
    procedure DoSorted(Attr : TAbViewAttribute);
      virtual;

  protected {properties}
    property Attributes : TAbViewAttributes
      read FAttributes
      write SetAttributes;
    property DisplayOptions : TAbDisplayOptions
      read FDisplayOptions
      write SetDisplayOptions;
    property HeaderRowHeight : Integer
      read GetHeaderRowHeight
      write SetHeaderRowHeight;
    property Headings : TAbColHeadings
      read FHeadings
      write SetHeadings;
    property ItemList : TAbArchiveList
      read FItemList
      write FItemList;
    property SortAttributes : TAbSortAttributes
      read FSortAttributes
      write SetSortAttributes;
    property Version : string
      read GetVersion
      write SetVersion
      stored False;

  protected {events}
    property OnChange : TNotifyEvent
      read FOnChange
      write FOnChange;
    property OnClick : TNotifyEvent
      read FOnClick
      write FOnClick;
    property OnDblClick : TNotifyEvent
      read FOnDblClick
      write FOnDblClick;
    property OnSorted :  TAbSortedEvent
      read FOnSorted
      write FOnSorted;
    property OnDrawSortArrow : TAbDrawSortArrowEvent
      read FOnDrawSortArrow
      write FOnDrawSortArrow;

  public {methods}
    constructor Create(AOwner : TComponent);
      override;
    destructor  Destroy;
      override;
    procedure BeginUpdate;
    procedure EndUpdate;
    procedure ClearSelections;
    procedure SelectAll;

  public {run-time properties}
    property ActiveRow : Longint
      read GetActiveRow  write SetActiveRow;
    property Colors : TAbColors
      read FColors write FColors;
    property Count : Longint
      read GetCount;
    property SelCount : Longint
      read GetSelCount;
    property Selected[RowNum : Longint] : Boolean
      read GetSelected write SetSelected;
    
    property ColWidths;
    property RowHeights;
  end;


implementation

{ ===== TAbColors ========================================================== }
procedure TAbColors.BeginUpdate;
begin
  FUpdating := True;
end;
{ -------------------------------------------------------------------------- }
procedure TAbColors.EndUpdate;
begin
  FUpdating := False;
  DoOnChange;
end;
{ -------------------------------------------------------------------------- }
procedure TAbColors.DoOnChange;
begin
  if not FUpdating and Assigned(FOnChange) then
    FOnChange(Self);
end;
{ -------------------------------------------------------------------------- }
procedure TAbColors.SetSelected(Value : TColor);
begin