Добрый день, уваж. гуру!!!
Нужно прорисовать в TListView в одной из колонок прямоугольник.
В TListView 3 колонки.
написал такой код:
procedure TForm1.ListView1CustomDrawSubItem(Sender: TCustomListView;
Item: TListItem; SubItem: Integer; State: TCustomDrawState;
var DefaultDraw: Boolean);
var
Rect : TRect;
begin
if SubItem = 1 then
begin
Rect.Left := Item.Left + 100;
Rect.Top := Item.Top;
Rect.Right := Rect.Left + 100;
Rect.Bottom := Rect.Top + 16;
Sender.Canvas.FillRect(Rect);
Sender.Canvas.Rectangle(Rect.Left,Rect.Top,Rect.Right-5,rect.Bottom);
DefaultDraw := false;
end;
end;
Проблема в том, что в 3 колонке текст почему-то прорисовывается жирным стилем.
Как с этим бороться?
И
Здравствуйте, yaser, Вы писали:
[Skip]
Y>Проблема в том, что в 3 колонке текст почему-то прорисовывается жирным стилем.
Y>Как с этим бороться?
Действительно такая проблема есть.
Можна решить ее так:
procedure TForm1.ListView1CustomDrawSubItem(Sender: TCustomListView;
Item: TListItem; SubItem: Integer; State: TCustomDrawState;
var DefaultDraw: Boolean);
var
aRect : TRect;
aCanvas : TCanvas;
K: Integer;
begin
if SubItem = 1 then
begin
{ вариант поточней вычислить прямоугольник }
aRect := Item.DisplayRect(drBounds);
aRect := Rect (0, aRect.Top, Sender.Column [SubItem].Width, aRect.Bottom);
for K := 0 to SubItem - 1 do
OffsetRect (aRect, Sender.Column [K].Width, 0); { может есть другой способ... }
aCanvas := TCanvas.Create;
try
{ делаем свою Canvas, борландовцы что то намутили (горе от ума :) ) }
aCanvas.Handle := GetDC (Sender.Handle);
try
aCanvas.Pen.Color := clBlack;
aCanvas.Pen.Style := psSolid;
aCanvas.Brush.Color := clGray;
aCanvas.Brush.Style := bsSolid;
aCanvas.FillRect(aRect);
aCanvas.Rectangle(aRect.Left, aRect.Top, aRect.Right, aRect.Bottom);
DefaultDraw := False;
finally
ReleaseDC(Sender.Handle, aCanvas.Handle);
aCanvas.Handle := 0;
end;
finally
aCanvas.Free;
end;
end;
end;
Удачи!
Здравствуйте, Danchik, Вы писали:
D>Здравствуйте, yaser, Вы писали:
D>[Skip]
Y>>Проблема в том, что в 3 колонке текст почему-то прорисовывается жирным стилем.
Y>>Как с этим бороться?
D>Действительно такая проблема есть.
D>Можна решить ее так:
D>D>procedure TForm1.ListView1CustomDrawSubItem(Sender: TCustomListView;
D> Item: TListItem; SubItem: Integer; State: TCustomDrawState;
D> var DefaultDraw: Boolean);
D>var
D> aRect : TRect;
D> aCanvas : TCanvas;
D> K: Integer;
D>begin
D> if SubItem = 1 then
D> begin
D> { вариант поточней вычислить прямоугольник }
D> aRect := Item.DisplayRect(drBounds);
D> aRect := Rect (0, aRect.Top, Sender.Column [SubItem].Width, aRect.Bottom);
D> for K := 0 to SubItem - 1 do
D> OffsetRect (aRect, Sender.Column [K].Width, 0); { может есть другой способ... }
D> aCanvas := TCanvas.Create;
D> try
D> { делаем свою Canvas, борландовцы что то намутили (горе от ума :) ) }
D> aCanvas.Handle := GetDC (Sender.Handle);
D> try
D> aCanvas.Pen.Color := clBlack;
D> aCanvas.Pen.Style := psSolid;
D> aCanvas.Brush.Color := clGray;
D> aCanvas.Brush.Style := bsSolid;
D> aCanvas.FillRect(aRect);
D> aCanvas.Rectangle(aRect.Left, aRect.Top, aRect.Right, aRect.Bottom);
D> DefaultDraw := False;
D> finally
D> ReleaseDC(Sender.Handle, aCanvas.Handle);
D> aCanvas.Handle := 0;
D> end;
D> finally
D> aCanvas.Free;
D> end;
D> end;
D>end;
D>
D>Удачи!
Спасибо огромное !!!!
1. А вы не знаете как сделать чтобы выделялся не ListItem, а полностью строка?
Здравствуйте, yaser, Вы писали:
[Skip]
Y>1. А вы не знаете как сделать чтобы выделялся не ListItem, а полностью строка?
Пропертя такая есть
ListView.RowSelect := True;
