Delphi: manually draw list view when horizontal bar is present
I draw list view items with OwnerDraw
, but I have bugs: please resize a column -> you will have a horizontal bar, scroll it -> items are drawn on a visible area :(
Please help me to edit a code below. Thanks for your attention and help!!!
Added:
I checked, Rect.Right and Rect.Left increase/decrease while scrolling. E.g. we scroll 50 px right, Rect.Right will be Rect.Right+50, Rect.Left will be -50 (0-50)
A normal view:
Bugs:
procedure TDownloadFrame.DownloadListDrawItem(Sender: TCustomListView;
Item: TListItem; Rect: TRect; State: TOwnerDrawState);
var
i: integer;
x1, x2: integer;
R: TRect;
s: string;
const
DT_ALIGN: array [TAlignment] of integer = (DT_LEFT, DT_RIGHT, DT_CENTER);
begin
if odSelected in State then
begin
Sender.Canvas.Font.Color := clWhite;
Sender.Canvas.Brush.Color := $00FF8000;
end
else
begin
Sender.Canvas.Font.Color := clBlack;
Sender.Canvas.Brush.Color := clWhite;
end;
Sender.Canvas.Brush.Style := bsSolid;
Sender.Canvas.FillRect(Rect);
x1 := 0;
x2 := 0;
R := Rect;
Sender.Canvas.Brush.Style := bsClear;
MainForm.Icons_16x16.Draw(DownloadList.Canvas, 3, R.Top + (R.Bottom - R.Top - 16) div 2, 1, true);
for i := 0 to DownloadList.Columns.Count - 1 do
begin
Inc(x2, ListView_GetColumnWidth(DownloadList.Handle,
DownloadList.Columns[i].Index));
R.Left := x1;
R.Right := x2;
if i = 0 then
begin
s := Item.Caption;
R.Left := 16 + 6;
开发者_运维知识库 end
else
s := Item.SubItems[i - 1];
if i <> 3 then
DrawText(Sender.Canvas.Handle, s, length(s), R, DT_SINGLELINE or
DT_ALIGN[DownloadList.Columns[i].Alignment] or DT_VCENTER or
DT_END_ELLIPSIS);
x1 := x2;
end;
end;
Change:
1)
x1 := 0;
x2 := 0;
to
x1 := Rect.Left;
x2 := Rect.Left;
2)
MainForm.Icons_16x16.Draw(DownloadList.Canvas, 3, R.Top + (R.Bottom - R.Top - 16) div 2, 1, true);
to
MainForm.Icons_16x16.Draw(DownloadList.Canvas, R.Left+3, R.Top + (R.Bottom - R.Top - 16) div 2, ImgIndex, true);
3)
if i = 0 then
begin
s := Item.Caption;
R.Left := 16 + 6;
end
to
if i = 0 then
begin
s := Item.Caption;
R.Left := R.Left + 16 + 6;
end
i came across a bug in the VCL recently where if i draw on a ListItem with an imagelist, then the listview's canvas would no longer honor any font color, font size, or font face changes of Sender.Canvas.Font
:
Sender.Canvas.Font.Color := clHighlightText;
Sender.Canvas.Font.Size := 14;
Sender.Canvas.Font.Name := 'Consolas';
...none would work. This would only stop working if i first drew on the canvas using:
imageList.Draw(Sender.Canvas, ....);
If i removed the imageList.Draw
everything was fine.
i was forced to set the font and colors using GDI directly:
savedDC := SaveDC(Sender.Canvas.Handle);
try
SetTextColor(Sender.Canvas.Handle, clHighlightText); //don't use clWhite, use the correct color
newfont := TFont.Create;
try
newFont.Assign(Sender.Canvas.Font);
newFont.Name := 'Consolas';
newfont.Size := 14;
SelectObject(Sender.Canvas.Handle, newFont.Handle);
szText = 'Hello, world!';
TextOut(Sender.Canvas.Handle, 0, 0, PChar(szText), Length(szText));
finally
newFont.Free;
end;
finally
RestoreDC(Sender.Canvas.Handle, savedDC);
end;
Note: Any code is released into the public domain. No attribution required.
精彩评论