Delphi: ошибка при изменении размера столбцов представления списка (на DrawItem)

Включите автоматический размер столбцов и включите OwnerDraw для представления списка. Затем добавьте код ниже ЗДЕСЬ:

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 SameText(Item.SubItems[1], 'done') then
  begin
      Sender.Canvas.Font.Color := clWhite;
      Sender.Canvas.Brush.Color := clGreen;
  end
  else
    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;
  if odSelected in State then                                                    // NEW!
  begin                                                                          // NEW!
    Sender.Canvas.Font.Color := clWhite;                                         // NEW!
    Sender.Canvas.Brush.Color := clNavy;                                         // NEW!
  end;                                                                           // NEW!
  Sender.Canvas.Brush.Style := bsSolid;
  Sender.Canvas.FillRect(Rect);
  x1 := 0;
  x2 := 0;
  r := Rect;
  Sender.Canvas.Brush.Style := bsClear;
  Sender.Canvas.Draw(3, r.Top + (r.Bottom - r.Top - bm.Height) div 2, bm);
  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
    begin
      S := Item.Caption;
      r.Left := bm.Width + 6;
    end
    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;
  if odFocused in State then                                                     // NEW!
    DrawFocusRect(Sender.Canvas.Handle, Rect);                                   // NEW!
end;

Активно измените размер предпоследнего столбца, если он имеет автоматический размер. Это могут быть ошибки:

введите здесь описание изображениявведите здесь описание изображения введите здесь описание изображениявведите здесь описание изображения

Как предотвратить эти ошибки?

Спасибо!


person maxfax    schedule 08.07.2011    source источник
comment
В чем вопрос? Это будут баги недостаточно конкретно.   -  person David Heffernan    schedule 09.07.2011
comment
Я не знаю, как это точно описать. Они на картинке. Видеть?   -  person maxfax    schedule 09.07.2011
comment
Я вижу картину. Я не знаю, что не так.   -  person David Heffernan    schedule 09.07.2011
comment
если авторазмер отключен то все будет ок   -  person maxfax    schedule 09.07.2011
comment
@David: Я не думаю, что с моим (как это бывает ...) кодом вообще что-то не так, с «теоретической» точки зрения. Вместо этого я думаю, что пользовательское рисование плохо поддерживается операционной системой, по крайней мере, с момента появления визуальных тем. Я думаю, вы также знакомы с неизбежным багом с «черной подсветкой», который появляется, как только кто-то выполняет какой-либо пользовательский рисунок в TListView.   -  person Andreas Rejbrand    schedule 09.07.2011
comment
@Andreas Андреас Я ожидаю, что для пользовательского рисования следует использовать API темы. Но ввязываться в это дело неприятное. Классическим примером является тотальный аборт VistaDraw от Menus.pas. Я потратил последние 6 месяцев на исправление ошибок, пока вчера я, наконец, не создал красивое решение и не допустил, чтобы оно не запускалось, а система рисовала меню в моем приложении. Документация по API темы дьявольски плоха.   -  person David Heffernan    schedule 09.07.2011
comment
Нет ли в Delphi нормального способа рисовать строки без пробелов? Без багов? Многие программы используют этот эффект, а сделать это оказалось невозможно...   -  person maxfax    schedule 09.07.2011
comment
Я могу продублировать проблему без тем, я думаю, это связано только с функцией «AutoSize» TListColumns, с ОС проблем нет.   -  person Sertac Akyuz    schedule 09.07.2011
comment
@Sertac: Кажется, ты был прав.   -  person Andreas Rejbrand    schedule 09.07.2011


Ответы (1)


Ошибка находится в файле TListColumn.GetWidthin 'comctrls.pas'. VCL извлекает неправильную ширину столбца при изменении размера столбцов, когда для столбцов установлен параметр «Авторазмер», поэтому вы рисуете текст элемента во всех столбцах.

Я несколько минут смотрел на код VCL и не мог понять, что не так, но установка значения в геттере достаточно подозрительна.

Во всяком случае, для обходного пути вместо

inc(x2, ListView1.Columns[i].Width);

использовать это:

inc(x2, ListView_GetColumnWidth(ListView1.Handle, ListView1.Columns[i].Index));
person Sertac Akyuz    schedule 08.07.2011
comment
ListView_GetColumnWidth находится в ComCtrls. Но в моей программе это необъявленный идентификатор - person maxfax; 09.07.2011
comment
@maxfax - Извините, включите «commctrl» в пункт использования. - person Sertac Akyuz; 09.07.2011
comment
@maxfax: добавьте CommCtrl в список uses. - person Andreas Rejbrand; 09.07.2011
comment
Эй, ребята, что тут сказать... таланты! - person maxfax; 09.07.2011