Bild skalieren

[b1zZ]

Guten Morgen,

hatt vor kurzem auch ein ähnliches Problem und habe mir eine Funktion dafür geschrieben, vielleicht hilft sie dir.

Delphi-Quellcode:

function ResizeImage(SourceBitMap: TBitMap; DrainWidth: Integer = 0; DrainHeight: Integer = 0;
                       KeepRatio: Boolean = true; PixelFormat :TPixelFormat = pfCustom):TBitMap;
var Rect: TRect;
    SourceHeight, SourceWidth: Integer;
    DrainBitMap: TBitMap;
begin
  DrainBitMap:= TBitMap.Create;

  SourceWidth:= SourceBitMap.Width;
  SourceHeight:= SourceBitMap.Height;

  if KeepRatio = True then
  begin
    if DrainHeight = 0 then
      DrainHeight:= Round((SourceHeight/SourceWidth)*DrainWidth)
    else
      if DrainWidth = 0 then
        DrainWidth:= Round(DrainHeight/(SourceHeight/SourceWidth));

    //Sollte das Verhältniss des Ausgangsbildes anders sein als des Zielbildes
    //wird es so verändert, dass es in sein Ausgangsverhältnis beibehält und in
    //Zielbild passt.
    if (DrainWidth/DrainHeight) > (SourceWidth/SourceHeight) then
      DrainWidth:= Round((SourceWidth/SourceHeight)*DrainHeight)
    else
      if (DrainWidth/DrainHeight) < (SourceWidth/SourceHeight) then
        DrainHeight:= Round(DrainWidth/(SourceWidth/SourceHeight));
  end;
  // Position des "kopier-Rechtecks" wird auf oben links
  // gesetzt und kopiert bis DrainWidth und DrainHeight
  Rect.TopLeft.X:= 0;
  Rect.TopLeft.Y:= 0;
  Rect.BottomRight.X:= DrainWidth;
  Rect.BottomRight.Y:= DrainHeight;
  // Das Result BitMap bekommt die gestretchte / gestauchte Grösse
  DrainBitMap.Width:= DrainWidth;
  DrainBitMap.Height:= DrainHeight;

  // Bild wird gestreckt und ins Resultbild geladen,
  // damit das Original nicht verändert wird.
  // Mit DrainBitMap wird dann weitergearbeitet
  DrainBitMap.Canvas.StretchDraw(Rect,SourceBitMap);

  // Die Farbtiefe wird geändert
  if PixelFormat <> pfCustom then
    DrainBitMap.PixelFormat:= PixelFormat;

  Result:= DrainBitMap;
end;

Habe den Code zwar Kommentiert, aber stehen für Fragen immer zur Verfügung.