[bar_gra]

I bought license today and i moved from TListView to TsListView. I had a function to insert progressbar in tlistview (third column) but with TsListview i have a problem.

onDrawSubItem (send progress to DrawStatus function)

Code:

procedure TMainForm.DownloadViewCustomDrawSubItem(Sender: TCustomListView;
Item: TListItem; SubItem: Integer; State: TCustomDrawState;
var DefaultDraw: Boolean);
var
ListView: TsListView absolute Sender;
R: TRect;
Progress: real;
begin

DefaultDraw := SubItem <> 2;
if not DefaultDraw then

begin
try
Progress := StrToFloat(Item.SubItems[SubItem – 1]);
except
on E: Exception do
begin
Progress := 0;
end;
end;
ListView_GetSubItemRect(ListView.Handle, Item.Index, SubItem, LVIR_BOUNDS, @R);
DrawStatus(ListView.Canvas.Handle, R, ListView.Font, 'Downloading', Progress);
end;

And the DrawStatus function

Code:

procedure DrawStatus(DC: HDC; R: TRect; State: TCustomDrawState; Font: TFont; const Txt: String; Progress: Single);
var
TxtRect: TRect;
S: String;
Details: TThemedElementDetails;
SaveBrush: HBRUSH;
SavePen: HPEN;
TxtFont: TFont;
SaveFont: HFONT;
SaveTextColor: COLORREF;
begin
FillRect(DC, R, 0);
InflateRect(R, -1, -1);
TxtRect := R;
S := Format('%s %.1f%%', [Txt, Progress * 100]);
if ThemeServices.ThemesEnabled then
begin
Details := ThemeServices.GetElementDetails(tpBar);
ThemeServices.DrawElement(DC, Details, R, nil);
InflateRect(R, -2, -2);
R.Right := R.Left + Trunc((R.Right – R.Left) * Progress);
Details := ThemeServices.GetElementDetails(tpChunk);
ThemeServices.DrawElement(DC, Details, R, nil);
end
else
begin
SavePen := SelectObject(DC, CreatePen(PS_NULL, 0, 0));
SaveBrush := SelectObject(DC, CreateSolidBrush($00EBEBE:cool:);
Inc(R.Right);
Inc(R.Bottom);
RoundRect(DC, R.Left, R.Top, R.Right, R.Bottom, 3, 3);
R.Right := R.Left + Trunc((R.Right – R.Left) * Progress);
DeleteObject(SelectObject(DC, CreateSolidBrush($00FFC184)));
RoundRect(DC, R.Left, R.Top, R.Right, R.Bottom, 3, 3);
if R.Right > R.Left + 3 then
Rectangle(DC, R.Right – 3, R.Top, R.Right, R.Bottom);
DeleteObject(SelectObject(DC, SaveBrush));
DeleteObject(SelectObject(DC, SavePen));
end;
TxtFont := TFont.Create;
try
TxtFont.Assign(Font);
TxtFont.Height := TxtRect.Bottom – TxtRect.Top;
TxtFont.Color := clGrayText;
SetBkMode(DC, TRANSPARENT);
SaveFont := SelectObject(DC, TxtFont.Handle);
SaveTextColor := SetTextColor(DC, GetSysColor(COLOR_GRAYTEXT));
DrawText(DC, PChar(S), -1, TxtRect, DT_SINGLELINE or DT_CENTER or DT_VCENTER or DT_END_ELLIPSIS or DT_NOPREFIX);
SetBkMode(DC, TRANSPARENT);
finally
DeleteObject(SelectObject(DC, SaveFont));
SetTextColor(DC, SaveTextColor);
TxtFont.Free;
end;
end;

It paints progressbar correctly but when i select item, then selection hides progressbar

Screens In 1.jpg (non-selected) in 2.jpg (selected)

Thanks

Bart

[Support]

Hello

This problem will be solved in the next release.

If you have sources of the package, then I can send you a patched file right now.

[Author]

Posts