JPersinger
asked on
Image (thumbnail size) populates a grid
Greetings -
I see lots of questions and answers regarding images in string grids, but my problem is a little differnt.
My application will be used as CD-ROM application. On the CD will be pictures from 1-30 in count. I need a grid that will automatically pick up the images from the cd (autorun will be used to open the application), make a thumbnail size image and place it in a string grid. Then when the user clicks the thumbnail image, a new form gets created and is sized to the image pixels.
Any ideas? I need samples or examples, please.
Jim
I see lots of questions and answers regarding images in string grids, but my problem is a little differnt.
My application will be used as CD-ROM application. On the CD will be pictures from 1-30 in count. I need a grid that will automatically pick up the images from the cd (autorun will be used to open the application), make a thumbnail size image and place it in a string grid. Then when the user clicks the thumbnail image, a new form gets created and is sized to the image pixels.
Any ideas? I need samples or examples, please.
Jim
listening
hello JPersinger, I made an App that would scan a Folder and display the Images there as thumbnails. I used a TDrawGrid, which I thought was more suited to graphics display. Here is some code I fished out of this app. I did NOT run this code, I just copied and pasted parts that I thought you might could get an Idea from. So some of the begins may not have an end. I Get the Folder files I want in FileListBox2.
type
PicRec = record
Path: String[255];
Name: String[64];
Sort: String[16];
Size: Cardinal;
Jsize: Integer;
Width, Height, PicIndex, PicInfo: Word;
Ext: PicExt;
WriteTime: TFileTime;
end;
var
ThisAlb: Array of PicRec;
ThisAlb2: Array of TJPEGImage;
Num: Integer;
Adding: Boolean;
procedure TfrmAlbum.ThumbNail(Pic1: TPicture; var ThumBmp: TBitmap);
var
Bmp1: TBitmap;
begin
ThumBmp.PixelFormat := pf24Bit;
if (Pic1.Width < Dimention) and (Pic1.Height < Dimention) then
begin // 1
ThumBmp.Height := Pic1.Height;
ThumBmp.Width := Pic1.Width;
end // 1
else
if Pic1.Width < Pic1.Height then
begin // 2
ThumBmp.Height := Dimention;
ThumBmp.Width := Trunc(Dimention / (Pic1.Height / Pic1.Width))+2;
end else // 2
if Pic1.Width > Pic1.Height then
begin // 3
ThumBmp.Width := Dimention;
ThumBmp.Height := Trunc(Dimention / (Pic1.Width / Pic1.Height))+2;
end else // 3
{if Pic1.Width = Pic1.Height then}
begin // 4
ThumBmp.Width := Dimention;
ThumBmp.Height := Dimention;
end; // 4
if Pic1.Graphic.ClassType = TGIFImage then
begin
Bmp1 := TBitmap.Create;
Bmp1.Width := Pic1.Width;
Bmp1.Height := Pic1.Height;
Bmp1.Assign(Pic1.Graphic);
ThumBmp.Canvas.StretchDraw (Rect(0,0, ThumBmp.Wi dth,ThumBm p.Height), Bmp1);
FreeAndNil(Bmp1);
end else
ThumBmp.Canvas.StretchDraw (Rect(0,0, ThumBmp.Wi dth,ThumBm p.Height), Pic1.Graphic);
end;
Procedure TfrmAlbum.AddImage(ImagePa th: String);
var
GotImage: Boolean;
LoadPic: TPicture;
PicT: TBitmap;
begin
GotImage := True;
LoadPic := TPicture.Create;
try
LoadPic.LoadFromFile(Image Path);
except
on E: Exception do
begin
GotImage := False;
end;
end;
if GotImage then
begin
PicT := TBitmap.Create;
ThumbNail(LoadPic,PicT);
SetLength(ThisAlb2, Num+1);
ThisAlb2[Num] := TJpegImage.Create;
with TJPEGImage(ThisAlb2[Num]) do
begin {8}
PixelFormat := jf24Bit;
Scale := jsFullSize;
Grayscale := False;
Performance := jpBestQuality;
CompressionQuality := 74;
ProgressiveDisplay := False;
end;
ThisAlb2[Num].Assign(PicT) ;
FreeAndNil(PicT);
end;
end;
procedure TfrmAlbum.DrawGrid1DrawCel l(Sender: TObject; ACol, ARow: Integer;
Recto: TRect; State: TGridDrawState);
var
Rect1, Rect2: TRect;
S1: String;
Num1, IndexNum: Integer;
begin
IndexNum := (ARow*DrawGrid1.ColCount)+ ACol;
Rect2 := Rect(0,0,90,90);
with Sender as TDrawGrid do
begin
Canvas.Brush.Color := clSilver;
Num1 := ARow*DrawGrid1.ColCount;
if Added then
begin
if (IndexNum) < Length(ThisAlb2) then
begin
Rect1.Top := Recto.Top+2;
Rect1.Left := Recto.Left+2;
Rect1.Right := Recto.Right-2;
Rect1.Bottom := Recto.Bottom-12;
DrawGrid1.Canvas.Draw(Rect o.Left+((( Recto.Righ t-Recto.Le ft) div 2)-(ThisAlb2[IndexNum].Wid th div 2)),
Recto.Top+2+((Dimention div 2)-(ThisAlb2[IndexNum].Hei ght div 2)),ThisAlb2[IndexNum]);
Rect1.Top := Recto.Top+Dimention+1;
Rect1.Left := Recto.Left+1;
Rect1.Right := Recto.Right-1;
Rect1.Bottom := Recto.Bottom;
S1 := ThisAlb[ACol+Num1].Name;
SetBkMode(DrawGrid1.Canvas .Handle, TRANSPARENT);
DrawText(DrawGrid1.Canvas. Handle,PCh ar(S1),-1, Rect1,DT_S INGLELINE or DT_VCENTER or DT_CENTER);
end;
end;
end;
end;
procedure TfrmAlbum.menuAddClick(Sen der: TObject);
var
i: Integer;
begin
FileListBox2.Update;
if FileListBox2.Items.Count < 1 then
begin
ShowMessage('There are no files listed to add to this Image Collection');
Exit;
end;
Num := 0;
OpenFilePath := '?';
DrawGrid1.Row := 0;
LockWindowUpdate(DrawGrid1 .handle);
if FileListBox2.Items.Count > 0 then
begin
Adding := True;
if Length(ThisAlb2) > 0 then
for i := 0 to Length(ThisAlb2)-1 do
FreeAndNil(ThisAlb2[i]);
DrawGrid1.RowCount := 1;
for i := 0 to (FileListBox2.Items.Count - 1) do
begin
if not FileExists(Label2.Caption+ '\' +FileListBox2.Items.String s[i]) then
begin
MessageDlg('File: ' + FileListBox2.Items.Strings [i] +
' not found', mtError, [mbOk], 0);
Continue;
end;
AddImage(Label2.Caption+'\ '+FileList Box2.Items .Strings[i ]);
if i = (((DrawGrid1.Height-4) div DrawGrid1.DefaultRowHeight ) * DrawGrid1.ColCount)-1 then
begin
LockWindowUpdate(0);
DrawGrid1.Update;
DrawGrid1.Invalidate;
LockWindowUpdate(DrawGrid1 .handle);
end;
end;
end;
IsFolder := True;
LockWindowUpdate(0);
Adding := False;
end;
- - - - - - - - - - - - - - - - - -
again, this is not working code, I don't have time to redo this app now, but this should give you the Idea of what it takes. Ask questions if it is unclear
type
PicRec = record
Path: String[255];
Name: String[64];
Sort: String[16];
Size: Cardinal;
Jsize: Integer;
Width, Height, PicIndex, PicInfo: Word;
Ext: PicExt;
WriteTime: TFileTime;
end;
var
ThisAlb: Array of PicRec;
ThisAlb2: Array of TJPEGImage;
Num: Integer;
Adding: Boolean;
procedure TfrmAlbum.ThumbNail(Pic1: TPicture; var ThumBmp: TBitmap);
var
Bmp1: TBitmap;
begin
ThumBmp.PixelFormat := pf24Bit;
if (Pic1.Width < Dimention) and (Pic1.Height < Dimention) then
begin // 1
ThumBmp.Height := Pic1.Height;
ThumBmp.Width := Pic1.Width;
end // 1
else
if Pic1.Width < Pic1.Height then
begin // 2
ThumBmp.Height := Dimention;
ThumBmp.Width := Trunc(Dimention / (Pic1.Height / Pic1.Width))+2;
end else // 2
if Pic1.Width > Pic1.Height then
begin // 3
ThumBmp.Width := Dimention;
ThumBmp.Height := Trunc(Dimention / (Pic1.Width / Pic1.Height))+2;
end else // 3
{if Pic1.Width = Pic1.Height then}
begin // 4
ThumBmp.Width := Dimention;
ThumBmp.Height := Dimention;
end; // 4
if Pic1.Graphic.ClassType = TGIFImage then
begin
Bmp1 := TBitmap.Create;
Bmp1.Width := Pic1.Width;
Bmp1.Height := Pic1.Height;
Bmp1.Assign(Pic1.Graphic);
ThumBmp.Canvas.StretchDraw
FreeAndNil(Bmp1);
end else
ThumBmp.Canvas.StretchDraw
end;
Procedure TfrmAlbum.AddImage(ImagePa
var
GotImage: Boolean;
LoadPic: TPicture;
PicT: TBitmap;
begin
GotImage := True;
LoadPic := TPicture.Create;
try
LoadPic.LoadFromFile(Image
except
on E: Exception do
begin
GotImage := False;
end;
end;
if GotImage then
begin
PicT := TBitmap.Create;
ThumbNail(LoadPic,PicT);
SetLength(ThisAlb2, Num+1);
ThisAlb2[Num] := TJpegImage.Create;
with TJPEGImage(ThisAlb2[Num]) do
begin {8}
PixelFormat := jf24Bit;
Scale := jsFullSize;
Grayscale := False;
Performance := jpBestQuality;
CompressionQuality := 74;
ProgressiveDisplay := False;
end;
ThisAlb2[Num].Assign(PicT)
FreeAndNil(PicT);
end;
end;
procedure TfrmAlbum.DrawGrid1DrawCel
Recto: TRect; State: TGridDrawState);
var
Rect1, Rect2: TRect;
S1: String;
Num1, IndexNum: Integer;
begin
IndexNum := (ARow*DrawGrid1.ColCount)+
Rect2 := Rect(0,0,90,90);
with Sender as TDrawGrid do
begin
Canvas.Brush.Color := clSilver;
Num1 := ARow*DrawGrid1.ColCount;
if Added then
begin
if (IndexNum) < Length(ThisAlb2) then
begin
Rect1.Top := Recto.Top+2;
Rect1.Left := Recto.Left+2;
Rect1.Right := Recto.Right-2;
Rect1.Bottom := Recto.Bottom-12;
DrawGrid1.Canvas.Draw(Rect
Recto.Top+2+((Dimention div 2)-(ThisAlb2[IndexNum].Hei
Rect1.Top := Recto.Top+Dimention+1;
Rect1.Left := Recto.Left+1;
Rect1.Right := Recto.Right-1;
Rect1.Bottom := Recto.Bottom;
S1 := ThisAlb[ACol+Num1].Name;
SetBkMode(DrawGrid1.Canvas
DrawText(DrawGrid1.Canvas.
end;
end;
end;
end;
procedure TfrmAlbum.menuAddClick(Sen
var
i: Integer;
begin
FileListBox2.Update;
if FileListBox2.Items.Count < 1 then
begin
ShowMessage('There are no files listed to add to this Image Collection');
Exit;
end;
Num := 0;
OpenFilePath := '?';
DrawGrid1.Row := 0;
LockWindowUpdate(DrawGrid1
if FileListBox2.Items.Count > 0 then
begin
Adding := True;
if Length(ThisAlb2) > 0 then
for i := 0 to Length(ThisAlb2)-1 do
FreeAndNil(ThisAlb2[i]);
DrawGrid1.RowCount := 1;
for i := 0 to (FileListBox2.Items.Count - 1) do
begin
if not FileExists(Label2.Caption+
begin
MessageDlg('File: ' + FileListBox2.Items.Strings
' not found', mtError, [mbOk], 0);
Continue;
end;
AddImage(Label2.Caption+'\
if i = (((DrawGrid1.Height-4) div DrawGrid1.DefaultRowHeight
begin
LockWindowUpdate(0);
DrawGrid1.Update;
DrawGrid1.Invalidate;
LockWindowUpdate(DrawGrid1
end;
end;
end;
IsFolder := True;
LockWindowUpdate(0);
Adding := False;
end;
- - - - - - - - - - - - - - - - - -
again, this is not working code, I don't have time to redo this app now, but this should give you the Idea of what it takes. Ask questions if it is unclear
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Studying. :)
Will let you know.
Thanks
Jim
Will let you know.
Thanks
Jim
ASKER
I had to tweak (as you suggested) but got it to work just perfectly.
Thanks
Jim
Thanks
Jim