В TListView, TextOut не прорисовывает цвета.

← →
JetAPI © (2007-08-15 22:50) [0]

Помогите пожалуйста, самому справиться не получается!
Перепробывал всё... и сдался!
На форме лежит TListView,.. и всё. Вот код:

. . .
uses CommCtrl;

procedure TForm1.FormCreate(Sender: TObject);
var i,j: Byte;
begin
Form1.Width := 650;
ListView1.ViewStyle := vsReport;
ListView1.GridLines := True;
ListView1.Width := 500;
for i:=0 to 2 do begin
ListView1.Columns.Add.Width:=150;
ListView1.Column[i].Caption:="Колонка "+IntToStr(i+1);
end;
for i:=0 to 3 do begin
ListView1.Items.Add.Caption:="Итем "+IntToStr(i+1);
for j:=0 to 1 do
ListView1.Items.Item[i].SubItems.Add("Сабитем "+IntToStr(j+1));
end;
end;

procedure TForm1.ListView1AdvancedCustomDrawSubItem(Sender: TCustomListView;
Item: TListItem; SubItem: Integer; State: TCustomDrawState;
Stage: TCustomDrawStage; var DefaultDraw: Boolean);
var R: TRect;
begin
if (item.Index = 1) and (SubItem = 1) then begin
DefaultDraw:=false;
ListView_GetSubItemRect(ListView1.Handle,Item.Index,SubItem,LVIR_BOUNDS,@R);
with Sender.Canvas do begin
Font.Color:=clBlue;
TextOut(R.Left + 6, R.Top, "01");
Font.Color:=clLime;
TextOut(R.Left + 26, R.Top, "02");
Font.Color:=clRed;
TextOut(R.Left + 46, R.Top, "03");
end;
end;
if Assigned(Sender.Canvas.Font.OnChange) then
Sender.Canvas.Font.OnChange(Sender.Canvas.Font);
end;

При запуске, программа, в отдельно взятом SubItem"е, должна нарисовать разными цветами: 01 02 03, но не рисует... Рисует, только одним цветом - clBlue.

В общем горе мне одно с этим TListView! Прошу очень помочь.
Спасибо всем.

← →
JetAPI © (2007-08-15 22:58) [1]

Если ничего так и не смогу решить, придется идти путем наименьшего сопротивления. Но мне этого, не хотелось бы больше всего - искать обхода и уклонятся от сути.
Если "имплантировать" в SubIten TLabel или TTPaintBox...
Но это тогда катастрофат, если, в каждый SubItem, вставлять TLabel или TPaintBox

В TListView, TextOut не прорисовывает цвета. Найти похожие ветки