Link to home
Start Free TrialLog in
Avatar of JPersinger
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
Avatar of ginsonic
ginsonic
Flag of Romania image

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.Width,ThumBmp.Height), Bmp1);
    FreeAndNil(Bmp1);
    end else
    ThumBmp.Canvas.StretchDraw(Rect(0,0,ThumBmp.Width,ThumBmp.Height), Pic1.Graphic);
end;


Procedure TfrmAlbum.AddImage(ImagePath: String);
var
GotImage: Boolean;
LoadPic: TPicture;
PicT: TBitmap;
begin
GotImage := True;
LoadPic := TPicture.Create;
try
LoadPic.LoadFromFile(ImagePath);
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.DrawGrid1DrawCell(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(Recto.Left+(((Recto.Right-Recto.Left) div 2)-(ThisAlb2[IndexNum].Width div 2)),
      Recto.Top+2+((Dimention div 2)-(ThisAlb2[IndexNum].Height 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,PChar(S1),-1,Rect1,DT_SINGLELINE or DT_VCENTER or DT_CENTER);
      end;
   
    end;
  end;
end;

procedure TfrmAlbum.menuAddClick(Sender: 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.Strings[i]) then
      begin
      MessageDlg('File: ' + FileListBox2.Items.Strings[i] +
                   ' not found', mtError, [mbOk], 0);
      Continue;
      end;

AddImage(Label2.Caption+'\'+FileListBox2.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
ASKER CERTIFIED SOLUTION
Avatar of Member_2_248744
Member_2_248744
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of JPersinger
JPersinger

ASKER

Studying. :)

Will let you know.

Thanks

Jim
I had to tweak (as you suggested) but got it to work just perfectly.

Thanks

Jim