Verlustfreies Zoomen von Bildern (Interpolieren)

[himitsu]

BitMap zusammen mit der neuen Größe übergeben:
z.B.: Zoom(Image1.Picture.Bitmap, 800, 600);

(QI = QuellImage, ZI = ZielImage)

Delphi-Quellcode:

Procedure Zoom(Var QI: TBitMap; ZI_Width, ZI_Height: Integer);
  {Pixel in die Grundfarben zerlegen}
  Function R(Pixel: TColor): Byte;
    Begin  Result := Pixel mod 256;  End;

  Function G(Pixel: TColor): Byte;
    Begin  Result := (Pixel shr 8) mod 256;  End;

  Function B(Pixel: TColor): Byte;
    Begin  Result := (Pixel shr 16) mod 256;  End;

  Var X, Y: Integer;
    R, G, B: Byte;
    ZI: TBitMap;
    
  Begin
    ZI := TBitMap.Create(self);
    ZI.Width := ZI_Width;
    ZI.Height := ZI_Height;
    ZI.PixelFormat := QI.PixelFormat;
    For X = 0 to ZI_Width - 1 do 
      For Y = 0 to ZI_Height - 1 do Begin     
        {Berechnet die Position des neuen Piexels im alten Bild}
        {entspricht der Position des linken oberen der 4 verwendeten Pixel}
        X2 = Trunc(QI.Width * (X / ZI_Width));    
        Y2 = Trunc(QI.Height * (Y / ZI_Height));
        {Berechnet die Wertigkeit der umliegenden Pixel im altenBild}
        {fürs rechte untere der 4 verwendeten Pixel}
        PX = Frac(QI.Width * (X / ZI_Width));
        PY = Frac(QI.Height * (Y / ZI_Height)));
        {Neuen Farbwert berechnen - rot}
              {QuellPixel}                        {Wertigkeit (%)}
        R = R(QI.Canvas.Pixels[X2,     Y2])     * (1 - PX) * (1 - PY) + 
            R(QI.Canvas.Pixels[X2 + 1, Y2])     * PX       * (1 - PY) + 
            R(QI.Canvas.Pixels[X2,     Y2 + 1]) * (1 - PX) * PY + 
            R(QI.Canvas.Pixels[X2 + 1, Y2 + 1]) * PX       * PY; 
        {Neuen Farbwert berechnen - grün}
        G = G(QI.Canvas.Pixels[X2,     Y2])     * (1 - PX) * (1 - PY) + 
            G(QI.Canvas.Pixels[X2 + 1, Y2])     * PX       * (1 - PY) + 
            G(QI.Canvas.Pixels[X2,     Y2 + 1]) * (1 - PX) * PY + 
            G(QI.Canvas.Pixels[X2 + 1, Y2 + 1]) * PX       * PY; 
        {Neuen Farbwert berechnen - blau}
        B = B(QI.Canvas.Pixels[X2,     Y2])     * (1 - PX) * (1 - PY) + 
            B(QI.Canvas.Pixels[X2 + 1, Y2])     * PX       * (1 - PY) + 
            B(QI.Canvas.Pixels[X2,     Y2 + 1]) * (1 - PX) * PY + 
            B(QI.Canvas.Pixels[X2 + 1, Y2 + 1]) * PX       * PY; 
        {Farben zusammensetzen und Pixel zeichnen}
        ZI.Canvas.Pixels[X, Y] := RGB(R, G, B);
      End;
    QI := ZI;  {Bildübergabe eventuell noch ändern}
    ZI.Free;
  End;

noch nicht getestet.