如何将 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.Width
和 Image1.Height
是 TImage
控件的维度。它们与 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;
我正在尝试创建一个包含图像的列表框。图像将从 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.Width
和 Image1.Height
是 TImage
控件的维度。它们与 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;