ProgressBar в TlistView subitem delphi
-
20-09-2019 - |
Вопрос
Я смотрел на то, как поставить планку прогресса в TListView
В Delphi, и у меня есть какой -то код, который работает, но я хочу добавить его в субтом и не могу выяснить, как.
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.
Код, с которым я хочу, это работало:
...
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;
Решение
Код, который вы показали, на самом деле не добавляет панель прогресса »в« Субитему. Скорее, это требует отдельного бара прогресса и Двигается это, чтобы покрыть пространство первых двух столбцов. Вот что ты AdjustProgressBar
функция выполняет. Он получает ограничивающий прямоугольник элемента списка, который, я думаю, соответствует общей ширине всех столбцов. Затем он сдвигает левую сторону прямоугольника шириной первого столбца, и сдвигает правую сторону прямоугольника по ширине второго столбца.
Вы можете настроить координаты панели прогресса, как хотите. Например, чтобы он покрыл третий столбец, переключите левую сторону на ширину первых двух столбцов, а затем установите правую сторону на левую координату плюс ширина третьего столбца.
Но для этого вам все равно нужно, чтобы элемент списка имел субтом. Вы просто ставите на него панель прогресса, и у вас уже есть код, чтобы сделать это. Вы не можете добавить объект в качестве субтом; Субитема всегда текст. Текст может быть пустым, хотя для чтения экрана, которые знают, как читать виды списка, было бы неплохо, если бы вы обновили текст со значением панели строительства.
Другие советы
Я посмотрел на Ondrawitem и сам полностью перерисовал контроль.
Проверять эта почта.