Thumbnails mit TwicImage (in Arbeit)

Es wird eine Unit entworfen, die mit der Klasse TwicImage Bilder mit verschiedenen Formaten zu laden und davon Thumbnails (Bitmaps) in einstellbaren Größen zu erzeugen.

Derzeit sind zwei Methoden programmiert (entworfen), die erste projeziert ein PNG-Bild auf Thumbnail-Größe und die zweite liefert ein Bitmap in Thumbnail-Größe von einem JPG zurück.

Grundsätzlich funktionieren die beiden Methoden, aber es wird in der Methode ThumbnailPng noch kein echtes Thumbnail erzeugt. Für Gif und Tiff müssen die entsprechenden Methoden noch programmiert werden.

unit ThumbUtil;

interface

uses
  JPEG, VCL.Graphics, Vcl.ExtCtrls, System.SysUtils, System.Classes,
  WinApi.Wincodec, System.Types;

procedure  ThumbNailPng(ADatei: String; ASize: Integer; AImage: TImage);
function ThumbNailJpeg(ADatei: String; AGroesse: Integer; AImage: TImage): TBitmap;

implementation

procedure ThumbNailPng(ADatei: String; ASize: Integer; AImage: TImage);
const
   interpolationMode: WICBitmapInterpolationMode = WICBitmapInterpolationModeFant;
var
   wicImage: TWICImage;
   bitmapScaler: IWicBitmapScaler;

   aspectRatio: Double;
   newSize: TPoint;
begin
   wicImage := TWICImage.Create();
   wicImage.ImageFormat := TWICImageFormat.wifPng;
   wicImage.LoadFromFile(ADatei);

   aspectRatio := 1.0;
   if AImage.Width < AImage.Height then
      aspectRatio := AImage.Width / wicImage.Width
   else
      aspectRatio := AImage.Height / wicImage.Height;
   newSize.X := Round( wicImage.Width * aspectRatio);
   newSize.Y := Round( wicImage.Height * aspectRatio);

   wicImage.ImagingFactory.CreateBitmapScaler(bitmapScaler);
   bitmapScaler.Initialize(wicImage.Handle, newSize.X, newSize.Y, interpolationMode);
   wicImage.Handle := IWICBitmap(bitmapScaler);
   AImage.Picture.Bitmap.Assign(wicImage);
   wicImage.Free;
end;

function ThumbNailJpeg(ADatei: String; AGroesse: Integer;AImage: TImage): TBitmap;
var
  JPG: TJPEGImage;
  Bitm: Tbitmap;
  Hoehe, Weite, X: integer;
  Verh: Double;
begin
  result := TBitmap.Create;
  JPG := TJPEGImage.Create;
  Bitm := TBitmap.Create;
  try
    JPG.LoadFromFile(ADatei);
    JPG.DIBNeeded;
    JPG.Scale := jsEighth;
    Result.Assign(JPG);
    Bitm.Assign(JPG);
    if (Bitm.Height > 0) AND (Bitm.Width > 0) then
      result.Canvas.StretchDraw(Rect(x,0,AImage.Width,AImage.Height),Bitm)
    else
      result := nil;
  finally
    FreeandNil(Bitm);
    FreeandNil(JPG);
  end;
end;

end.

Schreibe einen Kommentar