Making a thumbnail?

lundorff
lundorff used Ask the Experts™
on
Hallo,
how do I make a thumbnail of a picture with delphi6? By thumbnail I mean a 150*150 of the original pincture (or any size entered).

Rgs
Lund
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
hello lundorff, here's my version -


procedure TForm1.ThumbNail(Pic1: TBitmap; var ThumBmp: TBitmap; Dimention: Integer;);
var
Bmp1: TBitmap;
begin
ThumBmp.PixelFormat := pf24Bit;
if (Pic1.Width < Dimention) and (Pic1.Height < Dimention) then
    begin
    ThumBmp.Height := Pic1.Height;
    ThumBmp.Width := Pic1.Width;
    end
  else
  if Pic1.Width < Pic1.Height then
    begin
    ThumBmp.Height := Dimention;
    ThumBmp.Width := Trunc(Dimention / (Pic1.Height / Pic1.Width))+2;
    end else
  if Pic1.Width > Pic1.Height then
    begin
    ThumBmp.Width := Dimention;
    ThumBmp.Height := Trunc(Dimention / (Pic1.Width / Pic1.Height))+2;
    end  else // 3
    begin // 4
    ThumBmp.Width := Dimention;
    ThumBmp.Height := Dimention;
    end; // 4
    ThumBmp.Canvas.StretchDraw(Rect(0,0,ThumBmp.Width,ThumBmp.Height), Pic1);
end;


procedure TForm1.ButtonClick(Sender: TObject);
var
Bmp1, ThumBmp1: TBitmap;
begin
Bmp1 := TBitmap.Create;
ThumbBmp1 := TBitmap.Create;
try
  Bmp1.LoadFromFile('C:\Stuff\aBmp.bmp');
  ThumbNail(Bmp1, ThumBmp1, 150);
  Canvas.Draw(10,10,ThumBmp1);
  finally
  Bmp1.Free;
  ThumBmp1.Free;
  end;
end;
VGR

Commented:
yes yes yes, all solutions look like the one above 8-)

Here's mine (adapt, there is stuff useless to you : I use globResolMode to hold the resolution of the screen and thus deduce the "correct" dimensions of the thumbnails, but you may as well use the constant declaration : Var PageHeight = 200; in stead)

Procedure Vignette; // (Image1: TBitmap; filename:String; isGrande : Boolean);
Var PageHeight, // = 200;
    PageWidth : Word; // = 320;
var
  AspectRatio: Single;
  OutputWidth, OutputHeight: Single;
  ici          :             TBitMap;
begin
  Case globResolMode Of
   4 : If isGrande Then Begin PageHeight:=350; PageWidth:=560; End
        Else Begin PageHeight:=100; PageWidth:=160; End;
   3: If isGrande Then Begin PageHeight:=450; PageWidth:=720; End
        Else Begin PageHeight:=150; PageWidth:=240; End;
   2: If isGrande Then Begin PageHeight:=640; PageWidth:=944; End
        Else Begin PageHeight:=200; PageWidth:=320; End;
   1: If isGrande Then Begin PageHeight:=768; PageWidth:=1024; End
        Else Begin PageHeight:=300; PageWidth:=480; End;
   End; //Case
  try
    OutputWidth := Image1.Width;
    OutputHeight := Image1.Height;
    AspectRatio := OutputWidth / OutputHeight;
    if (OutputWidth < PageWidth) and
      (OutputHeight < PageHeight) then
    begin
      if OutputWidth < OutputHeight then
      begin
        //VGR23082002 RàF !!! OutputHeight := PageHeight;
        //VGR23082002 RàF !!! OutputWidth := OutputHeight * AspectRatio;
      end
      else
      begin
        //VGR23082002 RàF !!! OutputWidth := PageWidth;
        //VGR23082002 RàF !!! OutputHeight := OutputWidth / AspectRatio;
      end
    end;
    if OutputWidth > PageWidth then
    begin
      OutputWidth := PageWidth;
      OutputHeight := OutputWidth / AspectRatio;
    end;
    if OutputHeight > PageHeight then

    begin
      OutputHeight := PageHeight;
      OutputWidth := OutputHeight * AspectRatio;
    end;
    ici:=TBitmap.Create;
    ici.Width:=trunc(outputwidth);
    ici.Height:=trunc(outputheight);
    ici.PixelFormat:=pf24bit;
    ici.Canvas.StretchDraw(ici.Canvas.ClipRect,Image1);
    ici.SaveToFile(filename);
  finally
    ici.Free;
  end;
end;
Introduction to R

R is considered the predominant language for data scientist and statisticians. Learn how to use R for your own data science projects.

Hi,

And my version:
---
uses jpeg;

procedure ThumbNail(const SourceFile, DestFile: string; w,h: integer);
var
  bmp: TBitmap;
begin
  with TImage.Create(nil) do begin
   try
    Picture.LoadFromFile(SourceFile);
    bmp := TBitmap.Create;
    try
     bmp.Height := w;
     bmp.Width := h;
     bmp.Canvas.StretchDraw(Rect(0,0,Bmp.Width,Bmp.Height), Picture.Graphic);
     bmp.SaveToFile(DestFile);
    finally
     bmp.Free;
    end;
   finally
    Free;
   end;
  end;
end;

// usage:
procedure TForm1.Button1Click(Sender: TObject);
begin
  ThumbNail('c:\p1.jpg','c:\tn1.bmp',100,100);
end;
---

Regards, Geo
uses jpeg, graphics, extctrls; // is the right clause

Author

Commented:
Oh so many nice suggestions thank you all but I think I have been a bit too unspecific. The created thumbnail must be a jpeg that is created next to the original jpg. I must end up with 2 jpgs. This one http://www.delphipages.com/news/detaildocs.cfm?ID=42 might be the right solution but I'll have to wait till I get home :).

Rgs
Lund
uses jpeg, graphics, extctrls;

procedure ThumbNail(const SourceFile, DestFile: string; w,h: integer);
var
 bmp: TBitmap;
 j: TJPEGImage;
begin
 with TImage.Create(nil) do begin
  try
   Picture.LoadFromFile(SourceFile);
   bmp := TBitmap.Create;
   try
    bmp.Height := w;
    bmp.Width := h;
    bmp.Canvas.StretchDraw(Rect(0,0,Bmp.Width,Bmp.Height), Picture.Graphic);
    j := TJPEGImage.Create;
    try
     j.Assign(bmp);
     j.SaveToFile(DestFile);
    finally
     j.Free;
    end;
   finally
    bmp.Free;
   end;
  finally
   Free;
  end;
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ThumbNail('c:\p1.jpg','c:\tn1.jpg',100,100);
end;

Regards, Geo

Author

Commented:
@ geobul
I can't use graphics, extctrls (delphi gives an error) but I can run the procedure by using jpeg alone - an it works hehe. You have earned the point but let me ask you another question:

Would it be possible to make it crop-out a fixed section insted of resizing it. Right now the thumb looks rather ugly lol. (I will make a new question with 75 points if you can make this :)

Rgs
Lund
VGR

Commented:
Yes, it looks ugly because you did not pay attention to the code of Slick812  and me.

Why do you think we lost time argueing with Width, height and AspectRatio ? ;-)

Author

Commented:
I actually did try Slick812's version but it created the thumb on the canvas and still only resized - not cropped. I haven't tried your version since it's based on TBitmap - I will try yours later today.
VGR

Commented:
No, it won't change anything ; both are essentially ther same. To crop the image you have to use a specific TRect in the call  to StretchDraw() and not Rect(0,0,Width,Height)

that's all

good amusement

Author

Commented:
@ VGR
where do you declare globResolMode?
is the this sentence correct: Procedure Vignette; // (Image1: TBitmap; filename:String; isGrande : Boolean); ? Should I call the procedure with paramethers?
Hi Lund,
If it's the change in aspect ratio that bothers you then you may calculate it and preserve it in the result as Slick812 and VGR did in their code. (I can add this feature to my code also if you want me to). The quality depends on the quality of the original jpg, how much it's being resized and the compression quality (default is 90 percent I think). You may change the compression quality just before j.SaveToFile this way:
j.CompressionQuality := 100;
but this will almost double the size of the thumb file without any significant quality improvement.

If you'll use the thumbs for internet page then usually you may achieve better layout if the thumbs are with equal dimentions regardless of changes in aspect ratio. The purpose of using thumbs is to give an idea about the real picture consuming small amount of resources (time of loading, space on the screen, etc.). That's not absolute, of course, and depends on your specific page design.

Regards, Geo

Author

Commented:
"The purpose of using thumbs is to give an idea about the real picture"

Yes this is usually true but I only need a fixed section from any place on the original picture - I dont mind only getting the carwindow as long as it is clear. If you could make this I would be very greatfull :)

Rgs
Lund
// w,h: width and height of the thumbnail
// x,y: from where to copy WxH piece (of the original jpg)
procedure ThumbNail(const SourceFile, DestFile: string; w,h,x,y: integer);
var
bmp, bmp2: TBitmap;
j: TJPEGImage;
begin
bmp := TBitmap.Create;
try
  bmp2 := TBitmap.Create;
  try
    j := TJPEGImage.Create;
    try
      j.LoadFromFile(SourceFile);
      bmp2.Assign(j);
      bmp.Height := w;
      bmp.Width := h;
      bmp.Canvas.CopyRect(Rect(0,0,Bmp.Width,Bmp.Height), bmp2.Canvas, Rect(x,y,x+w,y+h));
      j.Assign(bmp);
      j.SaveToFile(DestFile);
    finally
      j.Free;
    end;
  finally
    bmp2.Free;
  end;
finally
  bmp.Free;
end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  // copy 150x150 piece starting at 500x400 point
  ThumbNail('c:\p1.jpg','c:\tn1.jpg',150,150,500,400);
end;

Regards, Geo
I have found many useful drawing methods by looking at the Delphi Help for index TCanvas, and then looking at the TCanvas Methods in the help.

Author

Commented:
@geobul
hmm I can see an obvious problem with copying a fixed size from a picture I don't know the size at.

If I could retrive the width and height of the picture (say 500*400) I could take the largest possible square (400*400 in this case) and then make a thumbnail from that square. This way the thumbnail would be a very good representation of the actual picture.

How do I find the width and height?

Author

Commented:
"How do I find the width and height?"

found it.

Author

Commented:
I have changed the procedure a bit

procedure TForm1.myThumbNail(const SourceFile, DestFile: string; w,h: integer);
var
bmp, bmp2,newbmp: TBitmap;
j,newj: TJPEGImage;
thesize: integer;
firstrun: boolean;
begin
firstrun := false;
bmp := TBitmap.Create;
try
 bmp2 := TBitmap.Create;
 try
   j := TJPEGImage.Create;
   try
   j.LoadFromFile(SourceFile);

    if j.Height <> j.Width then begin
     if j.Height > j.Width then begin
      thesize := j.Width;
      thesize := j.Width
     end else begin
      thesize := j.height;
      thesize := j.Height;
    end;
     bmp2.Assign(j);
     bmp.Height := thesize;
     bmp.Width := thesize;
     bmp.Canvas.CopyRect(Rect(0,0,Bmp.Width,Bmp.Height), bmp2.Canvas, Rect(0,0,0+thesize,0+thesize));
     j.Assign(bmp);
     j.SaveToFile(DestFile);
     firstrun := true;
    end else begin
     with TImage.Create(nil) do begin
     try
      Picture.LoadFromFile(SourceFile);
      newbmp := TBitmap.Create;
       try
        newbmp.Height := w;
        newbmp.Width := h;
        newbmp.Canvas.StretchDraw(Rect(0,0,newbmp.Width,newbmp.Height), Picture.Graphic);
        newj := TJPEGImage.Create;
        try
         newj.Assign(newbmp);
         newj.SaveToFile(DestFile);
         finally
         newj.Free;
         end;
       finally
        newbmp.Free;
       end;
     finally
      Free;
     end;
     end;
    end;
   finally
     j.Free;
   end;
 finally
   bmp2.Free;
 end;
finally
 bmp.Free;
end;
 if firstrun then begin
  myThumbNail('c:\tn1.jpg','c:\tn1.jpg',150,150);
 end;
end;


This way it will find the largest size and first crop this out and then resize the cropped part. The only problem is the quality of the picture is terrible: http://www.dailysite.net/car.html

sigh... any suggestions?

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial