AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Bitmap shrinken

Ein Thema von bernhard_LA · begonnen am 8. Jan 2013 · letzter Beitrag vom 9. Jan 2013
Antwort Antwort
bernhard_LA

Registriert seit: 8. Jun 2009
Ort: Bayern
1.123 Beiträge
 
Delphi 11 Alexandria
 
#1

Bitmap shrinken

  Alt 8. Jan 2013, 11:14
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 ?
Angehängte Grafiken
Dateityp: jpg shrink_bmp_error.jpg (19,4 KB, 6x aufgerufen)
  Mit Zitat antworten Zitat
Benutzerbild von DeddyH
DeddyH

Registriert seit: 17. Sep 2006
Ort: Barchfeld
27.542 Beiträge
 
Delphi 11 Alexandria
 
#2

AW: Bitmap shrinken

  Alt 8. Jan 2013, 11:26
Hat das einen bestimmten Grund, dass Du umständlich mit ScanLine hantierst anstatt einfach mit StretchBlt?
Detlef
"Ich habe Angst vor dem Tag, an dem die Technologie unsere menschlichen Interaktionen übertrumpft. Die Welt wird eine Generation von Idioten bekommen." (Albert Einstein)
Dieser Tag ist längst gekommen
  Mit Zitat antworten Zitat
Blup

Registriert seit: 7. Aug 2008
Ort: Brandenburg
1.429 Beiträge
 
Delphi 10.4 Sydney
 
#3

AW: Bitmap shrinken

  Alt 8. Jan 2013, 12:24
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.
  Mit Zitat antworten Zitat
bernhard_LA

Registriert seit: 8. Jun 2009
Ort: Bayern
1.123 Beiträge
 
Delphi 11 Alexandria
 
#4

AW: Bitmap shrinken

  Alt 8. Jan 2013, 12:39
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 ?
  Mit Zitat antworten Zitat
Medium

Registriert seit: 23. Jan 2008
3.679 Beiträge
 
Delphi 2007 Enterprise
 
#5

AW: Bitmap shrinken

  Alt 8. Jan 2013, 17:38
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.
"When one person suffers from a delusion, it is called insanity. When a million people suffer from a delusion, it is called religion." (Richard Dawkins)

Geändert von Medium ( 8. Jan 2013 um 17:42 Uhr)
  Mit Zitat antworten Zitat
bernhard_LA

Registriert seit: 8. Jun 2009
Ort: Bayern
1.123 Beiträge
 
Delphi 11 Alexandria
 
#6

AW: Bitmap shrinken

  Alt 9. Jan 2013, 10:06
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
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 22:39 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz