// List View Column Autosize (Virtual Mode)
unit Unit1;
interface
uses
// Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, StdCtrls,
// Forms, Dialogs, StrUtils, ComCtrls, CommCtrl;
Winapi.Windows,
Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Vcl.ComCtrls,
Winapi.CommCtrl,
Vcl.StdCtrls, System.StrUtils,
Vcl.ExtCtrls;
type
TSampleRecord =
record
Column1:
string;
Column2:
string;
Column3:
string;
Column4:
string;
end;
TSampleArray =
array [0..49]
of TSampleRecord;
type
TForm1 =
class(TForm)
Button1: TButton;
ListView1: TListView;
Panel1: TPanel;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormResize(Sender: TObject);
private
SampleArray: TSampleArray;
procedure AutoResizeColumn(
const AListView: TListView;
const AColumn: Integer);
procedure OnListViewData(Sender: TObject; Item: TListItem);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
// TForm1.AutoResizeColumn - auto-size column
// AListView - list view object instance
// AColumn - index of the column to be auto-sized
procedure TForm1.AutoResizeColumn(
const AListView: TListView;
const AColumn: Integer);
var
S:
string;
I: Integer;
MaxWidth: Integer;
ItemWidth: Integer;
begin
// set the destination column width to the column's caption width
// later on we'll check if we have a wider item
MaxWidth := ListView_GetStringWidth(AListView.Handle,
PChar(AListView.Columns.Items[AColumn].Caption));
// iterate through all data items and check if their captions are
// wider than the currently widest item if so then store that value
for I := 0
to High(SampleArray)
do
begin
case AColumn
of
0: S := SampleArray[I].Column1;
1: S := SampleArray[I].Column2;
2: S := SampleArray[I].Column3;
3: S := SampleArray[I].Column4;
end;
ItemWidth := ListView_GetStringWidth(AListView.Handle, PChar(S));
if MaxWidth < ItemWidth
then MaxWidth := ItemWidth;
end;
// here is hard to say what value to use for padding to prevent the
// string to be truncated; I've found the suggestions to use 6 px
// for item caption padding and 12 px for subitem caption padding,
// but a few quick tests confirmed me to use at least 7 px for items
// and 14 px for subitems
if AColumn = 0
then
MaxWidth := MaxWidth + 7
else
MaxWidth := MaxWidth + 14;
// and here we set the column width with caption padding included
AListView.Columns.Items[AColumn].Width := MaxWidth;
end;
// TForm1.FormCreate - setup the list view and fill custom data
procedure TForm1.FormCreate(Sender: TObject);
var
I: Integer;
begin
ListView1.ViewStyle := vsReport;
ListView1.Columns.Add.Caption := '
Column 1';
ListView1.Columns.Add.Caption := '
Column 2';
ListView1.Columns.Add.Caption := '
Column 3';
ListView1.Columns.Add.Caption := '
Column 4';
ListView1.OwnerData := True;
ListView1.OnData := OnListViewData;
ListView1.Items.Count := High(SampleArray);
for I := 0
to High(SampleArray)
do
begin
SampleArray[I].Column1 := '
Cell [0, ' + IntToStr(I) + '
] ' +
DupeString('
x', I);
SampleArray[I].Column2 := '
Cell [1, ' + IntToStr(I) + '
] ' +
DupeString('
x', High(SampleArray) - I);
SampleArray[I].Column3 := '
Cell [2, ' + IntToStr(I) + '
] ' +
DupeString('
x', I);
SampleArray[I].Column4 := '
Cell [3, ' + IntToStr(I) + '
] ' +
DupeString('
x', High(SampleArray) - I);
end;
end;
// TForm1.FormCreate - custom handler for OnData event
procedure TForm1.OnListViewData(Sender: TObject; Item: TListItem);
begin
Item.Caption := SampleArray[Item.
Index].Column1;
Item.SubItems.Add(SampleArray[Item.
Index].Column2);
Item.SubItems.Add(SampleArray[Item.
Index].Column3);
Item.SubItems.Add(SampleArray[Item.
Index].Column4);
end;
// TForm1.Button1Click - auto-resize all 4 columns
procedure TForm1.Button1Click(Sender: TObject);
begin
AutoResizeColumn(ListView1, 0);
AutoResizeColumn(ListView1, 1);
AutoResizeColumn(ListView1, 2);
AutoResizeColumn(ListView1, 3);
end;
procedure TForm1.FormResize(Sender: TObject);
begin
Button1.Click;
end;
end.