There seems not to exist any robust solution to this problem.
A bad solution, however, is
procedure TForm4.FormShow(Sender: TObject);
var
i: integer;
begin
ListView1.ViewStyle := vsReport;
ListView1.Columns.Add.Caption := 'Col 1';
ListView1.Columns.Add.Caption := 'Col 2';
ListView1.Columns.Add.Caption := 'Col 3';
ListView1.GridLines := false; // You cannot have grid lines...
for i := 0 to 10 do
with ListView1.Items.Add do
begin
if i <> 5 then
begin
Caption := 'Test';
SubItems.Add('test');
SubItems.Add('test');
end
else
Caption := 'This is a very, very long caption';
end;
end;
var
ColWidths: array of integer;
procedure TForm4.ListView1AdvancedCustomDraw(Sender: TCustomListView;
const ARect: TRect; Stage: TCustomDrawStage; var DefaultDraw: Boolean);
var
i, j: Integer;
begin
if Stage <> cdPrePaint then Exit;
if length(ColWidths) <> TListView(Sender).Columns.Count then
begin
SetLength(ColWidths, TListView(Sender).Columns.Count);
Exit;
end;
for i := 0 to length(ColWidths) - 1 do
if ColWidths[i] <> Sender.Column[i].Width then
begin
Sender.Invalidate;
for j := 0 to length(ColWidths) - 1 do
ColWidths[i] := Sender.Column[i].Width;
end;
end;
procedure TForm4.ListView1AdvancedCustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
var DefaultDraw: Boolean);
var
r: TRect;
begin
DefaultDraw := (Item.SubItems.Count <> 0);
if not DefaultDraw then
begin
FillRect(Sender.Canvas.Handle, Item.DisplayRect(drBounds), GetStockObject(WHITE_BRUSH));
r := Item.DisplayRect(drBounds);
DrawText(Sender.Canvas.Handle, Item.Caption, length(Item.Caption), r, DT_SINGLELINE or DT_LEFT or DT_VCENTER)
end;
end;

This is bad because it is not robust. It flickers, it's buggy, and it is "hacky". It might not work well in future versions of Windows. Basically, the Windows list view control isn't supposed to do HTML-like colspan, I think.