david
7ebea5ffa7
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.jvcl@12 7f62d464-2af8-f54e-996c-e91b33f51cbe
2938 lines
84 KiB
ObjectPascal
2938 lines
84 KiB
ObjectPascal
{-----------------------------------------------------------------------------
|
|
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/MPL-1.1.html
|
|
|
|
Software distributed under the License is distributed on an "AS IS" basis,
|
|
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
|
the specific language governing rights and limitations under the License.
|
|
|
|
The Original Code is: JvListView.PAS, released on 2001-02-28.
|
|
|
|
The Initial Developer of the Original Code is Sébastien Buysse [sbuysse att buypin dott com]
|
|
Portions created by Sébastien Buysse are Copyright (C) 2001 Sébastien Buysse.
|
|
All Rights Reserved.
|
|
|
|
Contributor(s): Michael Beck [mbeck att bigfoot dott com].
|
|
dejoy
|
|
Olivier Sannier [obones att altern dott org]
|
|
|
|
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
|
|
located at http://jvcl.sourceforge.net
|
|
|
|
Known Issues:
|
|
Mantis 3932: In the OnCustomDrawItem, if you change the canvas font directly,
|
|
then your changes will be ignored and the items be drawn bold if
|
|
the item brush is not used for the given list view style
|
|
(report for instance). As a workaround, always change the item's
|
|
properties, never the canvas' directly.
|
|
-----------------------------------------------------------------------------}
|
|
// $Id: JvListView.pas 11893 2008-09-09 20:45:14Z obones $
|
|
|
|
unit JvListView;
|
|
|
|
{$I jvcl.inc}
|
|
{$I vclonly.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF UNITVERSIONING}
|
|
JclUnitVersioning,
|
|
{$ENDIF UNITVERSIONING}
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
|
|
ComCtrls, CommCtrl, Menus, ImgList, Clipbrd,
|
|
JvJCLUtils, JvJVCLUtils, JvTypes, JvExComCtrls, JvAppStorage, JvVCL5Utils;
|
|
|
|
type
|
|
TJvViewStyle = (vsIcon, vsSmallIcon, vsList, vsReport, vsTile);
|
|
TJvHeaderImagePosition = (hipLeft, hipRight);
|
|
|
|
const
|
|
WM_AUTOSELECT = WM_USER + 1;
|
|
ALL_VIEW_STYLES = [vsIcon, vsSmallIcon, vsList, vsReport, vsTile];
|
|
|
|
type
|
|
TJvListView = class;
|
|
TJvListViewGroup = class;
|
|
EJvListViewError = EJVCLException;
|
|
|
|
// Mantis 980: new type for Groups
|
|
TLVGROUP = record
|
|
cbSize: UINT;
|
|
mask: UINT;
|
|
pszHeader: LPWSTR;
|
|
cchHeader: Integer;
|
|
pszFooter: LPWSTR;
|
|
cchFooter: Integer;
|
|
iGroupId: Integer;
|
|
stateMask: UINT;
|
|
state: UINT;
|
|
uAlign: UINT;
|
|
end;
|
|
|
|
// TJvSortMethod = (smAutomatic, smAlphabetic, smNonCaseSensitive, smNumeric, smDate, smTime, smDateTime, smCurrency);
|
|
TJvOnProgress = procedure(Sender: TObject; Progression, Total: Integer) of object;
|
|
TJvListViewCompareGroupEvent = procedure(Sender: TObject; Group1, Group2: TJvListViewGroup; var Compare: Integer) of object;
|
|
|
|
TJvListItems = class(TListItems, IJvAppStorageHandler, IJvAppStoragePublishedProps)
|
|
private
|
|
FOwnerInterface: IInterface;
|
|
protected
|
|
{ IInterface }
|
|
function _AddRef: Integer; stdcall;
|
|
function _Release: Integer; stdcall;
|
|
{ IJvAppStorageHandler }
|
|
procedure ReadFromAppStorage(AppStorage: TJvCustomAppStorage; const BasePath: string);
|
|
procedure WriteToAppStorage(AppStorage: TJvCustomAppStorage; const BasePath: string);
|
|
|
|
{ List item reader used in the call to ReadList. }
|
|
procedure ReadListItem(Sender: TJvCustomAppStorage; const Path: string;
|
|
const List: TObject; const Index: Integer; const ItemName: string);
|
|
{ List item writer used in the call to WriteList. }
|
|
procedure WriteListItem(Sender: TJvCustomAppStorage; const Path: string;
|
|
const List: TObject; const Index: Integer; const ItemName: string);
|
|
{ List item deleter used in the call to WriteList. }
|
|
procedure DeleteListItem(Sender: TJvCustomAppStorage; const Path: string;
|
|
const List: TObject; const First, Last: Integer; const ItemName: string);
|
|
public
|
|
function QueryInterface(const IID: TGUID; out Obj): HRESULT; virtual; stdcall;
|
|
procedure AfterConstruction; override;
|
|
end;
|
|
|
|
TJvListItem = class(TListItem)
|
|
private
|
|
FPopupMenu: TPopupMenu;
|
|
FBold: Boolean;
|
|
FFont: TFont;
|
|
FBrush: TBrush;
|
|
FGroupId: Integer;
|
|
FTileColumns: TIntegerList;
|
|
procedure SetBrush(const Value: TBrush);
|
|
procedure SetGroupId(const Value: Integer);
|
|
procedure SetTileColumns(const Value: TIntegerList);
|
|
|
|
procedure ReadTileColumns(Reader: TReader);
|
|
procedure WriteTileColumns(Writer: TWriter);
|
|
procedure TileColumnsChange(Sender: TObject; Item: Integer; Action: TListNotification);
|
|
protected
|
|
procedure SetPopupMenu(const Value: TPopupMenu);
|
|
procedure SetFont(const Value: TFont);
|
|
procedure UpdateTileColumns;
|
|
public
|
|
constructor CreateEnh(AOwner: TListItems; const Popup: TPopupMenu);
|
|
destructor Destroy; override;
|
|
|
|
procedure DefineProperties(Filer: TFiler); override;
|
|
|
|
property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
|
|
property TileColumns: TIntegerList read FTileColumns write SetTileColumns;
|
|
published
|
|
property Font: TFont read FFont write SetFont;
|
|
property Brush: TBrush read FBrush write SetBrush;
|
|
property GroupId: Integer read FGroupId write SetGroupId default -1;
|
|
// Published now for the usage of AppStorage.Read/WritePersistent
|
|
property Caption;
|
|
property Checked;
|
|
property Selected;
|
|
property SubItems;
|
|
end;
|
|
|
|
TJvListExtendedColumn = class(TCollectionItem)
|
|
private
|
|
FSortMethod: TJvSortMethod;
|
|
FUseParentSortMethod: Boolean;
|
|
FHeaderImagePosition: TJvHeaderImagePosition;
|
|
FUseParentHeaderImagePosition: Boolean;
|
|
function GetSortMethod: TJvSortMethod;
|
|
procedure SetSortMethod(const Value: TJvSortMethod);
|
|
function GetHeaderImagePosition: TJvHeaderImagePosition;
|
|
procedure SetHeaderImagePosition(const Value: TJvHeaderImagePosition);
|
|
procedure SetUseParentHeaderImagePosition(const Value: Boolean);
|
|
public
|
|
constructor Create(Collection: Classes.TCollection); override;
|
|
|
|
procedure Assign(AValue: TPersistent); override;
|
|
published
|
|
property SortMethod: TJvSortMethod read GetSortMethod write SetSortMethod default smAutomatic;
|
|
property UseParentSortMethod : Boolean read FUseParentSortMethod write FUseParentSortMethod default True;
|
|
property HeaderImagePosition: TJvHeaderImagePosition read GetHeaderImagePosition write SetHeaderImagePosition default hipLeft;
|
|
property UseParentHeaderImagePosition : Boolean read FUseParentHeaderImagePosition write SetUseParentHeaderImagePosition default True;
|
|
end;
|
|
|
|
TJvListExtendedColumns = class(TOwnedCollection)
|
|
private
|
|
function GetItem(Index: Integer): TJvListExtendedColumn;
|
|
procedure SetItem(Index: Integer; const Value: TJvListExtendedColumn);
|
|
|
|
function Owner : TPersistent;
|
|
public
|
|
constructor Create(AOwner: TPersistent);
|
|
property Items[Index: Integer] : TJvListExtendedColumn read GetItem write SetItem; default;
|
|
end;
|
|
|
|
TJvListViewGroup = class(TCollectionItem)
|
|
private
|
|
FHeader: WideString;
|
|
FGroupId: Integer;
|
|
FHeaderAlignment: TAlignment;
|
|
procedure SetHeader(const Value: WideString);
|
|
procedure SetHeaderAlignment(const Value: TAlignment);
|
|
procedure SetGroupId(const Value: Integer);
|
|
|
|
procedure UpdateGroupProperties(const NewGroupId: Integer = -1);
|
|
public
|
|
constructor Create(Collection: Classes.TCollection); override;
|
|
destructor Destroy; override;
|
|
procedure Assign(AValue: TPersistent); override;
|
|
procedure SetLVGROUP(var GroupInfo: TLVGROUP);
|
|
published
|
|
property GroupId: Integer read FGroupId write SetGroupId default -1;
|
|
property Header: WideString read FHeader write SetHeader;
|
|
property HeaderAlignment: TAlignment read FHeaderAlignment write SetHeaderAlignment default taLeftJustify;
|
|
end;
|
|
|
|
TJvListViewGroups = class(TOwnedCollection)
|
|
private
|
|
FSorted: Boolean;
|
|
function GetItem(Index: Integer): TJvListViewGroup;
|
|
procedure SetItem(Index: Integer; const Value: TJvListViewGroup);
|
|
|
|
function ParentList: TJvListView;
|
|
procedure InsertGroupIntoList(group: TJvListViewGroup);
|
|
procedure RemoveGroupFromList(group: TJvListViewGroup);
|
|
|
|
function Compare(Id1, Id2: Integer): Integer;
|
|
function GetItemById(GroupId: Integer): TJvListViewGroup;
|
|
procedure SetSorted(const Value: Boolean);
|
|
protected
|
|
procedure Notify(Item: TCollectionItem; Action: TCollectionNotification); override;
|
|
public
|
|
constructor Create(AOwner: TPersistent);
|
|
procedure Sort;
|
|
|
|
property Items[Index: Integer] : TJvListViewGroup read GetItem write SetItem; default;
|
|
property ItemsById[GroupId: Integer]: TJvListViewGroup read GetItemById;
|
|
published
|
|
property Sorted: Boolean read FSorted write SetSorted default False;
|
|
end;
|
|
|
|
TJvGroupsPropertiesBorderRect = class(TJvRect)
|
|
public
|
|
constructor Create;
|
|
published
|
|
property Top default 12;
|
|
end;
|
|
|
|
TJvGroupsPropertiesBorderColors = class(TPersistent)
|
|
private
|
|
FRight: TColor;
|
|
FBottom: TColor;
|
|
FTop: TColor;
|
|
FLeft: TColor;
|
|
FOnChange: TNotifyEvent;
|
|
procedure SetBottom(const Value: TColor);
|
|
procedure SetLeft(const Value: TColor);
|
|
procedure SetRight(const Value: TColor);
|
|
procedure SetTop(const Value: TColor);
|
|
protected
|
|
procedure DoChange;
|
|
public
|
|
constructor Create;
|
|
|
|
procedure Assign(Source: TPersistent); override;
|
|
|
|
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
|
published
|
|
property Top: TColor read FTop write SetTop default $C8D0D4;
|
|
property Left: TColor read FLeft write SetLeft default clWhite;
|
|
property Bottom: TColor read FBottom write SetBottom default clWhite;
|
|
property Right: TColor read FRight write SetRight default clWhite;
|
|
end;
|
|
|
|
TJvGroupsProperties = class(TPersistent)
|
|
private
|
|
FBorderSize: TJvGroupsPropertiesBorderRect;
|
|
FBorderColor: TJvGroupsPropertiesBorderColors;
|
|
FHeaderColor: TColor;
|
|
|
|
FOnChange: TNotifyEvent;
|
|
FLoading: Boolean;
|
|
procedure SetBorderSize(const Value: TJvGroupsPropertiesBorderRect);
|
|
procedure SetBorderColor(const Value: TJvGroupsPropertiesBorderColors);
|
|
|
|
procedure BorderSizeChange(Sender: TObject);
|
|
procedure BorderColorChange(Sender: TObject);
|
|
procedure SetHeaderColor(const Value: TColor);
|
|
protected
|
|
procedure DoChange;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
|
|
procedure LoadFromList(List: TCustomListView);
|
|
|
|
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
|
published
|
|
property BorderSize: TJvGroupsPropertiesBorderRect read FBorderSize write SetBorderSize;
|
|
property HeaderColor: TColor read FHeaderColor write SetHeaderColor default clBlack;
|
|
|
|
// Note that BorderColor is currently ignored by the Win32 API
|
|
property BorderColor: TJvGroupsPropertiesBorderColors read FBorderColor write SetBorderColor;
|
|
end;
|
|
|
|
TJvViewStyles = set of TJvViewStyle;
|
|
|
|
TJvTileSizeKind = (tskAutoSize, tskFixedWidth, tskFixedHeight, tskFixedSize);
|
|
|
|
TJvTileViewProperties = class(TPersistent)
|
|
private
|
|
FLabelMargin: TJvRect;
|
|
FTileSize: TJvSize;
|
|
FSubLinesCount: Integer;
|
|
FTileSizeKind: TJvTileSizeKind;
|
|
FOnChange: TNotifyEvent;
|
|
FLoading: Boolean;
|
|
procedure SetLabelMargin(const Value: TJvRect);
|
|
procedure SetSubLinesCount(const Value: Integer);
|
|
procedure SetTileSize(const Value: TJvSize);
|
|
procedure SetTileSizeKind(const Value: TJvTileSizeKind);
|
|
|
|
procedure LabelMarginChange(Sender: TObject);
|
|
procedure TileSizeChange(Sender: TObject);
|
|
protected
|
|
procedure DoChange;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
|
|
procedure LoadFromList(List: TCustomListView);
|
|
|
|
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
|
published
|
|
property TileSizeKind: TJvTileSizeKind read FTileSizeKind write SetTileSizeKind default tskAutoSize;
|
|
property TileSize: TJvSize read FTileSize write SetTileSize;
|
|
property SubLinesCount: Integer read FSubLinesCount write SetSubLinesCount default 1;
|
|
property LabelMargin: TJvRect read FLabelMargin write SetLabelMargin;
|
|
end;
|
|
|
|
TJvInsertMarkPosition = (impBefore, impAfter);
|
|
|
|
TJvListView = class(TJvExListView)
|
|
private
|
|
FAutoClipboardCopy: Boolean;
|
|
FSortOnClick: Boolean;
|
|
FLast: Integer;
|
|
FOnSaveProgress: TJvOnProgress;
|
|
FOnLoadProgress: TJvOnProgress;
|
|
FOnAutoSort: TJvListViewColumnSortEvent;
|
|
FSortMethod: TJvSortMethod;
|
|
FOnHorizontalScroll: TNotifyEvent;
|
|
FOnVerticalScroll: TNotifyEvent;
|
|
FImageChangeLink: TChangeLink;
|
|
FHeaderImagePosition: TJvHeaderImagePosition;
|
|
FHeaderImages: TCustomImageList;
|
|
FAutoSelect: Boolean;
|
|
FPicture: TPicture;
|
|
FExtendedColumns: TJvListExtendedColumns;
|
|
FSavedExtendedColumns: TJvListExtendedColumns;
|
|
FViewStylesItemBrush: TJvViewStyles; // use for Create/DestroyWnd process
|
|
FGroupView: Boolean;
|
|
FGroups: TJvListViewGroups;
|
|
FGroupsProperties: TJvGroupsProperties;
|
|
FOnCompareGroups: TJvListViewCompareGroupEvent;
|
|
FViewStyle: TJvViewStyle;
|
|
FTileViewProperties: TJvTileViewProperties;
|
|
FInsertMarkColor: TColor;
|
|
FSettingJvViewStyle: Boolean;
|
|
FSettingHeaderImagePosition: Boolean;
|
|
procedure DoPictureChange(Sender: TObject);
|
|
procedure SetPicture(const Value: TPicture);
|
|
procedure SetGroupView(const Value: Boolean);
|
|
procedure SetGroups(const Value: TJvListViewGroups);
|
|
procedure SetGroupsProperties(const Value: TJvGroupsProperties);
|
|
procedure SetTileViewProperties(const Value: TJvTileViewProperties);
|
|
procedure SetInsertMarkColor(const Value: TColor);
|
|
procedure SetHeaderImagePosition(const Value: TJvHeaderImagePosition);
|
|
procedure SetHeaderImages(const Value: TCustomImageList);
|
|
procedure UpdateHeaderImages(HeaderHandle: Integer);
|
|
procedure WMAutoSelect(var Msg: TMessage); message WM_AUTOSELECT;
|
|
procedure SetExtendedColumns(const Value: TJvListExtendedColumns);
|
|
{$IFDEF COMPILER5}
|
|
function GetItemIndex: Integer;
|
|
procedure SetItemIndex(const Value: Integer);
|
|
{$ENDIF COMPILER5}
|
|
procedure SetViewStylesItemBrush(const Value: TJvViewStyles);
|
|
function DoCompareGroups(Group1, Group2: TJvListViewGroup): Integer;
|
|
procedure TileViewPropertiesChange(Sender: TObject);
|
|
procedure GroupsPropertiesChange(Sender: TObject);
|
|
procedure LoadTileViewProperties;
|
|
procedure LoadGroupsProperties;
|
|
protected
|
|
function CreateListItem: TListItem; override;
|
|
function CreateListItems: TListItems; {$IFDEF COMPILER6_UP} override; {$ENDIF}
|
|
procedure WMHScroll(var Msg: TWMHScroll); message WM_HSCROLL;
|
|
procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL;
|
|
procedure KeyUp(var Key: Word; Shift: TShiftState); override;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
function GetColumnsOrder: string;
|
|
procedure SetColumnsOrder(const Order: string);
|
|
procedure SetItemPopup(Node: TListItem; Value: TPopupMenu);
|
|
function GetItemPopup(Node: TListItem): TPopupMenu;
|
|
procedure DoHeaderImagesChange(Sender: TObject);
|
|
procedure Loaded; override;
|
|
{$IFDEF COMPILER6_UP}
|
|
procedure SetViewStyle(Value: TViewStyle); override;
|
|
{$ENDIF COMPILER6_UP}
|
|
procedure SetJvViewStyle(Value: TJvViewStyle); virtual;
|
|
|
|
procedure CreateWnd; override;
|
|
procedure DestroyWnd; override;
|
|
|
|
procedure WMNCCalcSize(var Msg: TWMNCCalcSize); message WM_NCCALCSIZE;
|
|
procedure LVMDeleteColumn(var Msg: TMessage); message LVM_DELETECOLUMN;
|
|
procedure LVMInsertColumn(var Msg: TMessage); message LVM_INSERTCOLUMN;
|
|
procedure LVMSetColumn(var Msg: TMessage); message LVM_SETCOLUMN;
|
|
procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
|
|
|
|
procedure InsertItem(Item: TListItem); override;
|
|
function IsCustomDrawn(Target: TCustomDrawTarget; Stage: TCustomDrawStage): Boolean; {$IFDEF COMPILER6_UP} override; {$ENDIF}
|
|
function CustomDraw(const ARect: TRect; Stage: TCustomDrawStage): Boolean; override;
|
|
function CustomDrawItem(Item: TListItem; State: TCustomDrawState;
|
|
Stage: TCustomDrawStage): Boolean; override;
|
|
function CustomDrawSubItem(Item: TListItem; SubItem: Integer;
|
|
State: TCustomDrawState; Stage: TCustomDrawStage): Boolean; override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure ColClick(Column: TListColumn); override;
|
|
procedure SaveToStrings(Strings: TStrings; Separator: Char);
|
|
procedure LoadFromStrings(Strings: TStrings; Separator: Char);
|
|
procedure SaveToFile(FileName: string; ForceOldStyle: Boolean = False);
|
|
procedure LoadFromFile(FileName: string);
|
|
procedure SaveToStream(Stream: TStream; ForceOldStyle: Boolean = False);
|
|
procedure LoadFromStream(Stream: TStream);
|
|
procedure SaveToCSV(FileName: string; Separator: Char = ';');
|
|
procedure LoadFromCSV(FileName: string; Separator: Char = ';');
|
|
procedure SetSmallImages(const Value: TCustomImageList);
|
|
{$IFDEF COMPILER5}
|
|
procedure SelectAll;
|
|
procedure DeleteSelected;
|
|
{$ENDIF COMPILER5}
|
|
procedure UnselectAll;
|
|
procedure InvertSelection;
|
|
function MoveUp(Index: Integer; Focus: Boolean = True): Integer;
|
|
function MoveDown(Index: Integer; Focus: Boolean = True): Integer;
|
|
function SelectNextItem(Focus: Boolean = True): Integer;
|
|
function SelectPrevItem(Focus: Boolean = True): Integer;
|
|
|
|
function ShowInsertMark(ItemIndex: Integer; Position: TJvInsertMarkPosition): Boolean;
|
|
function HideInsertMark: Boolean;
|
|
function GetInsertMarkPosition(const X, Y: Integer; var ItemIndex: Integer; var Position: TJvInsertMarkPosition): Boolean;
|
|
|
|
property ItemPopup[Item: TListItem]: TPopupMenu read GetItemPopup write SetItemPopup;
|
|
procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer;
|
|
AHeight: Integer); override;
|
|
procedure SetFocus; override;
|
|
{$IFDEF COMPILER5}
|
|
property ItemIndex: Integer read GetItemIndex write SetItemIndex;
|
|
{$ENDIF COMPILER5}
|
|
published
|
|
property AutoSelect: Boolean read FAutoSelect write FAutoSelect default True;
|
|
property ColumnsOrder: string read GetColumnsOrder write SetColumnsOrder;
|
|
property HintColor;
|
|
property Picture: TPicture read FPicture write SetPicture;
|
|
property HeaderImagePosition: TJvHeaderImagePosition read FHeaderImagePosition write SetHeaderImagePosition default hipLeft;
|
|
property HeaderImages: TCustomImageList read FHeaderImages write SetHeaderImages;
|
|
property SortMethod: TJvSortMethod read FSortMethod write FSortMethod default smAutomatic;
|
|
property SortOnClick: Boolean read FSortOnClick write FSortOnClick default True;
|
|
property SmallImages write SetSmallImages;
|
|
property AutoClipboardCopy: Boolean read FAutoClipboardCopy write FAutoClipboardCopy default True;
|
|
property GroupView: Boolean read FGroupView write SetGroupView default False;
|
|
property Groups: TJvListViewGroups read FGroups write SetGroups;
|
|
property GroupsProperties: TJvGroupsProperties read FGroupsProperties write SetGroupsProperties;
|
|
property TileViewProperties: TJvTileViewProperties read FTileViewProperties write SetTileViewProperties;
|
|
property InsertMarkColor: TColor read FInsertMarkColor write SetInsertMarkColor default clBlack;
|
|
|
|
property ViewStylesItemBrush : TJvViewStyles read FViewStylesItemBrush write SetViewStylesItemBrush default ALL_VIEW_STYLES;
|
|
property ViewStyle: TJvViewStyle read FViewStyle write SetJvViewStyle default vsIcon;
|
|
|
|
property OnAutoSort: TJvListViewColumnSortEvent read FOnAutoSort write FOnAutoSort;
|
|
property OnHorizontalScroll: TNotifyEvent read FOnHorizontalScroll write FOnHorizontalScroll;
|
|
property OnLoadProgress: TJvOnProgress read FOnLoadProgress write FOnLoadProgress;
|
|
property OnSaveProgress: TJvOnProgress read FOnSaveProgress write FOnSaveProgress;
|
|
property OnVerticalScroll: TNotifyEvent read FOnVerticalScroll write FOnVerticalScroll;
|
|
property OnCompareGroups: TJvListViewCompareGroupEvent read FOnCompareGroups write FOnCompareGroups;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnParentColorChange;
|
|
|
|
// This property contains a collection that allows to specify additional
|
|
// properties for each columns (sort method for instance). It can not be
|
|
// included in the Columns collection as the VCL does not offer a way
|
|
// to specify which class to use for the items of the Columns collection.
|
|
// Note that this one (ExtendedColumns) is populated automatically when
|
|
// a column is added or deleted. But because the VCL code for add starts
|
|
// by deleting all columns to reinsert them after, you should not change
|
|
// the properties for any item of ExtendedColumns in a loop that contains
|
|
// a call to the Add method of the Columns property.
|
|
property ExtendedColumns : TJvListExtendedColumns read FExtendedColumns write SetExtendedColumns;
|
|
end;
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
const
|
|
UnitVersioning: TUnitVersionInfo = (
|
|
RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/branches/JVCL3_36_PREPARATION/run/JvListView.pas $';
|
|
Revision: '$Revision: 11893 $';
|
|
Date: '$Date: 2008-09-09 22:45:14 +0200 (mar., 09 sept. 2008) $';
|
|
LogPath: 'JVCL\run'
|
|
);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
implementation
|
|
|
|
uses
|
|
{$IFDEF COMPILER10_UP}
|
|
Types,
|
|
{$ENDIF COMPILER10_UP}
|
|
Math, Contnrs,
|
|
{$IFDEF HAS_UNIT_VARIANTS}
|
|
VarUtils, Variants,
|
|
{$ELSE}
|
|
ActiveX,
|
|
{$ENDIF HAS_UNIT_VARIANTS}
|
|
JclWideStrings,
|
|
JvConsts, JvResources;
|
|
|
|
type
|
|
// Mantis 980: New types for group/tile/insert mark handling
|
|
tagLVITEMA = packed record
|
|
mask: UINT;
|
|
iItem: Integer;
|
|
iSubItem: Integer;
|
|
state: UINT;
|
|
stateMask: UINT;
|
|
pszText: PAnsiChar;
|
|
cchTextMax: Integer;
|
|
iImage: Integer;
|
|
lParam: lParam;
|
|
iIndent: Integer;
|
|
iGroupId: Integer;
|
|
cColumns: UINT;
|
|
puColumns: PUINT;
|
|
end;
|
|
TLVITEMA = tagLVITEMA;
|
|
|
|
TFNLVGROUPCOMPARE = function (Group1_ID: Integer; Group2_ID: Integer; pvData: Pointer): Integer; stdcall;
|
|
PFNLVGROUPCOMPARE = ^TFNLVGROUPCOMPARE;
|
|
|
|
tagLVINSERTGROUPSORTED = packed record
|
|
pfnGroupCompare: PFNLVGROUPCOMPARE;
|
|
pvData: Pointer;
|
|
lvGroup: TLVGROUP;
|
|
end;
|
|
TLVINSERTGROUPSORTED = tagLVINSERTGROUPSORTED;
|
|
PLVINSERTGROUPSORTED = ^TLVINSERTGROUPSORTED;
|
|
|
|
tagLVTILEVIEWINFO = packed record
|
|
cbSize: UINT;
|
|
dwMask: DWORD;
|
|
dwFlags: DWORD;
|
|
sizeTile: TSize;
|
|
cLines: Integer;
|
|
rcLabelMargin: TRect;
|
|
end;
|
|
TLVTILEVIEWINFO = tagLVTILEVIEWINFO;
|
|
PLVTILEVIEWINFO = ^TLVTILEVIEWINFO;
|
|
|
|
tagLVTILEINFO = packed record
|
|
cbSize: UINT;
|
|
iItem: Integer;
|
|
cColumns: UINT;
|
|
puColumns: PUINT;
|
|
end;
|
|
TLVTILEINFO = tagLVTILEINFO;
|
|
PLVTILEINFO = ^TLVTILEINFO;
|
|
|
|
tagLVINSERTMARK = packed record
|
|
cbSize: UINT;
|
|
dwFlags: DWORD;
|
|
iItem: Integer;
|
|
dwReserved: DWORD;
|
|
end;
|
|
TLVINSERTMARK = tagLVINSERTMARK;
|
|
PLVINSERTMARK = ^TLVINSERTMARK;
|
|
|
|
tagLVGROUPMETRICS = packed record
|
|
cbSize: UINT;
|
|
mask: UINT;
|
|
Left: UINT;
|
|
Top: UINT;
|
|
Right: UINT;
|
|
Bottom: UINT;
|
|
crLeft: COLORREF;
|
|
crTop: COLORREF;
|
|
crRight: COLORREF;
|
|
crBottom: COLORREF;
|
|
crHeader: COLORREF;
|
|
crFooter: COLORREF;
|
|
end;
|
|
TLVGROUPMETRICS = tagLVGROUPMETRICS;
|
|
PLVGROUPMETRICS = ^TLVGROUPMETRICS;
|
|
|
|
const
|
|
// Mantis 980: New constants for group/tile/insert mark handling
|
|
LVM_SETTILEWIDTH = LVM_FIRST + 141;
|
|
LVM_SETVIEW = LVM_FIRST + 142;
|
|
LVM_INSERTGROUP = LVM_FIRST + 145;
|
|
LVM_SETGROUPINFO = LVM_FIRST + 147;
|
|
LVM_REMOVEGROUP = LVM_FIRST + 150;
|
|
LVM_MOVEITEMTOGROUP = LVM_FIRST + 154;
|
|
LVM_SETGROUPMETRICS = LVM_FIRST + 155;
|
|
LVM_GETGROUPMETRICS = LVM_FIRST + 156;
|
|
LVM_ENABLEGROUPVIEW = LVM_FIRST + 157;
|
|
LVM_SORTGROUPS = LVM_FIRST + 158;
|
|
LVM_INSERTGROUPSORTED = LVM_FIRST + 159;
|
|
LVM_REMOVEALLGROUPS = LVM_FIRST + 160;
|
|
LVM_SETTILEVIEWINFO = LVM_FIRST + 162;
|
|
LVM_GETTILEVIEWINFO = LVM_FIRST + 163;
|
|
LVM_SETTILEINFO = LVM_FIRST + 164;
|
|
LVM_GETTILEINFO = LVM_FIRST + 165;
|
|
LVM_SETINSERTMARK = LVM_FIRST + 166;
|
|
LVM_INSERTMARKHITTEST = LVM_FIRST + 168;
|
|
LVM_GETINSERTMARKRECT = LVM_FIRST + 169;
|
|
LVM_SETINSERTMARKCOLOR = LVM_FIRST + 170;
|
|
LVM_GETINSERTMARKCOLOR = LVM_FIRST + 171;
|
|
|
|
// ListViewItemFlag
|
|
LVIF_GROUPID = $0100;
|
|
|
|
// ListViewGroupFlag
|
|
LVGF_HEADER = $00000001;
|
|
LVGF_ALIGN = $00000008;
|
|
LVGF_GROUPID = $00000010;
|
|
|
|
// group alignment
|
|
LVGA_HEADER_LEFT = $00000001;
|
|
LVGA_HEADER_CENTER = $00000002;
|
|
LVGA_HEADER_RIGHT = $00000004;
|
|
|
|
// view styles
|
|
LV_VIEW_ICON = $00;
|
|
LV_VIEW_DETAILS = $01;
|
|
LV_VIEW_SMALLICON = $02;
|
|
LV_VIEW_LIST = $03;
|
|
LV_VIEW_TILE = $04;
|
|
|
|
// LVTVIF (ListViewTileViewInfoFlag Constants)
|
|
LVTVIF_AUTOSIZE = 0;
|
|
LVTVIF_FIXEDWIDTH = 1;
|
|
LVTVIF_FIXEDHEIGHT = 2;
|
|
LVTVIF_FIXEDSIZE = 3;
|
|
|
|
// LVTVIM (ListViewTileViewInfoMask Constants)
|
|
LVTVIM_TILESIZE = 1;
|
|
LVTVIM_COLUMNS = 2;
|
|
LVTVIM_LABELMARGIN = 4;
|
|
|
|
// LVIM (ListViewInsertMark Constants)
|
|
LVIM_AFTER = 1;
|
|
|
|
// LVGMF (ListViewGroupMetricsFlag Constants)
|
|
LVGMF_NONE = $00000000;
|
|
LVGMF_BORDERSIZE = $00000001;
|
|
LVGMF_BORDERCOLOR = $00000002;
|
|
LVGMF_TEXTCOLOR = $00000004;
|
|
|
|
AlignmentToLVGA: array[TAlignment] of Integer = (LVGA_HEADER_LEFT, LVGA_HEADER_RIGHT, LVGA_HEADER_CENTER);
|
|
TileSizeKindToLVTVIF: array[TJvTileSizeKind] of Integer = (LVTVIF_AUTOSIZE, LVTVIF_FIXEDWIDTH, LVTVIF_FIXEDHEIGHT, LVTVIF_FIXEDSIZE);
|
|
InsertMarkPositionToLVIM: array[TJvInsertMarkPosition] of Integer = (0, LVIM_AFTER);
|
|
|
|
// (rom) increased from 100
|
|
cColumnsHandled = 1024;
|
|
|
|
//=== { TJvListItem } ========================================================
|
|
|
|
constructor TJvListItem.CreateEnh(AOwner: TListItems; const Popup: TPopupMenu);
|
|
begin
|
|
inherited Create(AOwner);
|
|
|
|
FBold := False;
|
|
FPopupMenu := Popup; // (Salvatore) Get it from the JvListView
|
|
FFont := TFont.Create;
|
|
FBrush := TBrush.Create;
|
|
FGroupId := -1;
|
|
FTileColumns := TIntegerList.Create;
|
|
|
|
FTileColumns.OnChange := TileColumnsChange;
|
|
if AOwner.Owner is TJvListView then
|
|
FFont.Assign((AOwner.Owner as TJvListView).Canvas.Font);
|
|
end;
|
|
|
|
procedure TJvListItem.DefineProperties(Filer: TFiler);
|
|
begin
|
|
inherited DefineProperties(Filer);
|
|
|
|
// Because a TList is not saved natively by Delphi, we do it ourselves.
|
|
Filer.DefineProperty('TileColumns', ReadTileColumns, WriteTileColumns, True);
|
|
end;
|
|
|
|
destructor TJvListItem.Destroy;
|
|
begin
|
|
FTileColumns.Free;
|
|
FFont.Free;
|
|
FBrush.Free;
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJvListItem.ReadTileColumns(Reader: TReader);
|
|
begin
|
|
FTileColumns.ReadData(Reader);
|
|
UpdateTileColumns;
|
|
end;
|
|
|
|
procedure TJvListItem.SetBrush(const Value: TBrush);
|
|
begin
|
|
FBrush.Assign(Value);
|
|
end;
|
|
|
|
procedure TJvListItem.SetFont(const Value: TFont);
|
|
begin
|
|
FFont.Assign(Value);
|
|
end;
|
|
|
|
procedure TJvListItem.SetGroupId(const Value: Integer);
|
|
var
|
|
Infos: JvListView.TLVITEMA;
|
|
List: TCustomListView;
|
|
begin
|
|
if FGroupId <> Value then
|
|
begin
|
|
FGroupId := Value;
|
|
|
|
List := Owner.Owner;
|
|
if Assigned(List) then
|
|
begin
|
|
ZeroMemory(@Infos, sizeof(Infos));
|
|
Infos.mask := LVIF_GROUPID;
|
|
Infos.iItem := Index;
|
|
Infos.iGroupId := FGroupId;
|
|
|
|
SendMessage(List.Handle, LVM_SETITEM, 0, LPARAM(@Infos));
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvListItem.SetPopupMenu(const Value: TPopupMenu);
|
|
begin
|
|
FPopupMenu := Value;
|
|
end;
|
|
|
|
procedure TJvListItem.SetTileColumns(const Value: TIntegerList);
|
|
begin
|
|
FTileColumns.Assign(Value);
|
|
end;
|
|
|
|
procedure TJvListItem.TileColumnsChange(Sender: TObject; Item: Integer;
|
|
Action: TListNotification);
|
|
begin
|
|
if not TileColumns.Loading then
|
|
UpdateTileColumns;
|
|
end;
|
|
|
|
procedure TJvListItem.UpdateTileColumns;
|
|
type
|
|
TCardinalArray = array [0..0] of Cardinal;
|
|
var
|
|
List: TCustomListView;
|
|
TileInfos: TLVTILEINFO;
|
|
Cols: ^TCardinalArray;
|
|
I: Integer;
|
|
begin
|
|
List := Owner.Owner;
|
|
if Assigned(List) then
|
|
begin
|
|
GetMem(Cols, FTileColumns.Count);
|
|
try
|
|
for I := 0 to FTileColumns.Count - 1 do
|
|
begin
|
|
Cols[I] := FTileColumns[I];
|
|
end;
|
|
|
|
ZeroMemory(@TileInfos, SizeOf(TileInfos));
|
|
TileInfos.cbSize := SizeOf(TileInfos);
|
|
TileInfos.iItem := Index;
|
|
TileInfos.cColumns := FTileColumns.Count;
|
|
TileInfos.puColumns := PUINT(Cols);
|
|
SendMessage(List.Handle, LVM_SETTILEINFO, 0, LPARAM(@TileInfos));
|
|
finally
|
|
FreeMem(Cols);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvListItem.WriteTileColumns(Writer: TWriter);
|
|
begin
|
|
FTileColumns.WriteData(Writer);
|
|
end;
|
|
|
|
//=== { TJvListItems } =======================================================
|
|
|
|
procedure TJvListItems.AfterConstruction;
|
|
begin
|
|
inherited AfterConstruction;
|
|
if GetOwner <> nil then
|
|
GetOwner.GetInterface(IInterface, FOwnerInterface);
|
|
end;
|
|
|
|
function TJvListItems._AddRef: Integer;
|
|
begin
|
|
if FOwnerInterface <> nil then
|
|
Result := FOwnerInterface._AddRef
|
|
else
|
|
Result := -1;
|
|
end;
|
|
|
|
function TJvListItems._Release: Integer;
|
|
begin
|
|
if FOwnerInterface <> nil then
|
|
Result := FOwnerInterface._Release
|
|
else
|
|
Result := -1;
|
|
end;
|
|
|
|
function TJvListItems.QueryInterface(const IID: TGUID; out Obj): HRESULT;
|
|
const
|
|
E_NOINTERFACE = HRESULT($80004002);
|
|
begin
|
|
if GetInterface(IID, Obj) then
|
|
Result := 0
|
|
else
|
|
Result := E_NOINTERFACE;
|
|
end;
|
|
|
|
procedure TJvListItems.ReadFromAppStorage(AppStorage: TJvCustomAppStorage; const BasePath: string);
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
Clear;
|
|
AppStorage.ReadList(BasePath, Self, ReadListItem, cItem);
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvListItems.WriteToAppStorage(AppStorage: TJvCustomAppStorage; const BasePath: string);
|
|
begin
|
|
AppStorage.WriteList(BasePath, Self, Count, WriteListItem, DeleteListItem, cItem);
|
|
end;
|
|
|
|
procedure TJvListItems.ReadListItem(Sender: TJvCustomAppStorage;
|
|
const Path: string; const List: TObject; const Index: Integer; const ItemName: string);
|
|
var
|
|
NewItem: TPersistent;
|
|
NewPath: string;
|
|
begin
|
|
if List is TJvListItems then
|
|
try
|
|
NewPath := Sender.ConcatPaths([Path, ItemName + IntToStr(Index)]);
|
|
NewItem := TJvListItems(List).Add;
|
|
Sender.ReadPersistent(NewPath, NewItem);
|
|
except
|
|
end;
|
|
end;
|
|
|
|
procedure TJvListItems.WriteListItem(Sender: TJvCustomAppStorage;
|
|
const Path: string; const List: TObject; const Index: Integer; const ItemName: string);
|
|
begin
|
|
if List is TJvListItems then
|
|
if Assigned(TJvListItems(List)[Index]) then
|
|
Sender.WritePersistent(Sender.ConcatPaths([Path, ItemName + IntToStr(Index)]), TPersistent(TJvListItems(List)[Index]));
|
|
end;
|
|
|
|
procedure TJvListItems.DeleteListItem(Sender: TJvCustomAppStorage;
|
|
const Path: string; const List: TObject; const First, Last: Integer; const ItemName: string);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if List is TJvListItems then
|
|
for I := First to Last do
|
|
Sender.DeleteValue(Sender.ConcatPaths([Path, ItemName + IntToStr(I)]));
|
|
end;
|
|
|
|
{ TJvListExtendedColumn }
|
|
|
|
procedure TJvListExtendedColumn.Assign(AValue: TPersistent);
|
|
begin
|
|
if AValue is TJvListExtendedColumn then
|
|
begin
|
|
FSortMethod := TJvListExtendedColumn(AValue). SortMethod;
|
|
FUseParentSortMethod := TJvListExtendedColumn(AValue).UseParentSortMethod;
|
|
|
|
FHeaderImagePosition := TJvListExtendedColumn(AValue).HeaderImagePosition;
|
|
FUseParentHeaderImagePosition := TJvListExtendedColumn(AValue).UseParentHeaderImagePosition;
|
|
end
|
|
else
|
|
inherited Assign(AValue);
|
|
end;
|
|
|
|
constructor TJvListExtendedColumn.Create(Collection: Classes.TCollection);
|
|
begin
|
|
inherited Create(Collection);
|
|
|
|
FSortMethod := smAutomatic;
|
|
FUseParentSortMethod := True;
|
|
|
|
FHeaderImagePosition := hipLeft;
|
|
FUseParentHeaderImagePosition := True;
|
|
end;
|
|
|
|
function TJvListExtendedColumn.GetHeaderImagePosition: TJvHeaderImagePosition;
|
|
begin
|
|
if (TJvListExtendedColumns(Collection).Owner is TJvListView) and UseParentHeaderImagePosition then
|
|
Result := TJvListView(TJvListExtendedColumns(Collection).Owner).HeaderImagePosition
|
|
else
|
|
Result := FHeaderImagePosition;
|
|
end;
|
|
|
|
function TJvListExtendedColumn.GetSortMethod: TJvSortMethod;
|
|
begin
|
|
if (TJvListExtendedColumns(Collection).Owner is TJvListView) and UseParentSortMethod then
|
|
Result := TJvListView(TJvListExtendedColumns(Collection).Owner).SortMethod
|
|
else
|
|
Result := FSortMethod;
|
|
end;
|
|
|
|
procedure TJvListExtendedColumn.SetHeaderImagePosition(
|
|
const Value: TJvHeaderImagePosition);
|
|
begin
|
|
FHeaderImagePosition := Value;
|
|
UseParentHeaderImagePosition := False;
|
|
|
|
if (TJvListExtendedColumns(Collection).Owner is TJvListView) then
|
|
begin
|
|
TJvListView(TJvListExtendedColumns(Collection).Owner).DoHeaderImagesChange(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvListExtendedColumn.SetSortMethod(
|
|
const Value: TJvSortMethod);
|
|
begin
|
|
FSortMethod := Value;
|
|
UseParentSortMethod := False;
|
|
end;
|
|
|
|
procedure TJvListExtendedColumn.SetUseParentHeaderImagePosition(
|
|
const Value: Boolean);
|
|
begin
|
|
if FUseParentHeaderImagePosition <> Value then
|
|
begin
|
|
FUseParentHeaderImagePosition := Value;
|
|
if (TJvListExtendedColumns(Collection).Owner is TJvListView) then
|
|
begin
|
|
TJvListView(TJvListExtendedColumns(Collection).Owner).DoHeaderImagesChange(Self);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TJvListExtendedColumns }
|
|
|
|
constructor TJvListExtendedColumns.Create(AOwner: TPersistent);
|
|
begin
|
|
inherited Create(AOwner, TJvListExtendedColumn);
|
|
end;
|
|
|
|
function TJvListExtendedColumns.GetItem(
|
|
Index: Integer): TJvListExtendedColumn;
|
|
begin
|
|
Result := TJvListExtendedColumn(inherited Items[Index]);
|
|
end;
|
|
|
|
function TJvListExtendedColumns.Owner: TPersistent;
|
|
begin
|
|
Result := GetOwner;
|
|
end;
|
|
|
|
procedure TJvListExtendedColumns.SetItem(Index: Integer;
|
|
const Value: TJvListExtendedColumn);
|
|
begin
|
|
inherited Items[Index] := Value;
|
|
end;
|
|
|
|
//=== { TJvListView } ========================================================
|
|
|
|
const
|
|
cLISTVIEW01 = 'LISTVIEW01';
|
|
|
|
constructor TJvListView.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FSortOnClick := True;
|
|
FSortMethod := smAutomatic;
|
|
FLast := -1;
|
|
FInsertMarkColor := clBlack;
|
|
FAutoClipboardCopy := True;
|
|
FHeaderImagePosition := hipLeft;
|
|
FImageChangeLink := TChangeLink.Create;
|
|
FImageChangeLink.OnChange := DoHeaderImagesChange;
|
|
FAutoSelect := True;
|
|
FPicture := TPicture.Create;
|
|
FPicture.OnChange := DoPictureChange;
|
|
|
|
FViewStylesItemBrush := ALL_VIEW_STYLES;
|
|
FExtendedColumns := TJvListExtendedColumns.Create(Self);
|
|
FSavedExtendedColumns := TJvListExtendedColumns.Create(Self);
|
|
FGroups := TJvListViewGroups.Create(Self);
|
|
FGroupsProperties := TJvGroupsProperties.Create;
|
|
FTileViewProperties := TJvTileViewProperties.Create;
|
|
|
|
FTileViewProperties.OnChange := TileViewPropertiesChange;
|
|
FGroupsProperties.OnChange := GroupsPropertiesChange;
|
|
end;
|
|
|
|
destructor TJvListView.Destroy;
|
|
begin
|
|
FGroupsProperties.Free;
|
|
FTileViewProperties.Free;
|
|
FGroups.Free;
|
|
FExtendedColumns.Free;
|
|
FSavedExtendedColumns.Free;
|
|
|
|
FImageChangeLink.Free;
|
|
FPicture.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJvListView.WMHScroll(var Msg: TWMHScroll);
|
|
begin
|
|
inherited;
|
|
UpdateHeaderImages(ListView_GetHeader(Handle));
|
|
if Assigned(FOnHorizontalScroll) then
|
|
FOnHorizontalScroll(Self);
|
|
end;
|
|
|
|
procedure TJvListView.WMVScroll(var Msg: TWMVScroll);
|
|
begin
|
|
inherited;
|
|
UpdateHeaderImages(ListView_GetHeader(Handle));
|
|
if Assigned(FOnVerticalScroll) then
|
|
FOnVerticalScroll(Self);
|
|
end;
|
|
|
|
procedure TJvListView.ColClick(Column: TListColumn);
|
|
type
|
|
TParamSort = record
|
|
Index: Integer;
|
|
Sender: TObject;
|
|
end;
|
|
var
|
|
Parm: TParamSort;
|
|
|
|
function CustomCompare1(Item1, Item2, ParamSort: Integer): Integer stdcall;
|
|
var
|
|
Parm: TParamSort;
|
|
i1, i2: TListItem;
|
|
S1, S2: string;
|
|
I: Integer;
|
|
SortKind: TJvSortMethod;
|
|
|
|
function IsBigger(First, Second: string; SortType: TJvSortMethod): Boolean;
|
|
var
|
|
I, J: Double;
|
|
d, e: TDateTime;
|
|
a, b: Currency;
|
|
l, m: Int64;
|
|
st, st2: string;
|
|
int1, int2: Integer;
|
|
|
|
function FirstNonAlpha(Value: string): Integer;
|
|
var
|
|
Len: Integer;
|
|
I, J: Integer;
|
|
Comma: Boolean;
|
|
begin
|
|
Len := Length(Value);
|
|
I := 1;
|
|
J := 0;
|
|
Comma := False;
|
|
|
|
while I <= Len do
|
|
begin
|
|
case Value[I] of
|
|
'0', '1', '2', '3', '4', '5', '6', '7', '8', '9':
|
|
J := I;
|
|
',', '.':
|
|
if not Comma then
|
|
Comma := True
|
|
else
|
|
begin
|
|
J := I - 1;
|
|
I := Len;
|
|
end;
|
|
else
|
|
begin
|
|
J := I - 1;
|
|
I := Len;
|
|
end;
|
|
end;
|
|
Inc(I);
|
|
end;
|
|
|
|
Result := J;
|
|
end;
|
|
|
|
begin
|
|
Result := False;
|
|
if Trim(First) = '' then
|
|
Result := False
|
|
else
|
|
if Trim(Second) = '' then
|
|
Result := True
|
|
else
|
|
begin
|
|
case SortType of
|
|
smAlphabetic:
|
|
Result := First > Second;
|
|
smNonCaseSensitive:
|
|
Result := UpperCase(First) > UpperCase(Second);
|
|
smNumeric:
|
|
begin
|
|
try
|
|
VarR8FromStr(First, LOCALE_USER_DEFAULT, 0, I);
|
|
VarR8FromStr(Second, LOCALE_USER_DEFAULT, 0, J);
|
|
Result := I > J;
|
|
except
|
|
try
|
|
l := StrToInt64(First);
|
|
except
|
|
l := 0;
|
|
end;
|
|
try
|
|
m := StrToInt64(Second);
|
|
except
|
|
m := 0;
|
|
end;
|
|
Result := l > m;
|
|
end;
|
|
end;
|
|
smDate:
|
|
begin
|
|
d := StrToDate(First);
|
|
e := StrToDate(Second);
|
|
Result := d > e;
|
|
end;
|
|
smTime:
|
|
begin
|
|
d := StrToTime(First);
|
|
e := StrToTime(Second);
|
|
Result := d > e;
|
|
end;
|
|
smDateTime:
|
|
begin
|
|
d := StrToDateTime(First);
|
|
e := StrToDateTime(Second);
|
|
Result := d > e;
|
|
end;
|
|
smCurrency:
|
|
begin
|
|
VarCyFromStr(First, LOCALE_USER_DEFAULT, 0, a);
|
|
VarCyFromStr(Second, LOCALE_USER_DEFAULT, 0, b);
|
|
Result := a > b;
|
|
end;
|
|
smAutomatic:
|
|
begin
|
|
int1 := FirstNonAlpha(First);
|
|
int2 := FirstNonAlpha(Second);
|
|
if (int1 <> 0) and (int2 <> 0) then
|
|
begin
|
|
st := Copy(First, 1, int1);
|
|
st2 := Copy(Second, 1, int2);
|
|
try
|
|
Result := StrToFloat(st) > StrToFloat(st2);
|
|
except
|
|
Result := First > Second;
|
|
end;
|
|
end
|
|
else
|
|
Result := First > Second;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Parm := TParamSort(Pointer(ParamSort)^);
|
|
i1 := TListItem(Item1);
|
|
i2 := TListItem(Item2);
|
|
I := Parm.Index;
|
|
|
|
// (Salvatore)
|
|
if Parm.Index < TJvListView(Parm.Sender).ExtendedColumns.Count then
|
|
SortKind := TJvListView(Parm.Sender).ExtendedColumns[Parm.Index].SortMethod
|
|
else
|
|
SortKind := TJvListView(Parm.Sender).SortMethod;
|
|
|
|
if Assigned(TJvListView(Parm.Sender).OnAutoSort) then
|
|
TJvListView(Parm.Sender).OnAutoSort(Parm.Sender, Parm.Index, SortKind);
|
|
|
|
case I of
|
|
{sort by caption}
|
|
0:
|
|
begin
|
|
S1 := i1.Caption;
|
|
S2 := i2.Caption;
|
|
|
|
if IsBigger(S1, S2, SortKind) then
|
|
Result := 1
|
|
else
|
|
if IsBigger(S2, S1, SortKind) then
|
|
Result := -1
|
|
else
|
|
Result := 0;
|
|
end;
|
|
else
|
|
{sort by Column}
|
|
begin
|
|
if I > i1.SubItems.Count then
|
|
begin
|
|
if I > i2.SubItems.Count then
|
|
Result := 0
|
|
else
|
|
Result := -1;
|
|
end
|
|
else
|
|
if I > i2.SubItems.Count then
|
|
Result := 1
|
|
else
|
|
begin
|
|
S1 := i1.SubItems[I - 1];
|
|
S2 := i2.SubItems[I - 1];
|
|
if IsBigger(S1, S2, SortKind) then
|
|
Result := 1
|
|
else
|
|
if IsBigger(S2, S1, SortKind) then
|
|
Result := -1
|
|
else
|
|
Result := 0;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function CustomCompare2(Item1, Item2, ParamSort: Integer): Integer; stdcall;
|
|
begin
|
|
Result := -CustomCompare1(Item1, Item2, ParamSort);
|
|
end;
|
|
|
|
begin
|
|
inherited ColClick(Column);
|
|
if FSortOnClick then
|
|
begin
|
|
Parm.Index := Column.Index;
|
|
Parm.Sender := Self;
|
|
if FLast = Column.Index then
|
|
begin
|
|
FLast := -1;
|
|
CustomSort(TLVCompare(@CustomCompare2), Integer(@Parm));
|
|
end
|
|
else
|
|
begin
|
|
FLast := Column.Index;
|
|
CustomSort(TLVCompare(@CustomCompare1), Integer(@Parm));
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TJvListView.CreateListItem: TListItem;
|
|
begin
|
|
Result := TJvListItem.CreateEnh(Items, Self.PopupMenu);
|
|
end;
|
|
|
|
function TJvListView.CreateListItems: TListItems;
|
|
begin
|
|
Result := TJvListItems.Create(Self);
|
|
end;
|
|
|
|
function TJvListView.GetItemPopup(Node: TListItem): TPopupMenu;
|
|
begin
|
|
Result := TJvListItem(Node).PopupMenu;
|
|
end;
|
|
|
|
procedure TJvListView.SetItemPopup(Node: TListItem; Value: TPopupMenu);
|
|
begin
|
|
TJvListItem(Node).PopupMenu := Value;
|
|
end;
|
|
|
|
procedure TJvListView.LoadFromFile(FileName: string);
|
|
var
|
|
Stream: TFileStream;
|
|
begin
|
|
Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
|
|
try
|
|
LoadFromStream(Stream);
|
|
finally
|
|
Stream.Free;
|
|
end;
|
|
end;
|
|
|
|
// (rom) a 100 char buffer is silly
|
|
|
|
procedure TJvListView.LoadFromStream(Stream: TStream);
|
|
var
|
|
Buf: array [0..100] of Char;
|
|
Start: Integer;
|
|
|
|
procedure LoadOldStyle(Stream: TStream);
|
|
var
|
|
I, J, K: Integer;
|
|
Buf: array [0..100] of Byte;
|
|
st: string;
|
|
ch1, checks: Boolean;
|
|
t: TListItem;
|
|
begin
|
|
I := Stream.Position;
|
|
t := nil;
|
|
st := '';
|
|
Items.Clear;
|
|
if Assigned(FOnLoadProgress) then
|
|
FOnLoadProgress(Self, 0, Stream.Size - Start);
|
|
checks := False;
|
|
ch1 := CheckBoxes;
|
|
while I < Stream.Size do
|
|
begin
|
|
J := Stream.Read(Buf, 100);
|
|
if Assigned(FOnLoadProgress) then
|
|
FOnLoadProgress(Self, J, Stream.Size - Start);
|
|
I := I + J;
|
|
K := 0;
|
|
while K < J do
|
|
begin
|
|
while (K < J) and (Buf[K] <> 0) and (Buf[K] <> 1) do
|
|
begin
|
|
st := st + Char(Buf[K]);
|
|
Inc(K);
|
|
end;
|
|
|
|
if K < J then
|
|
begin
|
|
if t <> nil then
|
|
t.SubItems.Add(st)
|
|
else
|
|
begin
|
|
t := Items.Add;
|
|
checks := checks or (st[1] = 'T');
|
|
t.Checked := st[1] = 'T';
|
|
st := Copy(st, 2, Length(st));
|
|
t.Caption := st;
|
|
end;
|
|
if Buf[K] = 1 then
|
|
t := nil;
|
|
st := '';
|
|
end;
|
|
Inc(K);
|
|
end;
|
|
end;
|
|
if (not ch1) and (not checks) then
|
|
CheckBoxes := False;
|
|
end;
|
|
|
|
procedure LoadNewStyle(Stream: TStream);
|
|
const
|
|
LV_HASCHECKBOXES = $80;
|
|
// hs- LV_CHECKED = $8000;
|
|
var
|
|
Count, I, J: SmallInt;
|
|
Options: Byte;
|
|
st: string;
|
|
t: TListItem;
|
|
Buf: array [0..2048] of Char;
|
|
begin
|
|
try
|
|
Self.Items.BeginUpdate;
|
|
Self.Items.Clear;
|
|
Self.Items.EndUpdate;
|
|
|
|
Stream.Read(Options, SizeOf(Options));
|
|
CheckBoxes := (Options and LV_HASCHECKBOXES) = LV_HASCHECKBOXES;
|
|
|
|
//Read all lines
|
|
while Stream.Position < Stream.Size do
|
|
begin
|
|
Stream.Read(Count, SizeOf(Count));
|
|
|
|
//statistics
|
|
if Assigned(FOnLoadProgress) then
|
|
FOnLoadProgress(Self, Stream.Position, Stream.Size - Start);
|
|
|
|
//Read all columns
|
|
t := Self.Items.Add;
|
|
for I := 1 to Count do
|
|
begin
|
|
// hs-
|
|
if I = 1 then
|
|
begin
|
|
Stream.Read(Options, SizeOf(Options));
|
|
if CheckBoxes then
|
|
t.Checked := Boolean(Options and Ord(True));
|
|
end;
|
|
// -hs
|
|
|
|
(* hs-
|
|
Stream.Read(J, SizeOf(I));
|
|
-hs *)
|
|
Stream.Read(J, SizeOf(J));
|
|
|
|
//Read the string
|
|
FillChar(Buf, SizeOf(Buf), #0);
|
|
Stream.Read(Buf, J);
|
|
st := Buf;
|
|
|
|
if I = 1 then
|
|
begin
|
|
t.Caption := st;
|
|
(* hs-
|
|
if CheckBoxes then
|
|
t.Checked := (I and LV_CHECKED) = LV_CHECKED;
|
|
-hs *)
|
|
end
|
|
else
|
|
t.SubItems.Add(st);
|
|
end;
|
|
end;
|
|
except
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Start := Stream.Position;
|
|
Stream.Read(Buf, 10);
|
|
Buf[10] := #0;
|
|
if Buf <> cLISTVIEW01 then
|
|
begin
|
|
Stream.Position := Start;
|
|
LoadOldStyle(Stream);
|
|
end
|
|
else
|
|
LoadNewStyle(Stream);
|
|
end;
|
|
|
|
procedure TJvListView.SaveToFile(FileName: string; ForceOldStyle: Boolean);
|
|
var
|
|
Stream: TFileStream;
|
|
begin
|
|
Stream := TFileStream.Create(FileName, fmCreate or fmShareExclusive);
|
|
try
|
|
SaveToStream(Stream, ForceOldStyle);
|
|
finally
|
|
Stream.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvListView.SaveToStream(Stream: TStream; ForceOldStyle: Boolean);
|
|
|
|
procedure SaveOldStyle(Stream: TStream);
|
|
var
|
|
I, J, K: Integer;
|
|
b, c, d, e: Byte;
|
|
st: string;
|
|
Buf: array [0..1000] of Byte;
|
|
begin
|
|
b := 0;
|
|
c := 1;
|
|
d := Ord('T'); //checked
|
|
e := Ord('F'); //not checked
|
|
if Assigned(FOnSaveProgress) then
|
|
FOnSaveProgress(Self, 0, Self.Items.Count);
|
|
for I := 0 to Self.Items.Count - 1 do
|
|
begin
|
|
if Assigned(FOnSaveProgress) then
|
|
FOnSaveProgress(Self, I + 1, Self.Items.Count);
|
|
st := Self.Items[I].Caption;
|
|
for K := 1 to Length(st) do
|
|
Buf[K - 1] := Byte(st[K]);
|
|
K := Length(st);
|
|
//write checked,not
|
|
if Self.Items[I].Checked then
|
|
Stream.Write(d, 1)
|
|
else
|
|
Stream.Write(e, 1);
|
|
Stream.Write(Buf, K);
|
|
if Self.Items[I].SubItems.Count = 0 then
|
|
Stream.Write(c, 1)
|
|
else
|
|
begin
|
|
Stream.Write(b, 1);
|
|
for J := 0 to Self.Items[I].SubItems.Count - 2 do
|
|
begin
|
|
st := Self.Items[I].SubItems[J];
|
|
for K := 1 to Length(st) do
|
|
Buf[K - 1] := Byte(st[K]);
|
|
K := Length(st);
|
|
Stream.Write(Buf, K);
|
|
Stream.Write(b, 1);
|
|
end;
|
|
J := Self.Items[I].SubItems.Count - 1;
|
|
st := Self.Items[I].SubItems[J];
|
|
for K := 1 to Length(st) do
|
|
Buf[K - 1] := Byte(st[K]);
|
|
K := Length(st);
|
|
Stream.Write(Buf, K);
|
|
Stream.Write(c, 1);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure SaveNewStyle(Stream: TStream);
|
|
const
|
|
LV_HASCHECKBOXES = $80;
|
|
// hs- LV_CHECKED = $8000;
|
|
var
|
|
Buf: array [0..100] of Char;
|
|
// hs- I, J: Word;
|
|
I: Integer;
|
|
J: SmallInt;
|
|
|
|
// hs Options : Byte;
|
|
Options, IsChecked: Byte;
|
|
|
|
procedure WriteString(const Txt: string);
|
|
var
|
|
I: Word;
|
|
begin
|
|
I := Length(Txt);
|
|
Stream.Write(I, SizeOf(I));
|
|
if I > 0 then
|
|
Stream.Write(Txt[1], I);
|
|
end;
|
|
|
|
begin
|
|
Buf := cLISTVIEW01;
|
|
Stream.Write(Buf, 10);
|
|
if CheckBoxes then
|
|
Options := LV_HASCHECKBOXES
|
|
else
|
|
Options := 0;
|
|
Stream.Write(Options, SizeOf(Options));
|
|
for I := 0 to Items.Count - 1 do
|
|
with Items[I] do
|
|
begin
|
|
J := SubItems.Count + 1;
|
|
Stream.Write(J, SizeOf(J));
|
|
// hs-
|
|
IsChecked := Options or (Byte(Ord(Checked)));
|
|
Stream.Write(IsChecked, SizeOf(IsChecked));
|
|
// -hs
|
|
WriteString(Items[I].Caption);
|
|
for J := 0 to Items[I].SubItems.Count - 1 do
|
|
WriteString(SubItems[J]);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if ForceOldStyle then
|
|
SaveOldStyle(Stream)
|
|
else
|
|
SaveNewStyle(Stream);
|
|
end;
|
|
|
|
procedure TJvListView.SaveToStrings(Strings: TStrings; Separator: Char);
|
|
var
|
|
I, J: Integer;
|
|
TmpStr: string;
|
|
begin
|
|
if Assigned(FOnSaveProgress) then
|
|
FOnSaveProgress(Self, 0, Items.Count);
|
|
for I := 0 to Items.Count - 1 do
|
|
begin
|
|
if Assigned(FOnSaveProgress) then
|
|
FOnSaveProgress(Self, I + 1, Items.Count);
|
|
TmpStr := AnsiQuotedStr(Items[I].Caption, '"');
|
|
for J := 0 to Items[I].SubItems.Count - 1 do
|
|
TmpStr := TmpStr + Separator + AnsiQuotedStr(Items[I].SubItems[J], '"');
|
|
Strings.Add(TmpStr);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvListView.LoadFromStrings(Strings: TStrings; Separator: Char);
|
|
var
|
|
I: Integer;
|
|
Start, Stop, TmpStart: PChar;
|
|
TmpStr: string;
|
|
Li: TListItem;
|
|
begin
|
|
for I := 0 to Strings.Count - 1 do
|
|
begin
|
|
Li := nil;
|
|
Start := PChar(Strings[I]);
|
|
Stop := Start + Length(Strings[I]);
|
|
if (Start <> Stop) and (Start <> nil) and (Start^ <> #0) then
|
|
begin
|
|
if Start^ = '"' then
|
|
begin
|
|
Li := Items.Add;
|
|
TmpStr := AnsiExtractQuotedStr(Start, '"'); // this moves the PChar pointer
|
|
Li.Caption := TmpStr;
|
|
end
|
|
else
|
|
begin
|
|
TmpStart := Start;
|
|
while Start^ <> Separator do
|
|
begin
|
|
if Start = Stop then
|
|
Break;
|
|
Inc(Start);
|
|
end;
|
|
SetString(TmpStr, TmpStart, Start - TmpStart);
|
|
Li := Items.Add;
|
|
Li.Caption := TmpStr;
|
|
end;
|
|
end;
|
|
if Li <> nil then
|
|
begin
|
|
while (Start <> Stop) and (Start <> nil) and (Start^ <> #0) do
|
|
begin
|
|
while Start^ = Separator do
|
|
Inc(Start);
|
|
if Start^ = '"' then
|
|
begin
|
|
TmpStr := AnsiExtractQuotedStr(Start, '"'); // this moves the PChar pointer
|
|
Li.SubItems.Add(TmpStr);
|
|
end
|
|
else
|
|
begin
|
|
TmpStart := Start;
|
|
while Start^ <> Separator do
|
|
begin
|
|
if Start = Stop then
|
|
Break;
|
|
Inc(Start);
|
|
end;
|
|
SetString(TmpStr, TmpStart, Start - TmpStart);
|
|
Li.SubItems.Add(TmpStr);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvListView.LoadFromCSV(FileName: string; Separator: Char);
|
|
var
|
|
S: TStringList;
|
|
begin
|
|
S := TStringList.Create;
|
|
Items.BeginUpdate;
|
|
try
|
|
Items.Clear;
|
|
S.LoadFromFile(FileName);
|
|
LoadFromStrings(S, Separator);
|
|
finally
|
|
Items.EndUpdate;
|
|
S.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvListView.SaveToCSV(FileName: string; Separator: Char);
|
|
var
|
|
S: TStringList;
|
|
begin
|
|
S := TStringList.Create;
|
|
Items.BeginUpdate;
|
|
try
|
|
SaveToStrings(S, Separator);
|
|
S.SaveToFile(FileName);
|
|
finally
|
|
Items.EndUpdate;
|
|
S.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvListView.InvertSelection;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Items.BeginUpdate;
|
|
for I := 0 to Items.Count - 1 do
|
|
Items[I].Selected := not Items[I].Selected;
|
|
Items.EndUpdate;
|
|
end;
|
|
|
|
{$IFDEF COMPILER5}
|
|
procedure TJvListView.SelectAll;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Items.BeginUpdate;
|
|
for I := 0 to Items.Count - 1 do
|
|
Items[I].Selected := True;
|
|
Items.EndUpdate;
|
|
end;
|
|
{$ENDIF COMPILER5}
|
|
|
|
procedure TJvListView.UnselectAll;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Items.BeginUpdate;
|
|
for I := 0 to Items.Count - 1 do
|
|
Items[I].Selected := False;
|
|
Items.EndUpdate;
|
|
end;
|
|
|
|
procedure TJvListView.KeyUp(var Key: Word; Shift: TShiftState);
|
|
var
|
|
st: string;
|
|
I, J: Integer;
|
|
begin
|
|
inherited KeyUp(Key, Shift);
|
|
if AutoClipboardCopy then
|
|
if (Key in [Ord('c'), Ord('C')]) and (ssCtrl in Shift) then
|
|
begin
|
|
for I := 0 to Columns.Count - 1 do
|
|
st := st + Columns[I].Caption + Tab;
|
|
if st <> '' then
|
|
st := st + sLineBreak;
|
|
for I := 0 to Items.Count - 1 do
|
|
if (SelCount = 0) or Items[I].Selected then
|
|
begin
|
|
st := st + Items[I].Caption;
|
|
for J := 0 to Items[I].SubItems.Count - 1 do
|
|
st := st + Tab + Items[I].SubItems[J];
|
|
st := st + sLineBreak;
|
|
end;
|
|
Clipboard.SetTextBuf(PChar(st));
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF COMPILER5}
|
|
procedure TJvListView.DeleteSelected;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Items.BeginUpdate;
|
|
if SelCount = 1 then
|
|
begin
|
|
I := Selected.Index - 1;
|
|
Selected.Delete;
|
|
if I = -1 then
|
|
I := 0;
|
|
if Items.Count > 0 then
|
|
Selected := Items[I];
|
|
end
|
|
else
|
|
for I := Items.Count - 1 downto 0 do
|
|
if Items[I].Selected then
|
|
Items[I].Delete;
|
|
Items.EndUpdate;
|
|
end;
|
|
{$ENDIF COMPILER5}
|
|
|
|
function TJvListView.GetColumnsOrder: string;
|
|
var
|
|
Res: array [0..cColumnsHandled - 1] of Integer;
|
|
I: Integer;
|
|
begin
|
|
ListView_GetColumnOrderArray(Columns.Owner.Handle, Columns.Count, @Res[0]);
|
|
Result := '';
|
|
if Columns.Count > cColumnsHandled then
|
|
raise EJvListViewError.CreateRes(@RsETooManyColumns);
|
|
for I := 0 to Columns.Count - 1 do
|
|
begin
|
|
if Result <> '' then
|
|
Result := Result + ',';
|
|
Result := Result + IntToStr(Res[I]) + '=' + IntToStr(Columns[I].Width);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvListView.SetColumnsOrder(const Order: string);
|
|
var
|
|
Res: array [0..cColumnsHandled - 1] of Integer;
|
|
I, J: Integer;
|
|
st: string;
|
|
begin
|
|
FillChar(Res, SizeOf(Res), #0);
|
|
with TStringList.Create do
|
|
try
|
|
CommaText := Order;
|
|
I := 0;
|
|
while Count > 0 do
|
|
begin
|
|
st := Strings[0];
|
|
J := Pos('=', st);
|
|
if (J <> 0) and (I < Columns.Count) then
|
|
begin
|
|
Columns[I].Width := StrToIntDef(Copy(st, J + 1, Length(st)), Columns[I].Width);
|
|
st := Copy(st, 1, J - 1);
|
|
end;
|
|
Res[I] := StrToIntDef(st, 0);
|
|
Delete(0);
|
|
Inc(I);
|
|
end;
|
|
ListView_SetColumnOrderArray(Columns.Owner.Handle, Columns.Count, @Res[0]);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvListView.SetHeaderImages(const Value: TCustomImageList);
|
|
begin
|
|
if FHeaderImages <> Value then
|
|
begin
|
|
if FHeaderImages <> nil then
|
|
FHeaderImages.UnRegisterChanges(FImageChangeLink);
|
|
FHeaderImages := Value;
|
|
if Assigned(FHeaderImages) then
|
|
begin
|
|
FHeaderImages.RegisterChanges(FImageChangeLink);
|
|
FHeaderImages.FreeNotification(Self);
|
|
end;
|
|
UpdateHeaderImages(ListView_GetHeader(Handle));
|
|
end;
|
|
end;
|
|
|
|
procedure TJvListView.SetExtendedColumns(
|
|
const Value: TJvListExtendedColumns);
|
|
begin
|
|
FExtendedColumns.Assign(Value);
|
|
end;
|
|
|
|
procedure TJvListView.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if Operation = opRemove then
|
|
if AComponent = HeaderImages then
|
|
HeaderImages := nil
|
|
else
|
|
if not (csDestroying in ComponentState) and (AComponent is TPopupMenu) then
|
|
for I := 0 to Items.Count - 1 do
|
|
if TJvListItem(Items[I]).PopupMenu = AComponent then
|
|
TJvListItem(Items[I]).PopupMenu := nil;
|
|
end;
|
|
|
|
procedure TJvListView.CreateWnd;
|
|
begin
|
|
inherited CreateWnd;
|
|
UpdateHeaderImages(ListView_GetHeader(Handle));
|
|
if FSavedExtendedColumns.Count > 0 then
|
|
FExtendedColumns.Assign(FSavedExtendedColumns);
|
|
|
|
// Get the values from the newly created list view
|
|
LoadTileViewProperties;
|
|
LoadGroupsProperties;
|
|
FInsertMarkColor := SendMessage(Handle, LVM_GETINSERTMARKCOLOR, 0, 0);
|
|
|
|
// Force a change from True to False so that InsertMarks work correctly.
|
|
SendMessage(Handle, LVM_ENABLEGROUPVIEW, Integer(not FGroupView), 0);
|
|
SendMessage(Handle, LVM_ENABLEGROUPVIEW, Integer(FGroupView), 0);
|
|
end;
|
|
|
|
procedure TJvListView.UpdateHeaderImages(HeaderHandle: Integer);
|
|
//var
|
|
// WP: TWindowPlacement;
|
|
begin
|
|
if (HeaderHandle <> 0) and (ViewStyle = vsReport) and ShowColumnHeaders then
|
|
begin
|
|
// WP.length := SizeOf(WP);
|
|
// GetWindowPlacement(HeaderHandle, @WP);
|
|
if HeaderImages <> nil then
|
|
begin
|
|
Header_SetImageList(HeaderHandle, HeaderImages.Handle);
|
|
// WP.rcNormalPosition.Bottom := WP.rcNormalPosition.Top + HeaderImages.Height + 3;
|
|
end
|
|
else
|
|
if ComponentState * [csLoading, csDestroying] = [] then
|
|
begin
|
|
Header_SetImageList(HeaderHandle, 0);
|
|
// WP.rcNormalPosition.Bottom := WP.rcNormalPosition.Top + 17;
|
|
end;
|
|
// the problem with resizing the header is that there doesn't seem to be an easy way of telling the listview about it...
|
|
// SetWindowPlacement(HeaderHandle, @WP);
|
|
UpdateColumns;
|
|
Windows.InvalidateRect(HeaderHandle, nil, True)
|
|
end;
|
|
end;
|
|
|
|
procedure TJvListView.DoHeaderImagesChange(Sender: TObject);
|
|
begin
|
|
UpdateHeaderImages(ListView_GetHeader(Handle));
|
|
end;
|
|
|
|
procedure TJvListView.SetSmallImages(const Value: TCustomImageList);
|
|
begin
|
|
inherited SmallImages := Value;
|
|
UpdateHeaderImages(ListView_GetHeader(Handle));
|
|
end;
|
|
|
|
procedure TJvListView.Loaded;
|
|
begin
|
|
inherited Loaded;
|
|
UpdateHeaderImages(ListView_GetHeader(Handle));
|
|
TileViewProperties.DoChange;
|
|
end;
|
|
|
|
procedure TJvListView.WMNCCalcSize(var Msg: TWMNCCalcSize);
|
|
//var
|
|
// R: TRect;
|
|
begin
|
|
inherited;
|
|
// if Msg.CalcValidRects and Assigned(HeaderImages) and (ViewStyle = vsReport) and ShowColumnHeaders then
|
|
// with Msg.CalcSize_Params^.rgrc[0] do
|
|
// Top := Top + HeaderImages.Height + 3;
|
|
end;
|
|
|
|
procedure TJvListView.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
|
|
begin
|
|
inherited SetBounds(ALeft, ATop, AWidth, AHeight);
|
|
if HandleAllocated then
|
|
UpdateHeaderImages(ListView_GetHeader(Handle));
|
|
end;
|
|
|
|
procedure TJvListView.InsertItem(Item: TListItem);
|
|
begin
|
|
inherited InsertItem(Item);
|
|
if AutoSelect and (Selected = nil) and (Items.Count < 2) then
|
|
PostMessage(Handle, WM_AUTOSELECT, Integer(Item), 1);
|
|
end;
|
|
|
|
procedure TJvListView.WMAutoSelect(var Msg: TMessage);
|
|
var
|
|
lv: TListItem;
|
|
begin
|
|
with Msg do
|
|
begin
|
|
lv := TListItem(WParam);
|
|
if Assigned(lv) and (Items.IndexOf(lv) >= 0) and (LParam = 1) then
|
|
begin
|
|
lv.Selected := True;
|
|
lv.Focused := True;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TJvListView.MoveDown(Index: Integer; Focus: Boolean = True): Integer;
|
|
var
|
|
lv, lv2: TListItem;
|
|
FOnInsert, FOnDeletion: TLVDeletedEvent;
|
|
FOnCompare: TLVCompareEvent;
|
|
begin
|
|
Result := Index;
|
|
if (Index >= 0) and (Index < Items.Count) then
|
|
begin
|
|
lv2 := Items[Index];
|
|
FOnInsert := OnInsert;
|
|
FOnDeletion := OnDeletion;
|
|
FOnCompare := OnCompare;
|
|
try
|
|
OnInsert := nil;
|
|
OnDeletion := nil;
|
|
OnCompare := nil;
|
|
lv := Items.Insert(Index + 2);
|
|
lv.Assign(lv2);
|
|
lv2.Delete;
|
|
finally
|
|
OnInsert := FOnInsert;
|
|
OnDeletion := FOnDeletion;
|
|
OnCompare := FOnCompare;
|
|
end;
|
|
if Focus then
|
|
begin
|
|
lv.Selected := True;
|
|
lv.Focused := True;
|
|
end;
|
|
Result := lv.Index;
|
|
end;
|
|
end;
|
|
|
|
function TJvListView.MoveUp(Index: Integer; Focus: Boolean = True): Integer;
|
|
var
|
|
lv, lv2: TListItem;
|
|
FOnInsert, FOnDeletion: TLVDeletedEvent;
|
|
FOnCompare: TLVCompareEvent;
|
|
begin
|
|
Result := Index;
|
|
if (Index > 0) and (Index < Items.Count) then
|
|
begin
|
|
lv2 := Items[Index];
|
|
FOnInsert := OnInsert;
|
|
FOnDeletion := OnDeletion;
|
|
FOnCompare := OnCompare;
|
|
try
|
|
OnInsert := nil;
|
|
OnDeletion := nil;
|
|
OnCompare := nil;
|
|
lv := Items.Insert(Index - 1);
|
|
lv.Assign(lv2);
|
|
lv2.Delete;
|
|
finally
|
|
OnInsert := FOnInsert;
|
|
OnDeletion := FOnDeletion;
|
|
OnCompare := FOnCompare;
|
|
end;
|
|
if Focus then
|
|
begin
|
|
lv.Selected := True;
|
|
lv.Focused := True;
|
|
end;
|
|
Result := lv.Index;
|
|
end;
|
|
end;
|
|
|
|
function TJvListView.SelectNextItem(Focus: Boolean = True): Integer;
|
|
begin
|
|
Result := ItemIndex + 1;
|
|
if Result < Items.Count then
|
|
ItemIndex := Result;
|
|
Result := ItemIndex;
|
|
if Focus and (Result >= 0) and (Result < Items.Count) then
|
|
begin
|
|
Items[Result].Selected := True;
|
|
Items[Result].Focused := True;
|
|
end;
|
|
end;
|
|
|
|
function TJvListView.SelectPrevItem(Focus: Boolean = True): Integer;
|
|
begin
|
|
Result := ItemIndex - 1;
|
|
if Result >= 0 then
|
|
ItemIndex := Result;
|
|
Result := ItemIndex;
|
|
if Focus and (Result >= 0) and (Result < Items.Count) then
|
|
begin
|
|
Items[Result].Selected := True;
|
|
Items[Result].Focused := True;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvListView.SetFocus;
|
|
var
|
|
Index: Integer;
|
|
begin
|
|
inherited SetFocus;
|
|
|
|
Index := 0;
|
|
if Assigned(ItemFocused) then
|
|
Index := ItemIndex;
|
|
|
|
if AutoSelect and (Selected = nil) and (Items.Count > 0) then
|
|
PostMessage(Handle, WM_AUTOSELECT, Integer(Items[Index]), 1);
|
|
end;
|
|
|
|
function TJvListView.ShowInsertMark(ItemIndex: Integer; Position: TJvInsertMarkPosition): Boolean;
|
|
var
|
|
Infos: TLVINSERTMARK;
|
|
begin
|
|
ZeroMemory(@Infos, SizeOf(Infos));
|
|
|
|
Infos.cbSize := SizeOf(Infos);
|
|
Infos.dwFlags := InsertMarkPositionToLVIM[Position];
|
|
Infos.iItem := ItemIndex;
|
|
|
|
Result := Bool(SendMessage(Handle, LVM_SETINSERTMARK, 0, LPARAM(@Infos)));
|
|
end;
|
|
|
|
function TJvListView.HideInsertMark: Boolean;
|
|
begin
|
|
Result := ShowInsertMark(-1, impBefore);
|
|
end;
|
|
|
|
function TJvListView.GetInsertMarkPosition(const X, Y: Integer;
|
|
var ItemIndex: Integer; var Position: TJvInsertMarkPosition): Boolean;
|
|
var
|
|
Infos: TLVINSERTMARK;
|
|
Point: TPoint;
|
|
begin
|
|
Point.X := X;
|
|
Point.Y := Y;
|
|
|
|
ZeroMemory(@Infos, SizeOf(Infos));
|
|
|
|
Infos.cbSize := SizeOf(Infos);
|
|
Result := Bool(SendMessage(Handle, LVM_INSERTMARKHITTEST, WPARAM(@Point), LPARAM(@Infos)));
|
|
if Result then
|
|
begin
|
|
ItemIndex := Infos.iItem;
|
|
if (Infos.dwFlags and LVIM_AFTER) = LVIM_AFTER then
|
|
Position := impAfter
|
|
else
|
|
Position := impBefore;
|
|
end;
|
|
end;
|
|
|
|
function TJvListView.IsCustomDrawn(Target: TCustomDrawTarget; Stage: TCustomDrawStage): Boolean;
|
|
begin
|
|
{ We must custom draw both cdPrePaint and cdPostPaint because without the
|
|
cdPostPaint the TListView creates GDI fonts without releasing them. }
|
|
Result := inherited IsCustomDrawn(Target, Stage) or
|
|
((Stage in [cdPrePaint, cdPostPaint]) and (Picture.Graphic <> nil) and not Picture.Graphic.Empty) or
|
|
((Stage in [cdPrePaint, cdPostPaint]) and ((Target = dtItem) or (Target = dtSubItem)));
|
|
end;
|
|
|
|
|
|
function TJvListView.CustomDraw(const ARect: TRect; Stage: TCustomDrawStage): Boolean;
|
|
var
|
|
BmpXPos, BmpYPos: Integer; // X and Y position for bitmap
|
|
ItemRect: TRect; // List item bounds rectangle
|
|
TopOffset: Integer; // Y pos where bmp drawing starts
|
|
Bmp: TBitmap;
|
|
|
|
function GetHeaderHeight: Integer;
|
|
var
|
|
Header: HWND; // header window handle
|
|
Pl: TWindowPlacement; // header window placement
|
|
begin
|
|
// Get header window
|
|
Header := SendMessage(Handle, LVM_GETHEADER, 0, 0);
|
|
// Get header window placement
|
|
FillChar(Pl, SizeOf(Pl), 0);
|
|
Pl.length := SizeOf(Pl);
|
|
GetWindowPlacement(Header, @Pl);
|
|
// Calculate header window height
|
|
Result := Pl.rcNormalPosition.Bottom - Pl.rcNormalPosition.Top;
|
|
end;
|
|
|
|
begin
|
|
Result := inherited CustomDraw(ARect, Stage);
|
|
if Result and (Stage = cdPrePaint) and (FPicture <> nil) and (FPicture.Graphic <> nil) and not
|
|
FPicture.Graphic.Empty and (FPicture.Graphic.Width > 0) and (FPicture.Graphic.Height > 0) then
|
|
begin
|
|
Bmp := TBitmap.Create;
|
|
try
|
|
Bmp.Width := ClientWidth;
|
|
Bmp.Height := ClientHeight;
|
|
Bmp.Canvas.Brush.Color := Self.Color;
|
|
Bmp.Canvas.FillRect(ClientRect);
|
|
|
|
// Get top offset where drawing starts
|
|
if Items.Count > 0 then
|
|
begin
|
|
ListView_GetItemRect(Handle, 0, ItemRect, LVIR_BOUNDS);
|
|
TopOffset := ListView_GetTopIndex(Handle) * (ItemRect.Bottom - ItemRect.Top);
|
|
end
|
|
else
|
|
TopOffset := 0;
|
|
if ViewStyle = vsReport then
|
|
BmpYPos := ARect.Top - TopOffset + GetHeaderHeight
|
|
else
|
|
BmpYPos := 0;
|
|
// Draw the image
|
|
while BmpYPos < ARect.Bottom do
|
|
begin
|
|
// draw image across width of display
|
|
BmpXPos := ARect.Left;
|
|
while BmpXPos < ARect.Right do
|
|
begin
|
|
// DrawIconEx draws alpha-blended icons better (on XP) but gives problems with selecting in the listview
|
|
// if Picture.Graphic is TIcon then
|
|
// DrawIconEx(Canvas.Handle, BmpXPos, BmpYPos, Picture.Icon.Handle, 0, 0, 0, 0, DI_NORMAL)
|
|
// else
|
|
Bmp.Canvas.Draw(BmpXPos, BmpYPos, Picture.Graphic);
|
|
Inc(BmpXPos, Picture.Graphic.Width);
|
|
end;
|
|
// move to next row
|
|
Inc(BmpYPos, Picture.Graphic.Height);
|
|
end;
|
|
BitBlt(Canvas, 0, 0, ClientWidth, ClientHeight, Bmp.Canvas, 0, 0, SRCCOPY);
|
|
// Ensure that the items are drawn transparently
|
|
SetBkMode(Canvas.Handle, TRANSPARENT);
|
|
ListView_SetTextBkColor(Handle, CLR_NONE);
|
|
ListView_SetBKColor(Handle, CLR_NONE);
|
|
finally
|
|
Bmp.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TJvListView.CustomDrawItem(Item: TListItem;
|
|
State: TCustomDrawState; Stage: TCustomDrawStage): Boolean;
|
|
begin
|
|
if (Stage = cdPrePaint) and Assigned(Item) then
|
|
begin
|
|
Canvas.Font := TJvListItem(Item).Font;
|
|
if ViewStyle in ViewStylesItemBrush then
|
|
begin
|
|
if Win32MajorVersion >= 6 then
|
|
SetBkMode(Canvas.Handle, TRANSPARENT);
|
|
Canvas.Brush := TJvListItem(Item).Brush;
|
|
end;
|
|
Canvas.Handle;
|
|
end;
|
|
|
|
Result := inherited CustomDrawItem(Item, State, Stage);
|
|
end;
|
|
|
|
|
|
procedure TJvListView.CNNotify(var Message: TWMNotify);
|
|
begin
|
|
with Message do
|
|
begin
|
|
if NMHdr^.code = NM_CUSTOMDRAW then
|
|
begin
|
|
with PNMCustomDraw(NMHdr)^ do
|
|
begin
|
|
if (dwDrawStage and CDDS_SUBITEM <> 0) and
|
|
(PNMLVCustomDraw(NMHdr)^.iSubItem = 0) then
|
|
begin
|
|
// Mantis 3908: For some reason, the inherited handler will not call
|
|
// the CustomDrawSubItem if iSubItem is equal to zero. But not calling
|
|
// it has the consequence to trigger wrong rendering if the order of
|
|
// columns is modified and the list item has a non standard font.
|
|
// Calling it ourselves here is not enough as the inherited handler
|
|
// does some very specific management with the canvas. So we must
|
|
// trick it by changing the value to a recognizable value used
|
|
// in our CustomDrawSubItem handler.
|
|
PNMLVCustomDraw(NMHdr)^.iSubItem := -1;
|
|
inherited;
|
|
PNMLVCustomDraw(NMHdr)^.iSubItem := 0;
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
function TJvListView.CustomDrawSubItem(Item: TListItem; SubItem: Integer;
|
|
State: TCustomDrawState; Stage: TCustomDrawStage): Boolean;
|
|
begin
|
|
if SubItem = -1 then // See above
|
|
SubItem := 0;
|
|
|
|
if {(Stage = cdPrePaint) and} Assigned(Item) then
|
|
begin
|
|
Canvas.Font := TJvListItem(Item).Font;
|
|
if ViewStyle in ViewStylesItemBrush then
|
|
Canvas.Brush := TJvListItem(Item).Brush;
|
|
end;
|
|
|
|
Result := inherited CustomDrawSubItem(Item, SubItem, State, Stage);
|
|
end;
|
|
|
|
procedure TJvListView.SetPicture(const Value: TPicture);
|
|
begin
|
|
FPicture.Assign(Value);
|
|
end;
|
|
|
|
procedure TJvListView.SetGroupView(const Value: Boolean);
|
|
begin
|
|
if FGroupView <> Value then
|
|
begin
|
|
FGroupView := Value;
|
|
|
|
SendMessage(Handle, LVM_ENABLEGROUPVIEW, Integer(FGroupView), 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvListView.SetGroups(const Value: TJvListViewGroups);
|
|
begin
|
|
FGroups.Assign(Value);
|
|
end;
|
|
|
|
procedure TJvListView.SetGroupsProperties(const Value: TJvGroupsProperties);
|
|
begin
|
|
FGroupsProperties.Assign(Value);
|
|
end;
|
|
|
|
procedure TJvListView.SetTileViewProperties(const Value: TJvTileViewProperties);
|
|
begin
|
|
FTileViewProperties.Assign(Value);
|
|
end;
|
|
|
|
procedure TJvListView.SetInsertMarkColor(const Value: TColor);
|
|
begin
|
|
if FInsertMarkColor <> Value then
|
|
begin
|
|
FInsertMarkColor := Value;
|
|
|
|
SendMessage(Handle, LVM_SETINSERTMARKCOLOR, 0, ColorToRGB(FInsertMarkColor));
|
|
end;
|
|
end;
|
|
|
|
procedure TJvListView.SetHeaderImagePosition(const Value: TJvHeaderImagePosition);
|
|
begin
|
|
if FHeaderImagePosition <> Value then
|
|
begin
|
|
FHeaderImagePosition := Value;
|
|
UpdateHeaderImages(ListView_GetHeader(Handle));
|
|
end;
|
|
end;
|
|
|
|
procedure TJvListView.DoPictureChange(Sender: TObject);
|
|
begin
|
|
// if (Picture.Graphic <> nil) and not Picture.Graphic.Empty then
|
|
// Picture.Graphic.Transparent := true;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TJvListView.LVMDeleteColumn(var Msg: TMessage);
|
|
begin
|
|
inherited;
|
|
// This may happen at design time, especially when migrating
|
|
// a project that uses an old version of TJvListView that did
|
|
// not have the ExtendedColumns
|
|
if Msg.WParam < FExtendedColumns.Count then
|
|
FExtendedColumns.Delete(Msg.WParam);
|
|
end;
|
|
|
|
procedure TJvListView.LVMInsertColumn(var Msg: TMessage);
|
|
begin
|
|
inherited;
|
|
FExtendedColumns.Insert(Msg.WParam);
|
|
end;
|
|
|
|
procedure TJvListView.LVMSetColumn(var Msg: TMessage);
|
|
var
|
|
i: Integer;
|
|
Column: tagLVCOLUMN;
|
|
begin
|
|
inherited;
|
|
|
|
if not FSettingHeaderImagePosition then
|
|
begin
|
|
for i := 0 to ExtendedColumns.Count - 1 do
|
|
begin
|
|
if ExtendedColumns[i].GetHeaderImagePosition = hipRight then
|
|
begin
|
|
Column.mask := LVCF_FMT;
|
|
ListView_GetColumn(Handle, i, Column);
|
|
if Column.fmt and LVCFMT_IMAGE <> 0 then
|
|
begin
|
|
Column.fmt := Column.fmt or LVCFMT_BITMAP_ON_RIGHT;
|
|
FSettingHeaderImagePosition := True;
|
|
try
|
|
ListView_SetColumn(Handle, i, Column);
|
|
finally
|
|
FSettingHeaderImagePosition := False;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvListView.DestroyWnd;
|
|
begin
|
|
FSavedExtendedColumns.Assign(FExtendedColumns);
|
|
inherited DestroyWnd;
|
|
end;
|
|
{$IFDEF COMPILER5}
|
|
|
|
function TJvListView.GetItemIndex: Integer;
|
|
begin
|
|
if Selected <> nil then
|
|
Result := Selected.Index
|
|
else
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TJvListView.SetItemIndex(const Value: Integer);
|
|
begin
|
|
if (Value >= 0) and (Value < Items.Count) then
|
|
Items[Value].Selected := True;
|
|
end;
|
|
|
|
{$ENDIF COMPILER5}
|
|
|
|
procedure TJvListView.SetViewStylesItemBrush(const Value: TJvViewStyles);
|
|
begin
|
|
FViewStylesItemBrush := Value;
|
|
Invalidate;
|
|
end;
|
|
|
|
{$IFDEF COMPILER6_UP}
|
|
procedure TJvListView.SetViewStyle(Value: TViewStyle);
|
|
begin
|
|
// If someone is setting the view style via an ancestor class reference,
|
|
// we force it to be set through our setter. But if it's set via our setter
|
|
// then we inform the ancestor class' code so that display is updated.
|
|
if not FSettingJvViewStyle then
|
|
SetJvViewStyle(TJvViewStyle(Value))
|
|
else
|
|
inherited SetViewStyle(Value);
|
|
end;
|
|
{$ENDIF COMPILER6_UP}
|
|
|
|
procedure TJvListView.SetJvViewStyle(Value: TJvViewStyle);
|
|
begin
|
|
if Value <> FViewStyle then
|
|
begin
|
|
FSettingJvViewStyle := True;
|
|
try
|
|
FViewStyle := Value;
|
|
if Value = vsTile then
|
|
begin
|
|
if HandleAllocated then
|
|
begin
|
|
SendMessage(Handle, LVM_SETVIEW, LV_VIEW_TILE, 0);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
inherited ViewStyle := TViewStyle(Value);
|
|
end;
|
|
finally
|
|
FSettingJvViewStyle := False;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TJvListView.DoCompareGroups(Group1, Group2: TJvListViewGroup): Integer;
|
|
begin
|
|
if Assigned(OnCompareGroups) then
|
|
OnCompareGroups(Self, Group1, Group2, Result)
|
|
else
|
|
Result := Group2.GroupId - Group1.GroupId;
|
|
end;
|
|
|
|
procedure TJvListView.TileViewPropertiesChange(Sender: TObject);
|
|
var
|
|
Infos: TLVTILEVIEWINFO;
|
|
begin
|
|
if not (csLoading in ComponentState) then
|
|
begin
|
|
Infos.cbSize := SizeOf(Infos);
|
|
Infos.dwMask := LVTVIM_TILESIZE or LVTVIM_COLUMNS or LVTVIM_LABELMARGIN;
|
|
Infos.dwFlags := TileSizeKindToLVTVIF[TileViewProperties.TileSizeKind];
|
|
TileViewProperties.TileSize.CopyToSize(Infos.sizeTile);
|
|
infos.cLines := TileViewProperties.SubLinesCount;
|
|
TileViewProperties.LabelMargin.CopyToRect(infos.rcLabelMargin);
|
|
|
|
SendMessage(Handle, LVM_SETTILEVIEWINFO, 0, LPARAM(@Infos));
|
|
end;
|
|
end;
|
|
|
|
procedure TJvListView.GroupsPropertiesChange(Sender: TObject);
|
|
var
|
|
Infos: TLVGROUPMETRICS;
|
|
begin
|
|
if not (csLoading in ComponentState) then
|
|
begin
|
|
ZeroMemory(@Infos, SizeOf(Infos));
|
|
|
|
Infos.cbSize := SizeOf(Infos);
|
|
Infos.mask := LVGMF_BORDERSIZE or LVGMF_BORDERCOLOR or LVGMF_TEXTCOLOR;
|
|
Infos.Top := GroupsProperties.BorderSize.Top;
|
|
Infos.Left := GroupsProperties.BorderSize.Left;
|
|
Infos.Bottom := GroupsProperties.BorderSize.Bottom;
|
|
Infos.Right := GroupsProperties.BorderSize.Right;
|
|
Infos.crTop := GroupsProperties.BorderColor.Top;
|
|
Infos.crLeft := GroupsProperties.BorderColor.Left;
|
|
Infos.crBottom := GroupsProperties.BorderColor.Bottom;
|
|
Infos.crRight := GroupsProperties.BorderColor.Right;
|
|
Infos.crHeader := GroupsProperties.HeaderColor;
|
|
|
|
SendMessage(Handle, LVM_SETGROUPMETRICS, 0, LPARAM(@Infos));
|
|
end;
|
|
end;
|
|
|
|
procedure TJvListView.LoadTileViewProperties;
|
|
begin
|
|
TileViewProperties.LoadFromList(Self);
|
|
end;
|
|
|
|
procedure TJvListView.LoadGroupsProperties;
|
|
begin
|
|
GroupsProperties.LoadFromList(Self);
|
|
end;
|
|
|
|
{ TJvListViewGroup }
|
|
|
|
procedure TJvListViewGroup.Assign(AValue: TPersistent);
|
|
var
|
|
Source: TJvListViewGroup;
|
|
begin
|
|
if AValue is TJvListViewGroup then
|
|
begin
|
|
Source := AValue as TJvListViewGroup;
|
|
|
|
FHeader := Source.Header;
|
|
FHeaderAlignment := Source.HeaderAlignment;
|
|
FGroupId := Source.GroupId;
|
|
UpdateGroupProperties;
|
|
end;
|
|
end;
|
|
|
|
constructor TJvListViewGroup.Create(Collection: Classes.TCollection);
|
|
begin
|
|
// Before inherited for Notify to acces it
|
|
FGroupId := -1;
|
|
FHeaderAlignment := taLeftJustify;
|
|
FHeader := 'Group';
|
|
|
|
inherited Create(Collection);
|
|
end;
|
|
|
|
destructor TJvListViewGroup.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJvListViewGroup.SetHeader(const Value: WideString);
|
|
var
|
|
SavedGroupId: Integer;
|
|
begin
|
|
if FHeader <> Value then
|
|
begin
|
|
FHeader := Value;
|
|
|
|
// Due to a undocumented bug/feature in the list view, one has to change
|
|
// the GroupId as well when changing the caption or the modification is
|
|
// not taken into account.
|
|
SavedGroupId := GroupId;
|
|
UpdateGroupProperties(MaxInt);
|
|
FGroupId := MaxInt;
|
|
UpdateGroupProperties(SavedGroupId);
|
|
FGroupId := SavedGroupId;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvListViewGroup.SetHeaderAlignment(const Value: TAlignment);
|
|
begin
|
|
if FHeaderAlignment <> Value then
|
|
begin
|
|
FHeaderAlignment := Value;
|
|
UpdateGroupProperties;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvListViewGroup.SetLVGROUP(var GroupInfo: TLVGROUP);
|
|
begin
|
|
ZeroMemory(@GroupInfo, sizeof(GroupInfo));
|
|
|
|
GroupInfo.cbSize := sizeof(GroupInfo);
|
|
GroupInfo.mask := LVGF_HEADER or LVGF_ALIGN or LVGF_GROUPID;
|
|
GroupInfo.iGroupId := FGroupId;
|
|
GroupInfo.pszHeader := PWideChar(FHeader);
|
|
GroupInfo.cchHeader := Length(FHeader);
|
|
GroupInfo.uAlign := AlignmentToLVGA[HeaderAlignment];
|
|
end;
|
|
|
|
procedure TJvListViewGroup.SetGroupId(const Value: Integer);
|
|
begin
|
|
if FGroupId <> Value then
|
|
begin
|
|
UpdateGroupProperties(Value);
|
|
FGroupId := Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvListViewGroup.UpdateGroupProperties(const NewGroupId: Integer = -1);
|
|
var
|
|
GroupInfo: TLVGROUP;
|
|
List: TJvListView;
|
|
begin
|
|
List := (Collection as TJvListViewGroups).ParentList;
|
|
if Assigned(List) then
|
|
begin
|
|
SetLVGROUP(GroupInfo);
|
|
if NewGroupId <> -1 then
|
|
GroupInfo.iGroupId := NewGroupId;
|
|
SendMessage(List.Handle, LVM_SETGROUPINFO, FGroupId, LPARAM(@GroupInfo));
|
|
List.Invalidate;
|
|
end;
|
|
end;
|
|
|
|
{ TJvListViewGroups }
|
|
|
|
function TJvListViewGroups.Compare(Id1, Id2: Integer): Integer;
|
|
var
|
|
List: TJvListView;
|
|
begin
|
|
Result := Id2 - Id1;
|
|
List := ParentList;
|
|
if Assigned(List) then
|
|
begin
|
|
Result := List.DoCompareGroups(ItemsById[Id1], ItemsById[Id2]);
|
|
end;
|
|
end;
|
|
|
|
constructor TJvListViewGroups.Create(AOwner: TPersistent);
|
|
begin
|
|
inherited Create(AOwner, TJvListViewGroup);
|
|
end;
|
|
|
|
function TJvListViewGroups.GetItem(Index: Integer): TJvListViewGroup;
|
|
begin
|
|
Result := inherited Items[Index] as TJvListViewGroup;
|
|
end;
|
|
|
|
function TJvListViewGroups.GetItemById(GroupId: Integer): TJvListViewGroup;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := nil;
|
|
I := 0;
|
|
while (I < Count) and not Assigned(Result) do
|
|
begin
|
|
if Items[I].GroupId = GroupId then
|
|
Result := Items[I];
|
|
Inc(I);
|
|
end;
|
|
end;
|
|
|
|
function LVGroupCompare(Group1_ID: Integer; Group2_ID: Integer; pvData: Pointer): Integer; stdcall;
|
|
begin
|
|
Result := TJvListViewGroups(pvData).Compare(Group1_ID, Group2_ID);
|
|
end;
|
|
|
|
procedure TJvListViewGroups.InsertGroupIntoList(group: TJvListViewGroup);
|
|
var
|
|
List: TJvListView;
|
|
GroupInfo: TLVGROUP;
|
|
GroupSortedInfo: TLVINSERTGROUPSORTED;
|
|
begin
|
|
List := ParentList;
|
|
if Assigned(List) then
|
|
begin
|
|
if group.GroupId = -1 then
|
|
group.FGroupId := Count;
|
|
if Sorted then
|
|
begin
|
|
GroupSortedInfo.pfnGroupCompare := @LVGroupCompare;
|
|
GroupSortedInfo.pvData := Self;
|
|
group.SetLVGROUP(GroupSortedInfo.lvGroup);
|
|
SendMessage(List.Handle, LVM_INSERTGROUPSORTED, WPARAM(@GroupSortedInfo), 0);
|
|
end
|
|
else
|
|
begin
|
|
group.SetLVGROUP(GroupInfo);
|
|
SendMessage(List.Handle, LVM_INSERTGROUP, group.Index, LPARAM(@GroupInfo));
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvListViewGroups.Notify(Item: TCollectionItem;
|
|
Action: TCollectionNotification);
|
|
begin
|
|
case Action of
|
|
cnAdded:
|
|
InsertGroupIntoList(Item as TJvListViewGroup);
|
|
cnDeleting:
|
|
RemoveGroupFromList(Item as TJvListViewGroup);
|
|
end;
|
|
end;
|
|
|
|
function TJvListViewGroups.ParentList: TJvListView;
|
|
var
|
|
Owner: TPersistent;
|
|
begin
|
|
Result := nil;
|
|
Owner := GetOwner;
|
|
if Owner is TJvListView then
|
|
Result := Owner as TJvListView;
|
|
end;
|
|
|
|
procedure TJvListViewGroups.RemoveGroupFromList(group: TJvListViewGroup);
|
|
var
|
|
List: TJvListView;
|
|
begin
|
|
List := ParentList;
|
|
if Assigned(List) then
|
|
begin
|
|
SendMessage(List.Handle, LVM_REMOVEGROUP, group.GroupId, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvListViewGroups.SetItem(Index: Integer;
|
|
const Value: TJvListViewGroup);
|
|
begin
|
|
inherited Items[Index] := Value;
|
|
end;
|
|
|
|
procedure TJvListViewGroups.SetSorted(const Value: Boolean);
|
|
begin
|
|
if FSorted <> Value then
|
|
begin
|
|
FSorted := Value;
|
|
if FSorted then
|
|
Sort;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvListViewGroups.Sort;
|
|
var
|
|
List: TJvListView;
|
|
begin
|
|
List := ParentList;
|
|
if Assigned(List) then
|
|
begin
|
|
SendMessage(List.Handle, LVM_SORTGROUPS, WPARAM(@LVGroupCompare), LPARAM(Self));
|
|
end;
|
|
end;
|
|
|
|
{ TJvTileViewProperties }
|
|
|
|
constructor TJvTileViewProperties.Create;
|
|
begin
|
|
inherited Create;
|
|
|
|
FLabelMargin := TJvRect.Create;
|
|
FTileSize := TJvSize.Create;
|
|
|
|
FLabelMargin.OnChange := LabelMarginChange;
|
|
FTileSize.OnChange := TileSizeChange;
|
|
|
|
FSubLinesCount := 1;
|
|
FTileSizeKind := tskAutoSize;
|
|
end;
|
|
|
|
destructor TJvTileViewProperties.Destroy;
|
|
begin
|
|
FTileSize.Free;
|
|
FLabelMargin.Free;
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJvTileViewProperties.DoChange;
|
|
begin
|
|
if not FLoading and Assigned(OnChange) then
|
|
OnChange(Self);
|
|
end;
|
|
|
|
procedure TJvTileViewProperties.LabelMarginChange(Sender: TObject);
|
|
begin
|
|
DoChange;
|
|
end;
|
|
|
|
procedure TJvTileViewProperties.LoadFromList(List: TCustomListView);
|
|
var
|
|
Infos: TLVTILEVIEWINFO;
|
|
begin
|
|
if not (csDesigning in List.ComponentState) then
|
|
begin
|
|
Infos.cbSize := SizeOf(Infos);
|
|
Infos.dwMask := LVTVIM_TILESIZE or LVTVIM_COLUMNS or LVTVIM_LABELMARGIN;
|
|
|
|
SendMessage(List.Handle, LVM_GETTILEVIEWINFO, 0, LPARAM(@Infos));
|
|
|
|
FLoading := True;
|
|
try
|
|
case Infos.dwFlags of
|
|
LVTVIF_FIXEDHEIGHT:
|
|
FTileSizeKind := tskFixedHeight;
|
|
LVTVIF_FIXEDWIDTH:
|
|
FTileSizeKind := tskFixedWidth;
|
|
LVTVIF_FIXEDSIZE:
|
|
FTileSizeKind := tskFixedSize;
|
|
else
|
|
FTileSizeKind := tskAutoSize;
|
|
end;
|
|
TileSize.Assign(Infos.sizeTile);
|
|
FSubLinesCount := infos.cLines;
|
|
LabelMargin.Assign(infos.rcLabelMargin);
|
|
finally
|
|
FLoading := False;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvTileViewProperties.SetLabelMargin(const Value: TJvRect);
|
|
begin
|
|
FLabelMargin.Assign(Value);
|
|
end;
|
|
|
|
procedure TJvTileViewProperties.SetSubLinesCount(const Value: Integer);
|
|
begin
|
|
FSubLinesCount := Value;
|
|
DoChange;
|
|
end;
|
|
|
|
procedure TJvTileViewProperties.SetTileSize(const Value: TJvSize);
|
|
begin
|
|
FTileSize.Assign(Value);
|
|
end;
|
|
|
|
procedure TJvTileViewProperties.SetTileSizeKind(const Value: TJvTileSizeKind);
|
|
begin
|
|
FTileSizeKind := Value;
|
|
DoChange;
|
|
end;
|
|
|
|
procedure TJvTileViewProperties.TileSizeChange(Sender: TObject);
|
|
begin
|
|
DoChange;
|
|
end;
|
|
|
|
{ TJvGroupProperties }
|
|
|
|
procedure TJvGroupsProperties.BorderColorChange(Sender: TObject);
|
|
begin
|
|
DoChange;
|
|
end;
|
|
|
|
procedure TJvGroupsProperties.BorderSizeChange(Sender: TObject);
|
|
begin
|
|
DoChange;
|
|
end;
|
|
|
|
constructor TJvGroupsProperties.Create;
|
|
begin
|
|
inherited Create;
|
|
|
|
FBorderSize := TJvGroupsPropertiesBorderRect.Create;
|
|
FBorderColor := TJvGroupsPropertiesBorderColors.Create;
|
|
|
|
FBorderSize.OnChange := BorderSizeChange;
|
|
FBorderColor.OnChange := BorderColorChange;
|
|
end;
|
|
|
|
destructor TJvGroupsProperties.Destroy;
|
|
begin
|
|
FBorderSize.Free;
|
|
FBorderColor.Free;
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJvGroupsProperties.DoChange;
|
|
begin
|
|
if not FLoading and Assigned(OnChange) then
|
|
OnChange(Self);
|
|
end;
|
|
|
|
procedure TJvGroupsProperties.LoadFromList(List: TCustomListView);
|
|
var
|
|
Infos: TLVGROUPMETRICS;
|
|
begin
|
|
if not (csDesigning in List.ComponentState) then
|
|
begin
|
|
ZeroMemory(@Infos, SizeOf(Infos));
|
|
|
|
Infos.cbSize := SizeOf(Infos);
|
|
Infos.mask := LVGMF_BORDERSIZE or LVGMF_BORDERCOLOR or LVGMF_TEXTCOLOR;
|
|
SendMessage(List.Handle, LVM_GETGROUPMETRICS, 0, LPARAM(@Infos));
|
|
|
|
FLoading := True;
|
|
try
|
|
BorderSize.Top := Infos.Top;
|
|
BorderSize.Left := Infos.Left;
|
|
BorderSize.Bottom := Infos.Bottom;
|
|
BorderSize.Right := Infos.Right;
|
|
BorderColor.Top := Infos.crTop and $00FFFFFF;
|
|
BorderColor.Left := Infos.crLeft and $00FFFFFF;
|
|
BorderColor.Bottom := Infos.crBottom and $00FFFFFF;
|
|
BorderColor.Right := Infos.crRight and $00FFFFFF;
|
|
HeaderColor := Infos.crHeader and $00FFFFFF;
|
|
finally
|
|
FLoading := False;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvGroupsProperties.SetBorderColor(const Value: TJvGroupsPropertiesBorderColors);
|
|
begin
|
|
FBorderColor.Assign(Value);
|
|
end;
|
|
|
|
procedure TJvGroupsProperties.SetBorderSize(const Value: TJvGroupsPropertiesBorderRect);
|
|
begin
|
|
FBorderSize.Assign(Value);
|
|
end;
|
|
|
|
procedure TJvGroupsProperties.SetHeaderColor(const Value: TColor);
|
|
begin
|
|
if FHeaderColor <> Value then
|
|
begin
|
|
FHeaderColor := Value;
|
|
DoChange;
|
|
end;
|
|
end;
|
|
|
|
{ TJvGroupsPropertiesBorderRect }
|
|
|
|
constructor TJvGroupsPropertiesBorderRect.Create;
|
|
begin
|
|
inherited Create;
|
|
|
|
Top := 12;
|
|
end;
|
|
|
|
{ TJvGroupsPropertiesBorderColors }
|
|
|
|
procedure TJvGroupsPropertiesBorderColors.Assign(Source: TPersistent);
|
|
var
|
|
SourceColors: TJvGroupsPropertiesBorderColors;
|
|
begin
|
|
if Source is TJvGroupsPropertiesBorderColors then
|
|
begin
|
|
SourceColors := Source as TJvGroupsPropertiesBorderColors;
|
|
FTop := SourceColors.Top;
|
|
FLeft := SourceColors.Left;
|
|
FBottom := SourceColors.Bottom;
|
|
FRight := SourceColors.Right;
|
|
DoChange;
|
|
end
|
|
else
|
|
begin
|
|
inherited Assign(Source);
|
|
end;
|
|
end;
|
|
|
|
constructor TJvGroupsPropertiesBorderColors.Create;
|
|
begin
|
|
inherited Create;
|
|
|
|
Top := $C8D0D4;
|
|
Left := clWhite;
|
|
Bottom := clWhite;
|
|
Right := clWhite;
|
|
end;
|
|
|
|
procedure TJvGroupsPropertiesBorderColors.DoChange;
|
|
begin
|
|
if Assigned(OnChange) then
|
|
OnChange(Self);
|
|
end;
|
|
|
|
procedure TJvGroupsPropertiesBorderColors.SetBottom(const Value: TColor);
|
|
begin
|
|
if FBottom <> Value then
|
|
begin
|
|
FBottom := Value;
|
|
DoChange;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvGroupsPropertiesBorderColors.SetLeft(const Value: TColor);
|
|
begin
|
|
if FLeft <> Value then
|
|
begin
|
|
FLeft := Value;
|
|
DoChange;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvGroupsPropertiesBorderColors.SetRight(const Value: TColor);
|
|
begin
|
|
if FRight <> Value then
|
|
begin
|
|
FRight := Value;
|
|
DoChange;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvGroupsPropertiesBorderColors.SetTop(const Value: TColor);
|
|
begin
|
|
if FTop <> Value then
|
|
begin
|
|
FTop := Value;
|
|
DoChange;
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
initialization
|
|
RegisterUnitVersion(HInstance, UnitVersioning);
|
|
|
|
finalization
|
|
UnregisterUnitVersion(HInstance);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
end.
|
|
|