TListView OwnerDraw не рисуются SubItems

[JoLan]

На основе данной темы (http://programmersforum.ru/showthread.php?t=174029) сделал код для отрисовки списка ListView:

procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
const Colors: Array [0..1] of TColor = ($00202020, $00282828);
var mRect: TRect;
    i: Integer;
    S: String;
begin
  DefaultDraw := false;
  mRect := Item.DisplayRect(drLabel);
  mRect.Left := mRect.Left - 4;
  mRect.Right := mRect.Right +5;
  if cdsSelected in State then Sender.Canvas.Brush.Color := $00606060
                          else Sender.Canvas.Brush.Color := Colors[Item.Index mod 2];
  Sender.Canvas.FillRect(mRect);
  S := Item.SubItems[1];
  Sender.Canvas.Font.Color := GetColor(S);
  Sender.Canvas.TextRect(mRect,mRect.Left+3,mRect.Top+2,Item.Caption);
  for i:=1 to TListView(Sender).Columns.Count-1 do begin
    mRect.Left:=mRect.Right;
    mRect.Right:=mRect.Left+TListView(Sender).Columns.Items[i].Width-1;
    Sender.Canvas.FillRect(mRect);
    if i <> 2 then Sender.Canvas.TextRect(mRect, mRect.Left + 3, mRect.Top + 2, Item.SubItems[i-1])
              else Sender.Canvas.TextRect(mRect, mRect.Left + 3, mRect.Top + 2, S);
  end;
end;

Результат немного не устроил в плане изменения цвета текста всей строки. Нужно изменить цвет только 3-й колонки. Читал тему (http://programmersforum.ru/showthread.php?t=6090), где схожая проблема, но при данном решении сильно тормозит список. Пытался так же описывать отдельно CustomDrawItem и CustomDrawSubItem, но снова ничего не помогло, SubItems просто невидны.

[Аватар]

А в чем проблема? Sender.Canvas.Font.Color и используй для изменения цвета текста в колонках. Для колонки 3 делай как нужно, для остальных белый

[JoLan]

Сообщение от Аватар

А в чем проблема? Sender.Canvas.Font.Color и используй для изменения цвета текста в колонках. Для колонки 3 делай как нужно, для остальных белый

Для вышенаписанного кода не получилось бы, т.к. там цвет задается всей строке и рисуются не отдельно Item от Subitem. В общем-то данная проблема решилась. Но вышли новые проблемы: если Item перекрывает фокусное выделение, то SubItem рисуются под ним:



И еще 1 неприятная вещь: при наведении курсора на выделенную строку через 1 секунду область под курсором и сам Item закрашиваются



Код отрисовки Item:

procedure TForm1.ListView1AdvancedCustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
  var DefaultDraw: Boolean);
const Colors: Array [0..1] of TColor = ($00202020, $00282828);
var mRect: TRect;
begin
  DefaultDraw := true;
  mRect := Item.DisplayRect(drLabel);
  mRect.Left := mRect.Left - 4;
  mRect.Right := mRect.Right + 4;
  with Sender.Canvas do begin
    Brush.Color := Colors[Item.Index mod 2];
    Font.Color := clWhite;
    if cdsSelected in State then Brush.Color := $00404040;
    FillRect(mRect);
    TextRect(mRect,mRect.Left + 6, mRect.Top +2, Item.Caption);
  end;
end;

SubItem:

procedure TForm1.ListView1AdvancedCustomDrawSubItem(Sender: TCustomListView;
  Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  Stage: TCustomDrawStage; var DefaultDraw: Boolean);
const Colors: Array [0..1] of TColor = ($00202020, $00282828);
var mRect: TRect;
    i: Integer;
    S: String;
begin
  DefaultDraw := true;
  mRect := Item.DisplayRect(drLabel);
  for i := SubItem-1 downto 0 do mRect.Left := mRect.Left + Sender.Column[i].Width;
  mRect.Right := mRect.Left + Sender.Column[SubItem].Width;
  with Sender.Canvas do begin
    Brush.Color := Colors[Item.Index mod 2];
    if SubItem = 2 then begin
      S := Item.SubItems[SubItem-1];
      Font.Color := GetColor(S);
    end else Font.Color := clWhite;
    if SubItem = 7 then if Item.SubItems[SubItem-1] <> '0' then Font.Color := clLime
                                                           else Font.Color := clWhite;
    if cdsSelected in State then Brush.Color := $00404040;
    FillRect(mRect);
    if SubItem = 2 then TextRect(mRect,mRect.Left + 2, mRect.Top +2, S)
                   else TextRect(mRect,mRect.Left + 2, mRect.Top +2, Item.SubItems[SubItem-1]);
  end;
end;

[Аватар]

В примере из #1 для прорисовки текста Rect меняете в цикле. Что мешает в этом же обработчике в этом же цикле и фон прорисовывать разным цветом?

[JoLan]

Тогда по событию CustomDrawSubItem не рисуется текст. Выводить текст в SubItems по отрисовке Item - получится пример #1. Замкнутый круг.

[Аватар]

GetColor(S) из #1 используйте только для прорисовки текста в нужной колонке, в остальных - белый в вашем случае. Это же можно определить по индексу субитема. Тогда CustomDrawItem будет достаточно без AdvancedCustomDraw. И в чем необходимость FillRect в цикле? Фон уже прорисован выше по коду

[JoLan]

    if i <> 2 then begin
      Sender.Canvas.Font.Color := clWhite;
      Sender.Canvas.TextRect(mRect, mRect.Left + 3, mRect.Top + 2, Item.SubItems[i-1]);
    end else begin
      Sender.Canvas.Font.Color := clLime;
      Sender.Canvas.TextRect(mRect, mRect.Left + 3, mRect.Top + 2, Item.SubItems[i-1]);
    end;

Если Вы имели ввиду примерно это, то рисует все равно только белым.

Сообщение от Аватар

И в чем необходимость FillRect в цикле? Фон уже прорисован выше по коду

Это уже вопрос говнокодности.

[Аватар]

Почему у меня получается

procedure TForm1.ListView1DrawItem(Sender: TCustomListView; Item: TListItem; Rect: TRect; State: TOwnerDrawState);
const Colors: Array [0..1] of TColor = ($00202020, $00282828);
var mRect: TRect;
    i: Integer;
    S: String;
    xColor: TColor;
begin
  mRect := Item.DisplayRect(drLabel);
  mRect.Left := mRect.Left - 4;
  mRect.Right := mRect.Right +5;
  if odSelected in State then Sender.Canvas.Brush.Color := $00606060
                         else Sender.Canvas.Brush.Color := Colors[Item.Index mod 2];
  Sender.Canvas.FillRect(mRect);
  Sender.Canvas.Font.Color:=clWindow;
  Sender.Canvas.TextRect(mRect,mRect.Left+3,mRect.Top+2,Item.Caption);
  for i:=1 to TListView(Sender).Columns.Count-1 do begin
    mRect.Left:=mRect.Right;
    mRect.Right:=mRect.Left+TListView(Sender).Columns.Items[i].Width-1;
    if (i=2) and (Item.Caption='47') then xColor:=clRed else xColor:=clWindow;
    Sender.Canvas.Font.Color:=xColor;
    Sender.Canvas.TextRect(mRect, mRect.Left + 3, mRect.Top + 2,Item.SubItems[i-1]);
  end;
end;

[JoLan]

Спасибо огромное. Через DrawItem получилось.

[UFO 007]

Доброго всем времени суток!

procedure TForm1.lvResultAdvancedCustomDrawSubItem(Sender: TCustomListView;
  Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  Stage: TCustomDrawStage; var DefaultDraw: Boolean);
var 
  mRect: TRect;
  i: Integer;
  bCol, fCol: TColor;
begin
  DefaultDraw := true;
  mRect := Item.DisplayRect(drLabel);
  for i := SubItem-1 downto 0 do
  mRect.Left := mRect.Left + Sender.Column[i].Width;
  mRect.Right := mRect.Left + Sender.Column[SubItem-1].Width;
  if Item.SubItems[SubItem-1] = '789' then
  with Sender.Canvas do
  begin
    bCol:= Brush.Color;
    fCol:= Font.Color;
    Font.Color := clWhite;
    Brush.Color := $00202020;
    if cdsSelected in State then Brush.Color := $00404040;
    FillRect(mRect);                      
    DrawText(Handle, PChar(Item.SubItems[SubItem -1]), -1, mRect,  DT_VCENTER );
    Brush.Color:= bCol;
    Font.Color:= fCol;
  end;
end;

инвертирует в СубАйтеме с искомым текстом Бруш и Фонт Колоры (что, собсно, и требовалось) но в СубАйтеме, следующем за выделенным, текст отображается жирным шрифтом - т.е. в соответствии со скриншотом выше СубАйтем с символами "20000" имеет

lvResult.Font.Style:= [fsBold];

а остальное всё О,К.
Вопрос: как избавиться?

lvResult.Font.Style:= [];

не помогает...
Заранее Благодарен.