ProgressBar In tListview subitem Delphi - delphi

Question

I've been looking at how to put a progress bar in a TListView in Delphi, and I've got some code that works, BUT I want to add it to a SubItem and cannot figure out how.
object Form1: TForm1
Left = 221
Top = 113
Caption = 'Form1'
ClientHeight = 203
ClientWidth = 482
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
DesignSize = (
482
203)
PixelsPerInch = 96
TextHeight = 13
object ListView1: TListView
Left = 16
Top = 16
Width = 449
Height = 177
Anchors = [akLeft, akTop, akRight, akBottom]
Columns = <>
FullDrag = True
TabOrder = 0
OnCustomDrawItem = ListView1CustomDrawItem
end
end
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, CommCtrl;
type
TForm1 = class(TForm)
ListView1: TListView;
procedure FormCreate(Sender: TObject);
procedure ListView1CustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
private
{ Private declarations }
procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY;
procedure AdjustProgressBar(item: TListItem; r: TRect);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
i: Byte;
r: TRect;
pb: TProgressBar;
begin
Listview1.Columns.Add.Width := 100;
Listview1.Columns.Add.Width := 200;
Listview1.ViewStyle := vsReport;
Randomize;
for i:=0 to 40 do
begin
Listview1.Items.Add.Caption := 'Texte ' + IntToStr(i);
r := Listview1.Items[i].DisplayRect(drBounds);
pb := TProgressBar.Create(Self);
pb.Parent := Listview1;
pb.Position := Random(pb.Max);
Listview1.Items[i].Data := pb;
AdjustProgressBar(Listview1.Items[i], r);
end;end;
procedure TForm1.WMNotify(var Message: TWMNotify);
var
i: Integer;
r: TRect;
begin
case Message.NMHdr.code of
HDN_ITEMCHANGED, HDN_ITEMCHANGING:
begin
for i:=0 to Listview1.Items.Count-1 do
begin
r := Listview1.Items[i].DisplayRect(drBounds);
AdjustProgressBar(Listview1.Items[i], r);
end;
ListView1.Repaint;
end;end;
inherited;
end;
procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
var
r: TRect;
pb: TProgressBar;
begin
r := Item.DisplayRect(drBounds);
if r.Top>=Listview1.BoundsRect.Top then
AdjustProgressBar(Item, r);
end;
procedure TForm1.AdjustProgressBar(item: TListItem; r: TRect);
var
pb: TProgressBar;
begin
r.Left := r.Left + Listview1.columns[0].Width;
r.Right := r.Left + Listview1.columns[1].Width;
pb := item.Data;
pb.BoundsRect := r;
end;
end.
The code I want it to work with is:
...
with listview1.Items.Add do
begin
Caption := IntToStr(listview1.Items.Count);
SubItems.Add('blah');
SubItems.Add('blah');
SubItems.Add('blah');
{Add SubItem Progress Bar here Position 4 out of 10}
end;

Answer 1

The code you've shown doesn't really add a progress bar "to" a subitem. Rather, it takes a standalone progress bar and moves it to cover the space of the first two columns. That's what your AdjustProgressBar function does. It receives the bounding rectangle of the list item, which I think corresponds to the total width of all the columns. Then, it shifts the left side of the rectangle by the width of the first column, and it shifts the right side of the rectangle by the width of the second column.
You can adjust the coordinates of the progress bar however you want. For example, to make it cover the third column, shift the left side by the widths of the first two columns, and then set the right side to the left coordinate plus the third column's width.
But for that to work, you still need for the list item to have a subitem. You're just putting a progress bar on top of it, and you already have code to do that. You can't add an object as a subitem; a subitem is always text. The text can be blank, although for the benefit of screen readers that know how to read list views, it would be nice if you updated the text with the progress bar's value.

Answer 2

I'd take a look at the OnDrawItem and completely redraw the control myself.
Check this post.