TListview неправильно окрашивается при использовании события OnDrawItem
Я использую событие OnDrawItem в компоненте TlistView для рисования содержимого с использованием пользовательских цветов, но при прокрутке listview появляются некоторые артефакты.
Это используемый код.
procedure TForm35.FormCreate(Sender: TObject);
var
i, j : integer;
Item : TListItem;
s : string;
begin
for i:= 0 to 99 do
begin
Item:=ListView1.Items.Add;
for j:= 0 to ListView1.Columns.Count-1 do
begin
s:= Format('Row %d Column %d',[i+1, j+1]);
if j=0 then
Item.Caption :=s
else
Item.SubItems.Add(s);
end;
end;
end;
procedure TForm35.ListView1DrawItem(Sender: TCustomListView; Item: TListItem;
Rect: TRect; State: TOwnerDrawState);
var
x, y, i: integer;
begin
if odSelected in State then
begin
TListView(Sender).Canvas.Brush.Color := clYellow;
TListView(Sender).Canvas.Font.Color := clBlack;
end
else
begin
TListView(Sender).Canvas.Brush.Color := clLtGray;
TListView(Sender).Canvas.Font.Color := clGreen;
end;
TListView(Sender).Canvas.FillRect(Rect);
x := 5;
y := (Rect.Bottom - Rect.Top - TListView(Sender).Canvas.TextHeight('Hg')) div 2 + Rect.Top;
TListView(Sender).Canvas.TextOut(x, y, Item.Caption);
for i := 0 to Item.SubItems.Count - 1 do
begin
inc(x, TListView(Sender).Columns[i].Width);
TListView(Sender).Canvas.TextOut(x, y, Item.SubItems[i]);
end;
end;
Я тестировал этот код в Delphi 2007 и XE3, но получаю те же результаты. Как я могу предотвратить эту проблему?
1 ответ:
Хорошо. Изменить
X := 5
наX := Rect.Left;
И другое решение (возможно, более точное):
uses Graphics; //... Form or something else declarations ... implementation procedure TForm35.ListView1DrawItem(Sender: TCustomListView; Item: TListItem; Rect: TRect; State: TOwnerDrawState); var s: string; ts: TTextStyle; // Text style (used for drawing) begin // inherited; // Clear target rectangle // Set Canvas'es Font, Pen, Brush according for Item state // Get into s variable text value of the Cell. ts.Alignment := taLeftJustify; // Horz left alignment ts.Layout := tlCenter; // Vert center alignment ts.EndEllipsis := True; // End ellipsis (...) If line of text is too long too fit between left and right boundaries // Other fields see in the Graphics.TTextStyle = packed record ListView1.Canvas.TextRect( Rect, Rect.Left, // Not sure, but there are a small chance of this values equal to zero instead of Rect... Rect.Top, s, ts) end; end.
И чтобы предотвратить некоторые щелчки...
... var b: TBitmap; begin b := TBitmap.Create; try b.Widht := Rect.Right - Rect.Left; b.Height := Rect.Bottom - Rect.Top; //... // Draw content on the b.Canvas //... ListView.Canvas.Draw(Rect.Left, Rect.Top, b); finally b.Free; end; end;