Problem bei Supersampling (Verkleinern einer TBitmap)

[igel457]

Zitat von hellboyPS:

Hab den Post von igel457 mal umgesetzt.
Folgendes Ergebnis:

Vorher: http://img37.imageshack.us/i/vorher.png/
Nachher: http://img24.imageshack.us/i/nachhero.png/

Leider auch nicht das passende Ergebnis. Ich werde mich mit der GR32 Library mal auseinandersetzen.

Danke für die bisherigen Posts schon mal.

Ich habe das mal ausprobiert - der Fehler kommt durch die Art, wie du die Farbe berechnest. Wie Medium dich schon hingewiesen hat, gibt es so auch zwischen Subpixeln einen Überlauf im Farbkanal. Schließlich mache ich ja nichts anderes als für die Farbwerte von vier Pixeln auf einen zu vereinen. Daher liefert meine Implementierung tatsächlich weiche Kanten:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);

var
  bitmap: TBitmap;
  re, im, rez, imz, rezold, col: Single;
  a: boolean;
  i, x, y: integer;
  oldcolor: TColor;
  newcolor: TColor;
const
  iterations = 100;
  colchangevar = 0.05;
begin
  bitmap := TBitmap.Create;
  bitmap.Width := Image1.Width;
  bitmap.Height := Image1.Height;
  bitmap.Canvas.Brush.Color := clBlack;
  bitmap.Canvas.FillRect(bitmap.Canvas.ClipRect);
  for x :=  0 to bitmap.width * 2 do
  begin
    for y := 0 to bitmap.height * 2 do
    begin
      re := (x/bitmap.width/2)*4-2;  // mit Startwerten zoom = 4, move = -2
      im := (y/bitmap.height/2)*4-2;
      rez := 0;
      imz := 0;
      a := true;
      for i := 0 to iterations do
      begin
       if a then
       begin
        rezold := rez;
        rez := rez*rez-imz*imz+re;
        imz := 2*rezold*imz+im;
        if rez*rez+imz*imz > 4 then
         a := false;
       end;
      end;
      col := (rez*rez+imz*imz)/4*colchangevar*10;
      if not a then
      begin
       oldcolor := bitmap.canvas.Pixels[trunc(x/2),trunc(y/2)];
       newcolor := round(col+256*col+256*256+col);
       bitmap.canvas.Pixels[trunc(x/2),trunc(y/2)] := RGB(
         round(GetRValue(oldcolor) + GetRValue(newcolor) * 0.25),
         round(GetGValue(oldcolor) + GetGValue(newcolor) * 0.25),
         round(GetBValue(oldcolor) + GetBValue(newcolor) * 0.25));
      end;
    end;
  end;
  Image1.Picture.Bitmap := bitmap;
end;

Edit: Hier noch schnell die Scanline-Version:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);

var
  bitmap: TBitmap;
  re, im, rez, imz, rezold, col: Single;
  a: boolean;
  i, x, y: integer;
  oldcolor: TColor;
  newcolor: TColor;
  pi: PInteger;
const
  iterations = 100;
  colchangevar = 0.05;
begin
  bitmap := TBitmap.Create;
  bitmap.PixelFormat := pf32bit;
  bitmap.Width := Image1.Width;
  bitmap.Height := Image1.Height;
  bitmap.Canvas.Brush.Color := clBlack;
  bitmap.Canvas.FillRect(bitmap.Canvas.ClipRect);
  for y := 0 to (bitmap.height - 1) * 2 do
  begin
    for x := 0 to (bitmap.width - 1) * 2 do
    begin
      re := (x/bitmap.width/2)*4-2;  // mit Startwerten zoom = 4, move = -2
      im := (y/bitmap.height/2)*4-2;
      rez := 0;
      imz := 0;
      a := true;
      for i := 0 to iterations do
      begin
       if a then
       begin
        rezold := rez;
        rez := rez*rez-imz*imz+re;
        imz := 2*rezold*imz+im;
        if rez*rez+imz*imz > 4 then
         a := false;
       end;
      end;
      col := (rez*rez+imz*imz)/4*colchangevar*10;
      if not a then
      begin
       pi := bitmap.ScanLine[trunc(y/2)];
       if pi <> nil then
       begin
         inc(pi, trunc(x/2));
         oldcolor := pi^;;
         newcolor := round(col+256*col+256*256+col);
         pi^ := RGB(
           round(GetBValue(oldcolor) + GetBValue(newcolor) * 0.25),
           round(GetGValue(oldcolor) + GetGValue(newcolor) * 0.25),
           round(GetRValue(oldcolor) + GetRValue(newcolor) * 0.25));
       end;
      end;
    end;
  end;
  Image1.Picture.Bitmap := bitmap;
end;