pngjpegthumbnailsdelphi-10.2-tokyotimage

How to make a thumbnail from a JPG or PNG and load it into a Timage control?


How can I make a thumbnail from a JPG or PNG and load that thumbnail into a TImage control?

I've tried stuff like this, but the TImage does not look like is loading something.

Image2 is a TImage control.

function resize2(source: string): TBitmap;
var
  BMPFile, ScreenBMP: TBitmap;
begin
  BMPFile := TBitmap.Create;
  try
    BMPFile.LoadFromFile(source);
    ScreenBMP := TBitmap.Create;
    ScreenBMP.PixelFormat := BMPFile.PixelFormat;
    ScreenBMP.Width := 10;
    ScreenBMP.Height := 10;
    ScreenBMP.Canvas.StretchDraw(Rect(0,0, ScreenBMP.Width, ScreenBMP.Height), BMPFile);
    Result := ScreenBMP;
  finally
    BMPFile.Free;
  end;
end;

procedure TAlpha.dbeditTextBoxChange(Sender: TObject);
var
  pic1: string;
  mimapa: TBitmap;
begin
  try
    pic1 := dm.TableNotes.FieldByName('PathPic').AsVariant;
    mimapa := resize2(pic1);

    //all of these are not working
    Image2.Assign(mimapa);
    image2.Picture.Bitmap := mimapa;

Solution

  • The VCL's TBitmap supports only BMP images. If you try to load any other kind of image into it, you will get an exception raised.

    To load a JPG, you need to use TJPEGImage instead. To load a PNG, use TPNGImage instead.

    You can use a TPicture to help you with that task, eg:

    uses
     ..., Vcl.Graphics, Vcl.Imaging.jpeg, Vcl.Imaging.pngimage;
    
    function resize2(source: string): TBitmap;
    var
      Pic: TPicture;
    begin
      Pic := TPicture.Create;
      try
        Pic.LoadFromFile(source);
        Result := TBitmap.Create;
        try
          if Pic.Graphic is TBitmap then
            Result.PixelFormat := TBitmap(Pic.Graphic).PixelFormat
          else
            Result.PixelFormat := pf32bit;
          Result.Width := 10;
          Result.Height := 10;
          Result.Canvas.StretchDraw(Rect(0, 0, Result.Width, Result.Height), Pic.Graphic);
        except
          Result.Free;
          raise;
        end;
      finally
        Pic.Free;
      end;
    end;
    
    procedure TAlpha.dbeditTextBoxChange(Sender: TObject);
    var
      pic1: string;
      mimapa: TBitmap;
    begin
      try
        pic1 := dm.TableNotes.FieldByName('PathPic').AsString;
        mimapa := resize2(pic1);
        try
          image2.Picture.Assign(mimapa);
        finally
          mimapa.Free;
        end;
        ...
      except
       ...
      end;
    end;