unit ListViewEx;
interface
uses
SysUtils, Windows, Messages, Types, Classes, Graphics, Vcl.Controls, Vcl.Menus,
Vcl.ComCtrls, Vcl.Forms, CommCtrl, UITypes;
type
TColumnSortMethod = (csmText, csmInteger, csmFloat, csmDateTime);
TListViewEx = class(TListView)
strict private
FSortColumn: Integer;
FSortAscending: Boolean;
FEnableSorting: Boolean;
FOnSelCntChange: TNotifyEvent;
FEmptyText: string;
class constructor Create;
class destructor Destroy;
procedure SetSortColumn(const Value: Integer);
procedure SetSortAscending(const Value: Boolean);
procedure DoSelCntChange;
procedure SetEmptyText(const AText: string);
strict protected
procedure ApplySortingIndicator(ColumnIndex: Integer; Ascending: Boolean);
protected
procedure KeyPress(var Key: Char); override;
procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY;
procedure ColClick(Column: TListColumn); override;
procedure Resize; override;
procedure DoSelectItem(Item: TListItem; Selected: Boolean); override;
function OwnerDataStateChange(StartIndex: Integer; EndIndex: Integer;
OldState: TItemStates; NewState: TItemStates): Boolean; override;
procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
public
constructor Create(AOwner: TComponent); override;
procedure SelectAll; override;
function GetSelectedIndicesFast: TArray<Integer>;
function GetSelectedCaptions: TArray<string>;
function AdjustColumns: Boolean;
procedure EnableSorting(const AColumnTypes: array of TColumnSortMethod);
procedure DisableSorting;
procedure Sort(const AColumnIndex: Integer; const AAscending: Boolean = True);
published
property Action;
property Align;
property AllocBy;
property Anchors;
property BevelEdges;
property BevelInner;
property BevelOuter;
property BevelKind default bkNone;
property BevelWidth;
property BiDiMode;
property BorderStyle;
property BorderWidth;
property Checkboxes;
property Color;
property Columns;
property ColumnClick;
property Constraints;
property Ctl3D;
property DoubleBuffered default True;
property DragCursor;
property DragKind;
property DragMode;
property EmptyText: string read FEmptyText write SetEmptyText;
property Enabled;
property Font;
property FlatScrollBars;
property FullDrag;
property GridLines;
property Groups;
property HideSelection default False;
property HotTrack;
property HotTrackStyles;
property HoverTime;
property IconOptions;
property Items;
property LargeImages;
property MultiSelect;
property StyleElements;
property OwnerData;
property OwnerDraw;
property GroupHeaderImages;
property GroupView default False;
property ReadOnly default False;
property RowSelect default True;
property ParentBiDiMode;
property ParentColor default False;
property ParentDoubleBuffered;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowColumnHeaders;
property ShowWorkAreas;
property ShowHint;
property SmallImages;
property SortAscending: Boolean read FSortAscending write SetSortAscending default True;
property SortColumn: Integer read FSortColumn write SetSortColumn default -1;
property SortType;
property StateImages;
property TabOrder;
property TabStop default True;
property Touch;
property ViewStyle;
property Visible;
property OnAdvancedCustomDraw;
property OnAdvancedCustomDrawItem;
property OnAdvancedCustomDrawSubItem;
property OnChange;
property OnChanging;
property OnClick;
property OnColumnClick;
property OnColumnDragged;
property OnColumnRightClick;
property OnCompare;
property OnContextPopup;
property OnCustomDraw;
property OnCustomDrawItem;
property OnCustomDrawSubItem;
property OnCreateItemClass;
property OnData;
property OnDataFind;
property OnDataHint;
property OnDataStateChange;
property OnDblClick;
property OnDeletion;
property OnDrawItem;
property OnEdited;
property OnEditing;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGesture;
property OnGetImageIndex;
property OnGetSubItemImage;
property OnDragDrop;
property OnDragOver;
property OnInfoTip;
property OnInsert;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseActivate;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnSelCntChange: TNotifyEvent read FOnSelCntChange write FOnSelCntChange;
property OnSelectItem;
property OnItemChecked;
property OnStartDock;
property OnStartDrag;
end;
procedure Register;
implementation
uses
Math, Vcl.Clipbrd, Vcl.Dialogs, Vcl.Themes, DateUtils, Winapi.ShlObj,
StdCtrls, Buttons, StrUtils;
var
InvFS: TFormatSettings;
function NaturalStringToIntDef(const S: string; const Def: Integer): Integer;
begin
Result := StrToIntDef(S, Def);
end;
function NaturalStringToFloatDef(const S: string; const Def: Double): Double;
begin
var T := S;
for var i := 1 to T.Length do
if T[i] = ',' then
T[i] := '.';
Result := StrToFloatDef(T, Def, InvFS);
end;
class constructor TListViewEx.Create;
begin
TCustomStyleEngine.RegisterStyleHook(TListViewEx, TListViewStyleHook);
end;
class destructor TListViewEx.Destroy;
begin
TCustomStyleEngine.UnRegisterStyleHook(TListViewEx, TListViewStyleHook);
end;
procedure TListViewEx.DisableSorting;
begin
FEnableSorting := False;
end;
procedure TListViewEx.DoSelCntChange;
begin
if Assigned(FOnSelCntChange) then
FOnSelCntChange(Self);
end;
procedure TListViewEx.DoSelectItem(Item: TListItem; Selected: Boolean);
begin
inherited;
DoSelCntChange;
end;
procedure TListViewEx.EnableSorting(
const AColumnTypes: array of TColumnSortMethod);
begin
if ViewStyle <> vsReport then
Exit;
for var i := 0 to Columns.Count - 1 do
if i <= High(AColumnTypes) then
Columns[i].Tag := ord(AColumnTypes[i])
else
Columns[i].Tag := ord(csmText);
FEnableSorting := True;
ColumnClick := True;
end;
function SortProc(Left, Right: TListItem; AListView: TListViewEx): Integer; stdcall;
var
col: Integer;
asc: Boolean;
csm: TColumnSortMethod;
s1, s2: string;
begin
col := AListView.SortColumn;
asc := AListView.SortAscending;
csm := TColumnSortMethod(AListView.Columns[col].Tag);
if col = 0 then
begin
s1 := Left.Caption;
s2 := Right.Caption;
end
else
begin
if col <= Left.SubItems.Count then
s1 := Left.SubItems[col - 1]
else
s1 := '';
if col <= Right.SubItems.Count then
s2 := Right.SubItems[col - 1]
else
s2 := '';
end;
case csm of
csmText:
Result := AnsiCompareText(s1, s2);
csmInteger:
Result := CompareValue(NaturalStringToIntDef(s1, 0), NaturalStringToIntDef(s2, 0));
csmFloat:
Result := CompareValue(NaturalStringToFloatDef(s1, 0), NaturalStringToFloatDef(s2, 0));
csmDateTime:
Result := CompareDateTime(StrToDateTimeDef(s1, 0), StrToDateTimeDef(s2, 0));
else
Result := 0;
end;
if not asc then
Result := -Result;
end;
procedure TListViewEx.CNNotify(var Message: TWMNotify);
begin
inherited;
if not FEmptyText.IsEmpty and (Message.NMHdr.hwndFrom = Handle) and (Message.NMHdr.code = LVN_GETEMPTYMARKUP) then
begin
with PNMLVEmptyMarkup(Message.NMHdr)^ do
begin
dwFlags := EMF_CENTERED;
FillChar(szMarkup, SizeOf(szMarkup), 0);
Move(FEmptyText[1], szMarkup[0], SizeOf(FEmptyText[1]) * FEmptyText.Length);
end;
Message.Result := Ord(True);
end;
end;
procedure TListViewEx.ColClick(Column: TListColumn);
begin
inherited;
if FEnableSorting and not OwnerData then
begin
if Column.Index = FSortColumn then
SortAscending := not FSortAscending
else
begin
FSortAscending := True;
SortColumn := Column.Index;
end;
CustomSort(@SortProc, NativeInt(Self));
end;
end;
constructor TListViewEx.Create(AOwner: TComponent);
begin
inherited;
FSortColumn := -1;
FSortAscending := True;
FEnableSorting := False;
DoubleBuffered := True;
RowSelect := True;
HideSelection := False;
end;
function TListViewEx.GetSelectedCaptions: TArray<string>;
begin
var Idxs := GetSelectedIndicesFast;
SetLength(Result, Length(Idxs));
for var i := 0 to High(Idxs) do
Result[i] := Items[Idxs[i]].Caption;
end;
function TListViewEx.GetSelectedIndicesFast: TArray<Integer>;
var
c, idx: Integer;
begin
var LSelCount := Self.SelCount;
if Self.Items.Count = LSelCount then
begin
SetLength(Result, LSelCount);
for var i := 0 to High(Result) do
Result[i] := i;
Exit;
end;
SetLength(Result, LSelCount);
idx := -1;
c := 0;
repeat
idx := ListView_GetNextItem(Handle, idx, LVNI_ALL or LVNI_SELECTED);
if idx <> -1 then
begin
Result[c] := idx;
Inc(c);
end;
until idx = -1;
end;
procedure TListViewEx.KeyPress(var Key: Char);
begin
inherited;
case Key of
^A:
SelectAll;
end;
end;
function TListViewEx.OwnerDataStateChange(StartIndex, EndIndex: Integer;
OldState, NewState: TItemStates): Boolean;
begin
inherited;
DoSelCntChange;
Result := True;
end;
procedure TListViewEx.Resize;
begin
inherited;
ApplySortingIndicator(FSortColumn, FSortAscending);
end;
procedure TListViewEx.SelectAll;
begin
if MultiSelect then
ListView_SetItemState(Handle, -1, LVIS_SELECTED, LVIS_SELECTED);
end;
procedure TListViewEx.SetEmptyText(const AText: string);
begin
if FEmptyText <> AText then
begin
FEmptyText := AText;
RecreateWnd;
end;
end;
procedure TListViewEx.SetSortAscending(const Value: Boolean);
begin
FSortAscending := Value;
ApplySortingIndicator(FSortColumn, FSortAscending);
end;
procedure TListViewEx.SetSortColumn(const Value: Integer);
begin
FSortColumn := Value;
ApplySortingIndicator(FSortColumn, FSortAscending);
end;
procedure TListViewEx.Sort(const AColumnIndex: Integer;
const AAscending: Boolean);
begin
if FEnableSorting and not OwnerData then
begin
FSortColumn := AColumnIndex;
FSortAscending := AAscending;
ApplySortingIndicator(FSortColumn, FSortAscending);
if AColumnIndex <> -1 then
CustomSort(@SortProc, NativeInt(Self));
end;
end;
procedure TListViewEx.WMNotify(var Message: TWMNotify);
type
PNMHeader = ^TNMHeader;
TNMHeader = tagNMHEADERW;
begin
inherited;
if Message.NMHdr^.hwndFrom = ListView_GetHeader(Handle) then
case Message.NMHdr^.code of
HDN_ENDTRACK, HDN_DIVIDERDBLCLICK:
begin
ApplySortingIndicator(FSortColumn, FSortAscending);
end;
end
end;
function TListViewEx.AdjustColumns: Boolean;
var
AutoSizeWidths: TArray<Integer>;
TotalAutoSizeWidth: Integer;
NumAutoSizeCols: Integer;
FixedWidth: Integer;
FreeWidth: Integer;
VScrollLikely: Boolean;
hdr: HWND;
hdrRect: TRect;
hdrHeight: Integer;
begin
Result := False;
if ViewStyle <> vsReport then
Exit;
SetLength(AutoSizeWidths, Columns.Count);
FixedWidth := 0;
TotalAutoSizeWidth := 0;
NumAutoSizeCols := 0;
for var i := 0 to Columns.Count - 1 do
if Columns[i].AutoSize then
begin
AutoSizeWidths[i] := Columns[i].Width;
Inc(TotalAutoSizeWidth, AutoSizeWidths[i]);
Inc(NumAutoSizeCols);
end
else
Inc(FixedWidth, Columns[i].Width);
if TotalAutoSizeWidth = 0 then
Exit;
hdr := ListView_GetHeader(Handle);
if (hdr <> 0) and GetWindowRect(hdr, hdrRect) then
hdrHeight := hdrRect.Height
else
hdrHeight := 24;
if Items.Count > 0 then
VScrollLikely := Items.Count * Items[0].DisplayRect(drBounds).Height >=
Height - 2 * GetSystemMetrics(SM_CYEDGE) - hdrHeight
else
VScrollLikely := False;
FreeWidth := Width - 2 * GetSystemMetrics(SM_CXEDGE) - FixedWidth;
if VScrollLikely then
Dec(FreeWidth, GetSystemMetrics(SM_CXVSCROLL));
if FreeWidth < 6 * NumAutoSizeCols then
Exit;
for var i := 0 to Columns.Count - 1 do
if Columns[i].AutoSize then
Columns[i].Width := Floor(FreeWidth * AutoSizeWidths[i] / TotalAutoSizeWidth);
Result := True;
end;
procedure TListViewEx.ApplySortingIndicator(ColumnIndex: Integer;
Ascending: Boolean);
var
header: HWND;
hitem: THDItem;
begin
if ViewStyle <> vsReport then
Exit;
header := ListView_GetHeader(Handle);
hitem.Mask := HDI_FORMAT;
for var i := 0 to Columns.Count - 1 do
if Header_GetItem(header, i, hitem) then
begin
if i = ColumnIndex then
if Ascending then
hitem.fmt := (hitem.fmt or HDF_SORTUP) and not HDF_SORTDOWN
else
hitem.fmt := (hitem.fmt or HDF_SORTDOWN) and not HDF_SORTUP
else
hitem.fmt := hitem.fmt and not (HDF_SORTUP or HDF_SORTDOWN);
Header_SetItem(header, i, hitem);
end;
end;
procedure Register;
begin
RegisterComponents('Rejbrand 2020', [TListViewEx]);
end;
initialization
InvFS := TFormatSettings.Invariant;
end.