1658 lines
49 KiB
ObjectPascal
1658 lines
49 KiB
ObjectPascal
(* ***** 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.pas *}
|
|
{*********************************************************}
|
|
{* ABBREVIA: Base archive viewer component *}
|
|
{* Use AbQView.pas for CLX *}
|
|
{*********************************************************}
|
|
|
|
{$IFNDEF UsingCLX}
|
|
unit AbView;
|
|
{$ENDIF}
|
|
|
|
{$I AbDefine.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes,
|
|
Types,
|
|
{$IFDEF MSWINDOWS}
|
|
Windows,
|
|
Messages,
|
|
{$ENDIF}
|
|
{$IFDEF LibcAPI}
|
|
Libc,
|
|
{$ENDIF}
|
|
{$IFDEF UsingCLX }
|
|
Qt,
|
|
QControls,
|
|
QGraphics,
|
|
QGrids,
|
|
{$ELSE}
|
|
Controls,
|
|
Graphics,
|
|
Grids,
|
|
{$ENDIF}
|
|
AbArcTyp;
|
|
|
|
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, saPath, 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);
|
|
procedure SortOnItemDir(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;
|
|
FHeadings : TAbColHeadings;
|
|
FItemList : TAbArchiveList;
|
|
FRowMap : TAbRowMap;
|
|
FFileName : string;
|
|
FFontSize : Integer;
|
|
FItemIndex : Longint;
|
|
FColors : TAbColors;
|
|
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; const AText : string);
|
|
procedure DrawSortArrow;
|
|
function DrawTextFormat(Attr : TAbViewAttribute; var Rect : TRect) : Word;
|
|
function GetCount : Longint;
|
|
function GetActiveRow : Longint;
|
|
function GetHeaderRowHeight : Integer;
|
|
{$IFDEF MSWINDOWS}
|
|
function GetIcon(const 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 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;
|
|
{$IFDEF HasGridDrawingStyle}
|
|
procedure Paint;
|
|
override;
|
|
{$ENDIF}
|
|
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;
|
|
published
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
{$IFDEF MSWINDOWS}
|
|
ShellApi,
|
|
{$ENDIF}
|
|
{$IFDEF HasUITypes}
|
|
UITypes,
|
|
{$ENDIF}
|
|
SysUtils,
|
|
AbUtils,
|
|
AbConst,
|
|
AbResString,
|
|
AbZipTyp;
|
|
|
|
{ ===== 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
|
|
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;
|
|
case Attr of
|
|
saItemName : SortOnItemName(ItemList);
|
|
saPath : SortOnItemDir(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;
|
|
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;
|
|
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbRowMap.SortOnItemDir(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]).DiskPath;
|
|
AbUnFixName(FN);
|
|
SL.AddObject(ExtractFilePath(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(False);
|
|
|
|
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;
|
|
FColMoving := 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;
|
|
vaPath : SortAttr := saPath;
|
|
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
|
|
{$IFDEF MSWINDOWS}
|
|
{$WARN SYMBOL_PLATFORM OFF}
|
|
if (faReadOnly and ExternalFileAttributes) = faReadOnly then
|
|
Result := Result + AbReadOnlyS;
|
|
if (faHidden and ExternalFileAttributes) = faHidden then
|
|
Result := Result + AbHiddenS;
|
|
if (faSysFile and ExternalFileAttributes) = faSysFile then
|
|
Result := Result + AbSystemS;
|
|
if (faArchive and ExternalFileAttributes) = faArchive then
|
|
Result := Result + AbArchivedS;
|
|
{$WARN SYMBOL_PLATFORM OFF}
|
|
{$ENDIF MSWINDOWS}
|
|
end;
|
|
vaEncryption :
|
|
if IsEncrypted then
|
|
Result := AbEncryptedS;
|
|
vaTimeStamp :
|
|
if (LastModFileDate + LastModFileTime = 0) then
|
|
Result := AbUnknownS
|
|
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 := AbTextS
|
|
else
|
|
Result := AbBinaryS;
|
|
vaMethod :
|
|
Result := ZipCompressionMethodToString(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;
|
|
{ -------------------------------------------------------------------------- }
|
|
{$IFDEF HasGridDrawingStyle}
|
|
procedure TAbBaseViewer.Paint;
|
|
begin
|
|
DefaultDrawing := FInternalDrawingStyle <> gdsClassic;
|
|
inherited;
|
|
end;
|
|
{$ENDIF}
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbBaseViewer.DrawCell(ACol, ARow: Longint; ARect: TRect;
|
|
AState: TGridDrawState);
|
|
var
|
|
s : string;
|
|
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}
|
|
|
|
Canvas.Font := Font;
|
|
if (ARow = AbHeaderRow) then begin
|
|
DrawHeaderButton(ACol, FHeadings[ColMap(ACol)])
|
|
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
|
|
if not DefaultDrawing then Canvas.FillRect(ARect);
|
|
Exit;
|
|
end;
|
|
|
|
aItem := FItemList.Items[FRowMap[ARow-1]];
|
|
Attr := TAbViewAttribute(ColMap(ACol));
|
|
S := AttrToStr(Attr, aItem);
|
|
if (gdSelected in AState) or FSelList.IsSelected(FRowMap[ARow-1]) then begin
|
|
if not DefaultDrawing then begin
|
|
Brush.Color := FColors.Selected;
|
|
Font.Color := FColors.SelectedText;
|
|
end
|
|
{$IFDEF HasGridDrawingStyle}
|
|
else begin
|
|
if DrawingStyle = gdsGradient then
|
|
Canvas.Font.Color := clHighlightText;
|
|
if not (gdSelected in AState) then begin
|
|
if (goRowSelect in Options) then
|
|
Include(AState, gdRowSelected);
|
|
DrawCellHighlight(ARect, AState, ACol, ARow);
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
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;
|
|
if not DefaultDrawing then
|
|
Canvas.FillRect(ARect);
|
|
Canvas.Brush.Style := bsClear;
|
|
TxtRect := ARect;
|
|
{$IFNDEF UsingCLX}
|
|
Icon := 0;
|
|
if (Attr = vaItemName) then
|
|
Icon := GetIcon(aItem.Filename);
|
|
if (Icon <> 0) then begin
|
|
H := ARect.Bottom - ARect.Top;
|
|
DrawIconEx(Canvas.Handle, ARect.Left+1, ARect.Top+1, Icon,
|
|
H - 2, H - 2, 0, 0, DI_NORMAL);
|
|
TxtRect.Left := TxtRect.Left + H;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
DTFormat := DrawTextFormat(Attr, TxtRect);
|
|
{$IFNDEF UsingCLX}
|
|
DrawText(Canvas.Handle, PChar(s), -1, TxtRect, DTFormat);
|
|
{$ELSE}
|
|
Canvas.TextRect(TxtRect, TxtRect.Left, TxtRect.Top, s, DTFormat);
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbBaseViewer.DrawHeaderButton(ACol : Integer; const AText : string);
|
|
var
|
|
ARect : TRect;
|
|
DTFormat : Word;
|
|
begin
|
|
ARect := CellRect(ACol, 0);
|
|
if not DefaultDrawing then with Canvas do begin
|
|
Brush.Style := bsSolid;
|
|
Brush.Color := clBtnface;
|
|
FillRect(ARect);
|
|
if FButtonDown then
|
|
Pen.Color := clBtnHighlight
|
|
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, AText, DTFormat);
|
|
{$ELSE}
|
|
DrawText(Canvas.Handle, PChar(AText), -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;
|
|
{ -------------------------------------------------------------------------- }
|
|
function TAbBaseViewer.GetHeaderRowHeight : Integer;
|
|
begin
|
|
Result := RowHeights[AbHeaderRow];
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
{$IFDEF MSWINDOWS}
|
|
function TAbBaseViewer.GetIcon(const ItemName : string) : HIcon;
|
|
var
|
|
i : Longint;
|
|
t : string;
|
|
sfi : SHFILEINFO;
|
|
begin
|
|
Result := 0;
|
|
if not (doShowIcons in FDisplayOptions) then
|
|
Exit;
|
|
t := ExtractFileExt(ItemName);
|
|
i := FIcons.IndexOf(t);
|
|
if (i > -1) then
|
|
Result := HIcon(FIcons.Objects[i])
|
|
else begin
|
|
SHGetFileInfo(PChar(t), FILE_ATTRIBUTE_NORMAL, sfi, sizeof(sfi),
|
|
SHGFI_ICON or SHGFI_USEFILEATTRIBUTES);
|
|
Result := sfi.hIcon;
|
|
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 := AbVersionS;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbBaseViewer.InitColMap;
|
|
const
|
|
cResString: array[TAbViewAttribute] of string = (AbItemNameHeadingS,
|
|
AbPackedHeadingS, AbMethodHeadingS, AbRatioHeadingS, AbCRCHeadingS,
|
|
AbFileAttrHeadingS, AbFileFormatHeadingS, AbEncryptionHeadingS,
|
|
AbTimeStampHeadingS, AbFileSizeHeadingS, AbVersionMadeHeadingS,
|
|
AbVersionNeededHeadingS, AbPathHeadingS);
|
|
var
|
|
i : TAbViewAttribute;
|
|
begin
|
|
FHeadings.Clear;
|
|
for i := Low(TAbViewAttribute) to High(TAbViewAttribute) do begin
|
|
FHeadings.Add(cResString[i]);
|
|
FColMap[i] := Ord(i);
|
|
end;
|
|
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;
|
|
vaPath : Sorted := saPath 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
|
|
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;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbBaseViewer.MouseMove(Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
inherited MouseMove(Shift, X, Y);
|
|
|
|
if (FGridState = gsColMoving) then
|
|
FColMoving := True;
|
|
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];
|
|
{$IFDEF HasGridDrawingStyle}
|
|
Options := Options + [goFixedRowClick]; // Highlight pressed header when themed
|
|
{$ENDIF}
|
|
|
|
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.
|