Как сделать эскиз из JPG или PNG и загрузить его в элемент управления Timage? - PullRequest
Новая
       101

Как сделать эскиз из JPG или PNG и загрузить его в элемент управления Timage?

0 голосов
/ 03 марта 2019

Как сделать миниатюру из JPG или PNG и загрузить ее в элемент управления TImage?

Я пробовал что-то подобное, но TImage не похоже на загрузкучто-то.

Image2 - это TImage элемент управления. 

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;

1 Ответ

0 голосов
/ 03 марта 2019

VCL TBitmap поддерживает только изображения BMP.Если вы попытаетесь загрузить в него любое другое изображение, вы получите исключение.

Чтобы загрузить JPG, вам нужно использовать TJPEGImage.Чтобы загрузить PNG, используйте TPNGImage.

Вы можете использовать TPicture, чтобы помочь вам с этой задачей, например: 

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