Question

在DelphiXE中，我使用tFileOpenDialog选择文件夹，然后在tListBox中列出该文件夹中的所有* .jpg文件。我允许在列表中拖放列表项以进行自定义排序，以便我可以在以后按顺序显示它们。

我希望能够在文件名旁边绘制图像的缩略图，以便在查看列表视图中的文件时显示类似于Windows资源管理器，其中您在文件名左侧有关联的图标同一行。

我发现了一些旧的例子让我相信使用tListBox.onDrawItem是可能的，但我一直无法让它工作。

使用tListBox或其他方法实现此目标的最佳方法是什么？

感谢您的帮助。

更新：我一直在努力使用tListView，如建议的那样。

我试图将Ken和Andreas的示例转换为使用实际图像而不是动态创建的示例位图。我能够使基本工作正常，但没有调整大小，我只得到图像的左上角64 * 64。我现在只与JPG合作。 imagecount只是我列表框中文件名列表的计数，此时我还没有将初始列表创建移动到列表视图中。

使用此代码完成：

procedure TfrmMain.CreateThumbnails;
var
  i: Integer;
  FJpeg: TJpegImage;
  R: TRect;
begin
  for i := 0 to imageCount - 1 do
  begin
    FJpeg := TJpegImage.Create;
    thumbs[i] := TBitmap.Create;
    FJpeg.LoadFromFile(Concat(imgFolderlabel.caption,
      photoList.Items.Strings[i]));
    thumbs[i].Assign(FJpeg);
    thumbs[i].SetSize(64, 64); 
  end;
  imgListView.LargeImages := ImageList1;
  FJpeg.Free;
end;

为了在缩略图中正确调整图像大小并进行拉伸，我正在尝试从这里实现一些代码：http://delphi.about.com/od/graphics/a/resize_image.htm

新代码如下：


procedure TfrmMain.CreateThumbnails;
var
  i: Integer;
  FJpeg: TJpegImage;
  R: TRect;
begin
  for i := 0 to imageCount - 1 do
  begin
      FJpeg := TJpegImage.Create;
      thumbs[i] := TBitmap.Create;
      FJpeg.LoadFromFile(Concat(imgFolderlabel.caption,
        photoList.Items.Strings[i]));
      thumbs[i].Assign(FJpeg);

      //resize code
      R.Left := 0;
      R.Top := 0;
      // proportional resize
      if thumbs[i].Width > thumbs[i].Height then
      begin
        R.Right := 64;
        R.Bottom := (64 * thumbs[i].Height) div thumbs[i].Width;
      end
      else
      begin
        R.Bottom := 64;
        R.Right := (64 * thumbs[i].Width) div thumbs[i].Height;
      end;
      thumbs[i].Canvas.StretchDraw(R, thumbs[i]);
      // resize image
      //thumbs[i].Width := R.Right;
      //thumbs[i].Height := R.Bottom;

      thumbs[i].SetSize(64, 64); //all images must be same size for listview

  end;
  imgListView.LargeImages := ImageList1;
  FJpeg.Free;
end;

这为我提供了一个带有文件名的图像缩略图拼贴，效果很好。

谢谢。

Answer 1

不是答案，而是替代方案（使用安德里亚斯的代码创建图像数组作为起点）。在新表单上删除TListView和TImageList，将编辑器中的所有代码从interface切换到最终end.正上方：

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ImgList, ComCtrls;

type
  TForm1 = class(TForm)
    ImageList1: TImageList;
    ListView1: TListView;
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    procedure CreateListItems;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  N = 50;
  THUMB_WIDTH = 32;
  THUMB_HEIGHT = 32;
  THUMB_PADDING = 4;

var
  thumbs: array[0..N-1] of TBitmap;

procedure CreateThumbnails;
var
  i: Integer;
begin
  for i := 0 to N - 1 do
  begin
    thumbs[i] := TBitmap.Create;
    thumbs[i].SetSize(THUMB_WIDTH, THUMB_HEIGHT);
    thumbs[i].Canvas.Brush.Color := RGB(Random(255), Random(255), Random(255));
    thumbs[i].Canvas.FillRect(Rect(0, 0, THUMB_WIDTH, THUMB_HEIGHT));
  end;
end;


procedure TForm1.CreateListItems;
var
  i: Integer;
begin
  for i := 0 to N - 1 do
  begin
    with ListView1.Items.Add do
    begin
      Caption := 'Item ' + IntToStr(i);
      ImageIndex := i;
    end;
  end;
end;

procedure TForm1.FormShow(Sender: TObject);
var
  i: Integer;
begin
  CreateThumbnails;
  for i := 0 to N - 1 do
    ImageList1.Add(thumbs[i], nil);
  ListView1.LargeImages := ImageList1;
  CreateListItems;
end;

enter image description here

Answer 2

OnDrawItem是一个很好的方式。

简单示例：

const
  N = 50;
  THUMB_WIDTH = 64;
  THUMB_HEIGHT = 64;
  THUMB_PADDING = 4;

var
  thumbs: array[0..N-1] of TBitmap;

procedure CreateThumbnails;
var
  i: Integer;
begin
  for i := 0 to N - 1 do
  begin
    thumbs[i] := TBitmap.Create;
    thumbs[i].SetSize(THUMB_WIDTH, THUMB_HEIGHT);
    thumbs[i].Canvas.Brush.Color := RGB(Random(255), Random(255), Random(255));
    thumbs[i].Canvas.FillRect(Rect(0, 0, THUMB_WIDTH, THUMB_HEIGHT));
  end;
end;

procedure TForm4.FormCreate(Sender: TObject);
var
  i: integer;
begin
  with ListBox1.Items do
  begin
    BeginUpdate;
    for i := 0 to N - 1 do
      Add(Format('This is item %d.', [i]));
    EndUpdate;
  end;
  ListBox1.ItemHeight := 2*THUMB_PADDING + THUMB_HEIGHT;
  CreateThumbnails;
end;

procedure TForm4.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  dc: HDC;
  s: string;
  r: TRect;
begin
  dc := TListBox(Control).Canvas.Handle;
  s := TListBox(Control).Items[Index];
  FillRect(dc, Rect, GetStockObject(WHITE_BRUSH));
  BitBlt(dc,
    Rect.Left + THUMB_PADDING,
    Rect.Top + THUMB_PADDING,
    THUMB_WIDTH,
    THUMB_HEIGHT,
    thumbs[Index].Canvas.Handle,
    0,
    0,
    SRCCOPY);
  r := Rect;
  r.Left := Rect.Left + 2*THUMB_PADDING + THUMB_WIDTH;
  DrawText(dc,
    PChar(s),
    length(s),
    r,
    DT_SINGLELINE or DT_VCENTER or DT_LEFT or DT_END_ELLIPSIS);
end;

在实际场景中，thumbs数组将包含实际的图像大拇指。但是，在此示例中，“缩略图”由单色方块组成。

http://privat.rejbrand.se/listviewthumbs.png

在tlistbox中绘制缩略图

2 个答案: