Making a thumbnail?

http://www.delphipages.com/news/detaildocs.cfm?ID=42
http://www.ibrtses.com/delphi/dmth.html

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;

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;

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

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

@ 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

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 ? ;-)

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.

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

@ 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

"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.

@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?

"How do I find the width and height?"

found it.

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?