Einzelnen Beitrag anzeigen

Benutzerbild von igel457
igel457

Registriert seit: 31. Aug 2005
1.622 Beiträge
 
FreePascal / Lazarus
 
#6

Re: Problem bei Supersampling (Verkleinern einer TBitmap)

  Alt 28. Dez 2009, 17:46
Eine Möglichkeit wäre die folgende: Färbe das Bitmap zunächst komplett schwarz ein. Verdopple die Durchläufe der For-Schleife bei Höhe und Breite, teile "x" und "y" jedoch bei allen Zugriffen mit "/" durch zwei - bei dem Zugriff auf "Pixels[x, y]" musst du entsprechend runden, also "Pixels[round(x/2), round(y/2)]". Beim Setzen der Farbe multipilizierst du den Farbwert jeweils mit 1/4 und addierst diesen Wert auf die alte Pixelfarbe drauf.

Ungefähr so (ungetestet):
Delphi-Quellcode:
for x := 0 to bitmap.width * 2 do
begin
for y := 0 to bitmap.height * 2 do
begin
  re := (x/bitmap.width/2)*zoom+movex; // mit Startwerten zoom = 4, move = -2
  im := (y/bitmap.height/2)*zoom+movey;
  rez := 0;
  imz := 0;
  a := true;
  it := 0;
  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
    begin
     a := false;
     it := i;
    end;
   end;
  end;
  col := (rez*rez+imz*imz)/4*colchangevar*10
  if not a then
  begin
   oldcolor := bitmap.canvas.Pixels[round(x/2),round(y/2)];
   newcolor := round(col+256*col+256*256+col);
   bitmap.canvas.Pixels[round(x/2),round(y/2)] := RGB(
     rounc(GetRValue(oldcolor) + GetRValue(newcolor) * 0.25),
     rounc(GetGValue(oldcolor) + GetGValue(newcolor) * 0.25),
     rounc(GetBValue(oldcolor) + GetBValue(newcolor) * 0.25));
  end;
end;
end;
Andreas
"Sollen sich auch alle schämen, die gedankenlos sich der Wunder der Wissenschaft und Technik bedienen, und nicht mehr davon geistig erfasst haben als die Kuh von der Botanik der Pflanzen, die sie mit Wohlbehagen frisst." - Albert Einstein
  Mit Zitat antworten Zitat