Problem bei Supersampling (Verkleinern einer TBitmap)

[Neutral General]

Das Mandelbrot muss roh sein! :-P

Wie weit bist du denn? Bin nämlich auch grad Mandelbrote am malen :)

[igel457]

Zitat:

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;

[igel457]

Meiner Weisheit letzter Schluss ist folgender Code, welcher wunderbar Super-gesampelte Bilder erzeugt. Leider ergeben sich helle Striche links und Rechts am Rand, aber ich weiß nicht woher die kommen, und habe jetzt keine Lust mehr danach zu suchen.

Delphi-Quellcode:

const
  ssv = 8; //8-Faches Super-Sampling

type
  TFC = packed record
    r,g,b: Single;
  end;
  PFC = ^TFC;

procedure TForm1.Button1Click(Sender: TObject);
function Cut(ain: single): single;
begin
  result := ain;
  if result > 255 then
    result := 255
  else if result < 0 then
    result := 0;
end;

var
  bitmap: TBitmap;
  re, im, rez, imz, rezold, col: Single;
  a: boolean;
  i, x, y: integer;
  pmem: PFC;
  ps: PFC;
  pi: PInteger;
const
  iterations = 100;
  colchangevar = 1;
begin
  bitmap := TBitmap.Create;
  bitmap.PixelFormat := pf32bit;
  bitmap.Width := Image1.Width;
  bitmap.Height := Image1.Height;

  GetMem(pmem, bitmap.Width * bitmap.Height * SizeOf(TFC));
  ZeroMemory(pmem, bitmap.Width * bitmap.Height * SizeOf(TFC));
  
  for y := 0 to (bitmap.height - 1) * ssv do
  begin
    for x := 0 to (bitmap.width - 1) * ssv do
    begin
      re := (x/bitmap.width/ssv)*4-2;  // mit Startwerten zoom = 4, move = -2
      im := (y/bitmap.height/ssv)*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;
      if not a then
      begin
       ps := pmem;
       inc(ps, (bitmap.Height) * trunc(y / ssv) + trunc(x/ssv));
       col := (rez*rez+imz*imz)/4*colchangevar;
       col := col+256*col+256*256+col;
       ps^.r := ps^.r + GetRValue(Round(col));
       ps^.g := ps^.g + GetGValue(Round(col));
       ps^.b := ps^.b + GetBValue(Round(col));
      end;
    end;
  end;

  for y := 0 to (bitmap.height - 1) do
  begin
    pi := bitmap.ScanLine[y];
    for x := 0 to (bitmap.width - 1) do
    begin
      inc(pi);
      ps := pmem;
      inc(ps, (bitmap.Height) * y + x);
      pi^ := RGB(
        Round(Cut(ps^.b / (ssv*ssv))),
        Round(Cut(ps^.g / (ssv*ssv))),
        Round(Cut(ps^.r / (ssv*ssv))));
    end;
  end;

  Image1.Picture.Bitmap := bitmap;
end;

[hellboyPS]

Hey danke, damit dürfte das Problem dann gelöst sein!
Zu der Färbung: Es dürfte euch aufgefallen sein, dass die Färbung totaler Schwachsinn ist.
Hab mich auch mit dem Kopieren vertan, habe meherere Färbungsmethoden zur Auswahl aber Standard ist diese

Delphi-Quellcode:

   col := it*colchangevar

und nicht

Delphi-Quellcode:

   col := (rez*rez+imz*imz)/4*colchangevar*10

Ich werde weiterhin in diesem Forum mit Fragen und Anregungen aktiv sein! Hat mir sehr geholfen danke!

[himitsu]

Zitat:

Code:

col := col+256*col+256*256[color=#ff0000][b]+[/b][/color]col;

liegt hier nicht die ganze Zeit ein Rechenfehler vor?

TFC ist 24 und das Bitmap 32 Bit :warn:

Zitat:

Delphi-Quellcode:

col := (rez*rez+imz*imz)/4*colchangevar;
col := col+256*col+256*256+col;
ps^.r := ps^.r + GetRValue(Round(col));
ps^.g := ps^.g + GetGValue(Round(col));
ps^.b := ps^.b + GetBValue(Round(col));

wozu alle Farben zusammenrechnen und dann nochmal zerlegen und erneut zusammensetzen?

Delphi-Quellcode:

// colB: Byte;
colB := Round((rez*rez+imz*imz)/4*colchangevar);
Inc(ps^.r, colB);
Inc(ps^.g, colB);
Inc(ps^.b, colB);

[igel457]

TFC ist 96Bit breit ;-)

[himitsu]

blödes Single
dachte dort wird schon auf das Bitmap zugegriffen :wall:

OK, dann stimmt das mit dem PI^ und den 32 Bit schon :oops: