Bitmap shrinken

[bernhard_LA]

ich möchte mit folgendem Code eine Bitmap in der Größe möglichst verlustfrei reduzieren

Delphi-Quellcode:

Function SmartShrinkBitmap0(PBitmap: TBitMap; Scale: Double): Boolean;
var
  Out_X, Out_Y: Integer;
  Source_X, Source_Y: Integer;
  ScanImageBox: TRect;
  ShrinkImageLine: PByteArray;
  SourceImageLine: PByteArray;
  ScaleF: Double;
  PixCount: Integer;
  Local_Red, Local_Green, Local_Blue: Integer;
  Local_Scr_X, local_dest_X: Integer;
  SourceBitmap: TBitMap;
begin
  Result := False;

  //  no work to to ....
  if not assigned(PBitmap) or (Scale > 1) or (Scale < 0) or (PBitmap.Width < 2)
    or (PBitmap.Height < 2) then
    exit;

  if Scale = 1 then
  begin
    exit;
  end;

  if Scale = 0 then
  begin
    PBitmap.Width := 0;
    PBitmap.Height := 0;
    exit;
  end;

  ScaleF := 1 / Scale;

  // Daten von PBitMap in new SourceBitmap Kopieren
  SourceBitmap := TBitMap.Create;
  SourceBitmap.PixelFormat := pf24bit;
  SourceBitmap.Assign(PBitmap);

  //  set values for new out bitmap
  PBitmap.Width := round(SourceBitmap.Width * Scale);
  PBitmap.Height := round(SourceBitmap.Height * Scale);
  PBitmap.PixelFormat := pf24bit;

  try // try...finally
    try // try...except
      // for each pixel in new OutBitmap do...
      for Out_Y := 0 to PBitmap.Height - 1 do
      begin
        ShrinkImageLine := PBitmap.Scanline[Out_Y];
        for Out_X := 0 to PBitmap.Width - 1 do
        begin
          ScanImageBox.Left := trunc(Out_X * ScaleF);
          ScanImageBox.Top := trunc(Out_Y * ScaleF);
          ScanImageBox.Right := trunc((Out_X + 1) * ScaleF);
          ScanImageBox.Bottom := trunc((Out_Y + 1) * ScaleF);
          Local_Red := 0;
          Local_Green := 0;
          Local_Blue := 0;
          PixCount := 0;
          for Source_Y := ScanImageBox.Top to ScanImageBox.Bottom - 1 do
          begin
            SourceImageLine := SourceBitmap.Scanline[Source_Y];
            for Source_X := ScanImageBox.Left to ScanImageBox.Right - 1 do
            begin
            ///   hier entsteht die AV ??? 

              [B]              
              Local_Scr_X := Source_X * 3;
              inc(Local_Red, SourceImageLine[Local_Scr_X]);
              [/B]              
              inc(Local_Green, SourceImageLine[Local_Scr_X + 1]);
              inc(Local_Blue, SourceImageLine[Local_Scr_X + 2]);
              inc(PixCount);
            end;
          end;
          local_dest_X := Out_X * 3;
          If local_dest_X > 32000 then
            Raise Exception.CreateFmt('Variable LDX to high ...(%d)', [local_dest_X]);
          // Raise Exception.Create ('Variable LDX to high ...('+ inttostr (LDX)+')');
          ShrinkImageLine[local_dest_X] := Local_Red div PixCount;
          ShrinkImageLine[local_dest_X + 1] := Local_Green div PixCount;
          ShrinkImageLine[local_dest_X + 2] := Local_Blue div PixCount;
        end;
      end;

      Result := True;

    except
      // If the code produces an Exception ....
      on E: Exception do
        // {--Only for debuging reasons }

        ShowMessageFmt(E.ClassName + ' error raised, with message : ' +
          E.Message + #13#10 + 'Variables values:' + #13#10 +
          '  out_X=' + Inttostr(Out_X) + ', ' + '  out_Y=' + Inttostr(Out_Y) + #13#10 +
          '  src_x=' + Inttostr(Source_X) + ', ' + '  src_Y=' + Inttostr(Source_Y) + #13#10 +
          '  ScanBOX.TOP=' + Inttostr(ScanImageBox.TOP) + #13#10 +
          '  ScanBOX.LEFT=' + Inttostr(ScanImageBox.LEFT) + #13#10 +
          '  ScanBOX.RIGHT=' + Inttostr(ScanImageBox.Right) + #13#10 +
          '  ScanBOX.BOTTOM=' + Inttostr(ScanImageBox.Bottom) + #13#10 +
          '  LDX=' + Inttostr(local_dest_X) + #13#10 +
          '  LSX=' + Inttostr(Local_Scr_X) + #13#10 +
          '  PBitmap=%p, OutBitmap=%p' +  '  DLine=%p, Dimensions='  + #13#10 +
          '  Inbmp Size ' + Inttostr(SourceBitmap.Height) + 'x' + Inttostr(SourceBitmap.Width)+ ' pixel' + #13#10 +
          '  Outbmp Size ' + Inttostr(PBitmap.Height) + 'x' + Inttostr(PBitmap.Width)+ ' pixel' + #13#10 +
          '  Scale :'  + Floattostr(Scale) +
          '  ScaleF:'  + Floattostr(ScaleF),
          [SourceBitmap.Scanline[0], PBitmap.Scanline[0], ShrinkImageLine]);

    end; // Try...except...end;
  finally
    SourceBitmap.free;
  end; // Try...finally...end;
end;

mein Problem : bei machen Bildern erzeugt die Fubktion scanline eine AV beim Zugriff auf bestimmte Pixel, ich kann mir aber keinen Reim darauf machen, auch wenn ich alle Werte ausgeben lasse , siehe screnn Dump.

Sieht jemand einen Fehler in diesem Code ?

[DeddyH]

Hat das einen bestimmten Grund, dass Du umständlich mit ScanLine hantierst anstatt einfach mit StretchBlt?

[Blup]

Die Größe von ScanImageBox wird falsch berechnet.
So verschiebt sich der gesamte Bildinhalt nach Links und Oben.
Ausserdem wird am rechten und unteren Bildrand über die Bildgröße des Orginals hinaus zugegriffen.

Beispiel mit StretchBlt:

Delphi-Quellcode:

SetStretchBltMode(PBitmap.Canvas.Handle, HALFTONE);
StretchBlt(PBitmap.Canvas.Handle, 0, 0, PBitmap.Width, PBitmap.Height,
           SourceBitmap.Canvas.Handle, 0, 0, SourceBitmap.Width, SourceBitmap.Height, SRCCOPY);

Einfach den Durchschitt aller Farbwerte in einem Rechteck zu bestimmen, reicht für eine ordentlich Skalierung eventuell nicht aus. Dazu bestimmt man am besten die Farbwerte in einem Kreis um den zu berechnenden Punkt. Die Farbwerte der einzelnen Pixel gehen dabei z.B. nach dem Quadrat der Entfernung zum Mittelpunkt gewichtet in die Berechnung ein.

[bernhard_LA]

um die Box zu zentrieren würde ich folgende LÖsung verwenden

Delphi-Quellcode:

          ScanImageBox.Left := trunc(Out_X-1 * ScaleF/2);
          ScanImageBox.Top := trunc(Out_Y-1 * ScaleF/2);
          ScanImageBox.Right := trunc((Out_X + 1) * ScaleF/2);
          ScanImageBox.Bottom := trunc((Out_Y + 1) * ScaleF/2);

un solange die Box nicht im Scan Bereich der Ursprungbildes liegt abbrechen ?

[Medium]

Es ist zwar eine externe Komponente mehr, aber die Graphics32 bietet eine gute Auswahl an Resize-Filtern an, die zudem sehr sehr zügig sind. (Insbesondere wird für Verkleinerungen gerne der Lanzcos-Kernel empfohlen.)
Ausser es ist reines Interesse am Lernen/Forschen: Bevor man sich lange mit nachher sehr wahrscheinlich langsameren und weniger schöne Ergebnisse produzierenden eigenen Methoden rum schlägt, würde ich jederzeit zur G32 greifen.

Edit: Ne Kleinigkeit, aber sticht mir in die Seite: "Verlustfrei verkleinern" geht nicht. Fast egal mit welcher Methode man verkleinert, der Verlust rein Signaltheoretisch betrachtet, ist bei allen praktisch gleich. Man kann höchstens mit diversen Verfahren versuchen, diese an Stellen / in Eigenschaften zu erzeugen, die ein Mensch am wenigsten wahrnimmt.

[bernhard_LA]

falls noch jemand diesen Algo verwenden will :


ScaleF := 1 / Scale;
ersetzt durch

Delphi-Quellcode:

  ScaleF_x := SourceBitmap.Width / PBitmap.Width;
  ScaleF_Y := SourceBitmap.height / PBitmap.Height;

damit ist dann das AV Problem gelöst