Delphi: вручную отображать вид списка при наличии горизонтальной полосы - PullRequest
Новая
       9

Delphi: вручную отображать вид списка при наличии горизонтальной полосы

3 голосов
/ 25 августа 2011

Я рисую элементы списка в виде OwnerDraw, но у меня есть ошибки: пожалуйста, измените размер столбца -> у вас будет горизонтальная полоса, прокрутите ее -> элементы отображаются на видимой области: (

Пожалуйста, помогите мне отредактировать код ниже. Спасибо за ваше внимание и помощь !!!

Добавлено:

Я проверил, Rect.Right и Rect.Left увеличиваются / уменьшаются во время прокрутки. Например, мыпрокрутка вправо на 50 пикселей, Rect.Right будет Rect.Right + 50, Rect.Left будет -50 (0-50)

Обычный вид:

enter image description here

Ошибки:

enter image description here enter image description here

procedure TDownloadFrame.DownloadListDrawItem(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 odSelected in State then
  begin
    Sender.Canvas.Font.Color := clWhite;
    Sender.Canvas.Brush.Color := $00FF8000;
  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;
  MainForm.Icons_16x16.Draw(DownloadList.Canvas, 3, R.Top + (R.Bottom - R.Top - 16) div 2, 1, true);
  for i := 0 to DownloadList.Columns.Count - 1 do
  begin
    Inc(x2, ListView_GetColumnWidth(DownloadList.Handle,
      DownloadList.Columns[i].Index));
    R.Left := x1;
    R.Right := x2;
    if i = 0 then
    begin
      s := Item.Caption;
      R.Left := 16 + 6;
    end
    else
      s := Item.SubItems[i - 1];
    if i <> 3 then
    DrawText(Sender.Canvas.Handle, s, length(s), R, DT_SINGLELINE or
      DT_ALIGN[DownloadList.Columns[i].Alignment] or DT_VCENTER or
      DT_END_ELLIPSIS);
    x1 := x2;
  end;
end;

Ответы [ 2 ]

1 голос
/ 26 августа 2011

Изменение:

1) 

  x1 := 0;
  x2 := 0;

на 

  x1 := Rect.Left;
  x2 := Rect.Left;

2) 

MainForm.Icons_16x16.Draw(DownloadList.Canvas, 3, R.Top + (R.Bottom - R.Top - 16) div 2, 1, true);

на 

MainForm.Icons_16x16.Draw(DownloadList.Canvas, R.Left+3, R.Top + (R.Bottom - R.Top - 16) div 2, ImgIndex, true);

3) 

if i = 0 then
begin
  s := Item.Caption;
  R.Left := 16 + 6;
end

до 

 if i = 0 then
    begin
      s := Item.Caption;
      R.Left := R.Left + 16 + 6;
    end
1 голос
/ 26 августа 2011

Недавно я столкнулся с ошибкой в ​​VCL, когда если бы я рисовал элемент ListItem с изображением, тогда холст списка больше не учитывал бы цвет шрифта, размер шрифта или изменения шрифта Sender.Canvas.Font: 

Sender.Canvas.Font.Color := clHighlightText;
Sender.Canvas.Font.Size := 14;
Sender.Canvas.Font.Name := 'Consolas';

... никто не будет работать. Это перестало бы работать, только если я впервые нарисовал на холсте, используя: 

imageList.Draw(Sender.Canvas, ....);

Если я удалил imageList.Draw, все было в порядке.

Я был вынужден установить шрифт и цвета, используя GDI напрямую: 

savedDC := SaveDC(Sender.Canvas.Handle);
try
   SetTextColor(Sender.Canvas.Handle, clHighlightText); //don't use clWhite, use the correct color

   newfont := TFont.Create;
   try
      newFont.Assign(Sender.Canvas.Font);
      newFont.Name := 'Consolas';
      newfont.Size := 14;
      SelectObject(Sender.Canvas.Handle, newFont.Handle);  


      szText = 'Hello, world!';

      TextOut(Sender.Canvas.Handle, 0, 0, PChar(szText), Length(szText));
   finally
      newFont.Free;
   end;
finally
   RestoreDC(Sender.Canvas.Handle, savedDC);
end;

Примечание : любой код публикуется в открытом доступе. Указание авторства не требуется.

...