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;
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.
精彩评论