Цвета границ в TListView (Delphi)

Я пытаюсь настроить цвет фона и цвет шрифта элемента ListView, используя событие OnCustomDrawItem. Однако цвет границы подэлемента всегда является цветом фона ListView. Кто-нибудь знает, как это исправить? Вот код, который я использую:

procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
var
  lst: TListView;
  i: integer;
  f1, f2, c1, c2: TColor;
begin
  if (TListView(Sender).ViewStyle = vsIcon) then
    Exit;
  lst := Sender as TListView;
  lst.Canvas.Brush.Style := bsSolid;
  i := lst.Items.Count;
  if (i mod 2) <> 0 then
  begin
    c1 := clWhite;
    c2 := $00F8F8F8;
    f1 := clBlue;
    f2 := clBlack;
  end else
  begin
    c1 := $00F8F8F8;
    c2 := clWhite;
    f1 := clBlack;
    f2 := clBlue;
  end;
  // Painting...
  if (Item.Index mod 2) = 0 then
  begin
    lst.Canvas.Brush.Color := c2;
    lst.Canvas.Font.Color := f2;
  end else
  begin
    lst.Canvas.Brush.Color := c1;
    lst.Canvas.Font.Color := f1;
  end;
end;

РЕДАКТИРОВАТЬ:

Между столбцами SubItems есть GAP. Этот GAP является цветом фона ListView.

Я использую Delphi XE2 и ОС: Windows 7 бит.


delphi tlistview
person blacksun    schedule 27.09.2012    source источник
comment
Подсказка: замените (Item.Index mod 2) = 0 на Odd(Item.Index) (или отрицание последнего утверждения).   -  person Andreas Rejbrand    schedule 27.09.2012
comment
Кстати, между столбцами подэлементов есть зазор... и этот зазор - цвет списка   -  person blacksun    schedule 27.09.2012
comment
Кстати, я использую XE2 и Win7 64bit   -  person blacksun    schedule 27.09.2012
comment
Вы уверены, что это не тема? По умолчанию приложения тематические. Возможно, вы подумали, что я спрашиваю, используете ли вы стили VCL. Если ваше приложение не тематическое, вам пришлось бы удалить манифест comctl32 v6. Ты сделал это?   -  person David Heffernan    schedule 27.09.2012
comment
Упс.. Тогда моя ошибка. Да, тематическая. Как я могу удалить эту тему из кода?   -  person blacksun    schedule 27.09.2012
comment
Хорошо, я удалил темы. Но теперь все приложения не тематические :)   -  person blacksun    schedule 27.09.2012
comment
Я не просил вас удалять темы. Я просто хотел узнать, тематическое ли ваше приложение. Теперь пользовательский рисунок тематических элементов управления очень трудно сделать правильно. Как правило, вы должны рисовать весь элемент управления самостоятельно. Использование API темы.   -  person David Heffernan    schedule 27.09.2012
comment
Хм.. Да, это сложно сделать   -  person blacksun    schedule 27.09.2012

Ответы (1)


arrow_upward
1
arrow_downward

Попробуйте OnAdvancedCustomDrawItem вместо вашей процедуры CustomDrawItem

procedure TForm1.ListView1AdvancedCustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
var DefaultDraw: Boolean);
var
  lst: TListView;
  i: integer;
  f1, f2, c1, c2: TColor;
  r: TRect;
begin
  if Stage = cdPostPaint then
  begin
    lst := Sender as TListView;
    lst.Canvas.Brush.Style := bsSolid;
    i := lst.Items.Count;
    if not Odd(i) then
    begin
      c1 := clWhite;
      c2 := $00F8F8F8;
      f1 := clBlue;
      f2 := clBlack;
    end else
    begin
      c1 := $00F8F8F8;
      c2 := clWhite;
      f1 := clBlack;
      f2 := clBlue;
    end;
    // Painting...
    if Odd(Item.Index) then
    begin
      lst.Canvas.Brush.Color := c2;
      lst.Canvas.Pen.Color := c2;
      lst.Canvas.Font.Color := f2;
    end else
    begin
      lst.Canvas.Brush.Color := c1;
      lst.Canvas.Pen.Color := c1;
      lst.Canvas.Font.Color := f1;
    end;

    r:=Item.DisplayRect(drBounds);

    if cdsSelected in State then
    begin
      lst.Canvas.Brush.Color:=clHighlight;
      lst.Canvas.Pen.Color:=clHighlight;
      lst.Canvas.Font.Color:=clBlack;
    end;

    lst.Canvas.Rectangle(r);

    if cdsSelected in State then
      lst.Canvas.DrawFocusRect(r);

    lst.Canvas.TextOut(r.Left, r.Top + (r.Bottom - r.top - lst.Canvas.TextHeight(Item.Caption)) div 2, Item.Caption);
    for i := 0 to Item.SubItems.Count - 1 do
    begin
      r.Left:=r.Left + lst.Columns[i].Width;
      lst.Canvas.TextOut(r.Left, r.Top + (r.Bottom - r.top - lst.Canvas.TextHeight(Item.Caption)) div 2, Item.SubItems[i]);
    end;
  end;
end;

Надеюсь это поможет.

person ibogolyubskiy    schedule 27.09.2012
comment
На самом деле это не работает так, как ожидалось. Все, что я хочу сделать, это избавиться от GAP, заполняемого цветом фона. - person blacksun; 27.09.2012