// Zeichnet eine Fortschrittanzeige
procedure DrawProgress (aCanvas: TCanvas;
const aRect: TRect; aPercent: Integer;
aText:
string = '
');
var
tx, ty : Integer;
R : TRect;
begin
if (aText <> '
')
then
aText := aText + '
';
aText := aText + Format('
(%d%%)', [aPercent]);
with aCanvas
do
begin
tx := (aRect.Left + aRect.Right - TextWidth(aText))
div 2;
ty := (aRect.Top + aRect.Bottom - TextHeight(aText))
div 2;
// Hintergrund (linker Teil)
R := aRect;
R.Right := aRect.Left + MulDiv(aRect.Right - aRect.Left, aPercent, 100);
Brush.Color := clNavy;
FillRect (R);
// Text (linker Teil)
Font.Color := clWhite;
TextRect (R, tx, ty, aText);
// Hintergrund (rechter Teil)
R.Left := R.Right;
R.Right := aRect.Right;
Brush.Color :=
RGB(240, 240, 240);
FillRect (R);
// Text (rechter Teil)
Font.Color := clBlack;
TextRect (R, tx, ty, aText);
end;
end;
procedure TForm1.FormCreate (Sender: TObject);
begin
ListBox1.Style := lbOwnerDrawFixed;
// kann auch im OI
ListBox1.ItemHeight := 20;
// vorgenommen werden
end;
procedure TForm1.ListBox1DrawItem (Control: TWinControl;
Index: Integer;
Rect: TRect; State: TOwnerDrawState);
begin
with ListBox1
do
begin
if (odSelected
in State)
then
Canvas.Brush.Color := clRed
else
Canvas.Brush.Color := clWindow;
Canvas.FillRect (Rect);
InflateRect(Rect, -2, -2);
DrawProgress (Canvas, Rect, Integer(Items.Objects[
Index]), Items[
Index]);
end;
end;
// zum Testen:
procedure TForm1.Button1Click (Sender: TObject);
begin
with ListBox1.Items
do
AddObject(Format('
item #%d', [Count + 1]), TObject(Random(100)));
end;