开发者

drawn thumbnails in tlistbox

In DelphiXE, I'm using a tFileOpenDialog to select a folder and then listing all the *.jpg files in that folder in a tListBox. I'm allowing the list items to be dragged and dropped within the list for custom sorting so that I can display them in order later.

I'd like to be able to draw a thumbnail of the image beside the filename so that the display is similar to Windows Explorer when looking at files in List view where you have the associated icon just left of the file name on the same row.

I've found a couple of old examples that lead me to believe this is possible using tListBox.onDrawItem, but I've been unable to get one to work.

What is the best approach to take to accomplish this goal using a tListBox, or by some other means?

Thanks for your help.


Update: I've been working to use tListView instead, as suggested.

I've attempted to convert the examples from Ken and Andreas to use actual images instead of dynamically created sample bitmaps. I was able to get the basics working, but without resizing, I get only the top left of the image 64*64. I'm only working with JPGs at this point. imagecount is just the count of my list of filenames in my listbox, I haven't moved the initial list creation into the listview at this point.

That is done with this code:

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;

In order to also resize and stretch the image properly within the thumbnail, I'm trying to implement some code from here: http://delphi.about.com/od/graphics/a/resize_image.htm

The new code looks like:


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; thum开发者_StackOverflowbs[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;

This gives me a collage of image thumbnails with their filenames and works good.

Thank you.


Not an answer, but an alternative (using Andreas' code for creating the image array as a starting point). Drop a TListView and a TImageList on a new form, cut all the code from the editor from the interface to just above the final end. with this:

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;

drawn thumbnails in tlistbox


OnDrawItem is a good way to go.

Simple example:

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;

In a real-world scenario, the thumbs array would contain the actual image thumbs. In this example, however, the "thumbnails" consist of single-colour squares.

drawn thumbnails in tlistbox

0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜