如何将 TImage 中的图像绘制到 TListbox 中?

How to draw image from TImage into TListbox?

我正在尝试创建一个包含图像的列表框。图像将从 TImage 组件中获取;我不想使用 TImageList,因为 TImage 可以处理很多图像类型(png、gif、jpg),而且我不必转换它来填充图像列表。

所以我将我的列表框样式设置为 lbOwnerDrawVariable 并且我正在尝试将 TImage 中的图像绘制到列表框中。我已将 Image1 的宽度和高度设置为 50,因为这是我希望图像在列表框中具有的大小。

这是我的代码:

procedure TForm2.listbox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  CenterText: Integer;
begin
  listbox1.Canvas.FillRect(Rect);
  listbox1.Canvas.draw(rect.Left+4,rect.Top+4,image1.Picture.graphic);
  CenterText := (Rect.Bottom - Rect.top - listbox1.Canvas.TextHeight(text)) div 2;
  listbox1.Canvas.TextOut(Rect.left + 58, Rect.top + CenterText, listbox1.Items.Strings[index]);
end;

但是它没有将图像放在每个列表框项目中,而是在列表框本身内部绘制了很多图像,其原始大小不是 50...我的代码有什么问题?

Image1.WidthImage1.HeightTImage 控件的维度。它们与 Image1.Picture.

的尺寸无关

您需要 stretch-draw 图片或 pre-scale 它。

只是一个非常快速和肮脏的例子:

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
begin

  if Control <> ListBox1 then
    Exit;

  if Index = -1 then
    Exit;

  var C := ListBox1.Canvas;

  C.Brush.Color := clWindow;
  C.Font.Color := clWindowText;
  C.FillRect(Rect);

  var R := Rect;
  var S := ListBox1.Items[Index];

  var G := Image1.Picture.Graphic;

  var scale := 1.0;

  if (G.Width > 0) and (G.Height > 0) then
  begin

    var xscale := R.Width / G.Width;
    var yscale := R.Height / G.Height;
    scale := Min(xscale, yscale);

    R.Width := Round(G.Width * scale);
    R.Height := Round(G.Height * scale);

    C.StretchDraw(R, G);

  end;

  R := Rect;
  R.Left := R.Left + Round(G.Width * scale) + C.TextWidth('0');
  C.TextRect(R, S, [tfSingleLine, tfVerticalCenter, tfEndEllipsis]);

end;