ProgressBar В подпункте tListview Delphi

Question

Я смотрел, как поместить ProgressBar в tListview в delphi, и у меня есть некоторый код, который работает ... НО я хочу добавить его в подпункт ... и не могу понять это ... .

 </p>

<h2>DFM Source Begin</h2>

<p>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</p>

<hr>

<p>END DFM Source</p>

<p>unit Unit1;</p>

<p>interface</p>

<p>uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, CommCtrl;</p>

<p>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;</p>

<p>var
  Form1: TForm1;</p>

<p>implementation</p>

<p>{$R *.dfm}</p>

<p>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;</p>

<p>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;</p>

<p>procedure TForm1.WMNotify(var Message: TWMNotify);
var
  i: Integer;
  r: TRect;
begin</p>

<p>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;</p>

<pre><code>    ListView1.Repaint;
  end;end;

наследуется; конец;

процедура TForm1.ListView1CustomDrawItem (Отправитель: TCustomListView; Item: TListItem; Состояние: TCustomDrawState; var DefaultDraw: Boolean); вар r: TRect; пб: TProgressBar; начать r: = Item.DisplayRect (drBounds); if r.Top> = Listview1.BoundsRect.Top then AdjustProgressBar (Item, r); конец;

процедура TForm1.AdjustProgressBar (элемент: TListItem; r: TRect); вар пб: TProgressBar; начать r.Left: = r.Left + Listview1.columns [0] .Width; r.Right: = r.Left + Listview1.columns [1] .Width; pb: = item.Data; pb.BoundsRect: = r; конец;

конец.

Код, с которым я хочу работать, это:

<code>
...</p>

<p>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; </p>

<p>

Любая помощь будет оценена.

Спасибо

-Brad

Answer 1

Код, который вы показали, на самом деле не добавляет индикатор выполнения «к» подэлементу. Скорее, требуется отдельный индикатор выполнения и перемещает , чтобы покрыть пространство первых двух столбцов. Это то, что делает ваша AdjustProgressBar функция. Он получает ограничивающий прямоугольник элемента списка, который, я думаю, соответствует общей ширине всех столбцов. Затем он сдвигает левую сторону прямоугольника на ширину первого столбца и смещает правую сторону прямоугольника на ширину второго столбца.

Вы можете настроить координаты индикатора выполнения так, как вы хотите. Например, чтобы он охватывал третий столбец, сдвиньте левую сторону на ширину первых двух столбцов, а затем установите правую сторону для левой координаты плюс ширина третьего столбца.

Но чтобы это работало, вам все еще нужно, чтобы элемент списка имел подэлемент. Вы просто помещаете индикатор выполнения поверх него, и у вас уже есть код для этого. Вы не можете добавить объект как подпункт; Подпункт всегда текст. Текст может быть пустым, хотя для удобства программ чтения с экрана, которые знают, как читать представления списка, было бы неплохо, если бы вы обновили текст значением индикатора выполнения.

Answer 2

Я бы посмотрел на OnDrawItem и полностью перерисовал элемент управления самостоятельно.

Проверьте это сообщение .