Блог

Главная - Вопросы по программированию - Просмотр списка в режиме vsReport, изменение цвета элементов и строк

Просмотр списка в режиме vsReport, изменение цвета элементов и строк

#delphi #listview #colors #row #brush

#delphi #просмотр списка #Цвет #строка #кисть

Вопрос:

Я хочу покрасить одну строку в серый, а другую в белый.
У меня есть следующий код, но в Windows 7 есть пробелы между вертикальными линиями столбцов.
Как мне раскрасить все строки?

 procedure TForm2.Update_ListBoxCustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
 if Item.Index mod 2=0
 then
  begin
   Sender.Canvas.Font.Color:=clBlack;
   Sender.Canvas.Brush.Color:=$F6F6F6;
  end
 else
  begin
   Sender.Canvas.Font.Color:=clBlack;
   Sender.Canvas.Brush.Color:=clWhite;
  end;
end;

Комментарии:

1. Я объединил ваши две учетные записи вместе. Пожалуйста, прочтите эту запись часто задаваемых вопросов об учетных записях на основе файлов cookie.

Ответ №1:

Установите OwnerDraw в true и добавьте

 procedure TForm1.ListView1DrawItem(Sender: TCustomListView; Item: TListItem;
  Rect: TRect; State: TOwnerDrawState);
var
  i: Integer;
  x1, x2: integer;
  r: TRect;
  S: string;
const
  DT_ALIGN: array[TAlignment] of integer = (DT_LEFT, DT_RIGHT, DT_CENTER);
begin
  if Odd(Item.Index) then
  begin
    Sender.Canvas.Font.Color := clBlack;
    Sender.Canvas.Brush.Color := $F6F6F6;
  end
  else
  begin
    Sender.Canvas.Font.Color := clBlack;
    Sender.Canvas.Brush.Color := clWhite;
  end;
  Sender.Canvas.Brush.Style := bsSolid;
  Sender.Canvas.FillRect(Rect);
  x1 := 0;
  x2 := 0;
  r := Rect;
  Sender.Canvas.Brush.Style := bsClear;
  for i := 0 to ListView1.Columns.Count - 1 do
  begin
    inc(x2, ListView1.Columns[i].Width);
    r.Left := x1;
    r.Right := x2;
    if i = 0 then
      S := Item.Caption
    else
      S := Item.SubItems[i - 1];
    DrawText(Sender.Canvas.Handle,
      S,
      length(S),
      r,
      DT_SINGLELINE or DT_ALIGN[ListView1.Columns[i].Alignment] or
        DT_VCENTER or DT_END_ELLIPSIS);
    x1 := x2;
  end;
end;

Скриншот

В приведенном выше примере первый столбец выровнен по левому краю, а два других расположены по центру.

Если у вас есть только один столбец, то есть нет подпунктов:

 procedure TForm1.ListView1DrawItem(Sender: TCustomListView; Item: TListItem;
  Rect: TRect; State: TOwnerDrawState);
var
  r: TRect;
  S: string;
const
  DT_ALIGN: array[TAlignment] of integer = (DT_LEFT, DT_RIGHT, DT_CENTER);
begin
  if odd(Item.Index) then
  begin
    Sender.Canvas.Font.Color:=clBlack;
    Sender.Canvas.Brush.Color:=$F6F6F6;
  end
  else
  begin
    Sender.Canvas.Font.Color:=clBlack;
    Sender.Canvas.Brush.Color:=clWhite;
  end;
  Sender.Canvas.Brush.Style := bsSolid;
  Sender.Canvas.FillRect(Rect);
  r := Rect;
  Sender.Canvas.Brush.Style := bsClear;
  S := Item.Caption;
  DrawText(Sender.Canvas.Handle,
    S,
    length(S),
    r,
    DT_SINGLELINE or DT_ALIGN[ListView1.Columns[0].Alignment] or DT_VCENTER or DT_END_ELLIPSIS);
end;

Комментарии:

1. В этом есть немного больше (и что именно это такое, зависит от вашей конкретной ситуации), но, по крайней мере, это должно помочь вам начать.

2. если у меня нет текста в подпункте, что делать? И как нарисовать изображение для элемента? Спасибо.

3. Если у вас нет никаких подпунктов, у вас есть только один столбец. Тогда это еще проще. Вы просто удаляете несколько строк кода выше.

4. Пожалуйста, помогите мне сделать это, если у меня есть подпункты, которые можно не заполнять текстом у элементов есть значки. Спасибо!

5. Я подумал, что это заслуживает комментария — строка: ‘S:= Item. Подпункты [i];’ должно быть ‘S := Item. Подпункты [i-1];’ В противном случае вы получите ошибки индекса списка.