Schnelligkeit von FastBitmap, Optimierungsmöglichkeiten

Für Probleme bezüglich Grafik, Audio, GL, ACS, ...
Antworten
400kmh
Beiträge: 92
Registriert: Do 25. Mär 2010, 04:03

Schnelligkeit von FastBitmap, Optimierungsmöglichkeiten

Beitrag von 400kmh »

Hallo,

ich habe ein paar Fragen zur Optimierung von Zeichnungsvorgängen.

Ich habe mittels Bitmap.Canvas eine recht zufriedenstellende Grafikausgabe programmiert, hauptsächlich mittels Canvas.Polygon. Jedoch bin ich an ein paar Grenzen gelangt:
- Bei noch mehr zu zeichnenden Polygonen wird das Programm zu langsam (etwas abhängig vom Computer).
- Abgesehen von der Anzahl der Polygone könnten die einzelnen Polygone noch besser sein z. B. durch Kantenglättung oder Helligkeitsverläufe (Belichtungseffekte).

Auf der Suche nach Verbesserungsmöglichkeiten bin ich auf https://wiki.freepascal.org/Fast_direct_pixel_access gestoßen. Auf der Seite fehlt zwar ein richtiger Beispielquelltext, indem die ganzen Einzelteile zusammengefügt sind, aber irgendwie konnte ich mir daraus doch mit ein paar Änderungen etwas funktionierendes zusammenbasteln. Ich habe ein TFastBitmap programmiert als Ersatz für Bitmap(.Canvas).

Der Vorteil einer solchen FastBitmap scheint zu sein, dass einzelne Pixel wesentlich schneller geändert werden können als mit Canvas.Pixels. Auch kleine Polygone lassen sich mit selbst erstellten Prozeduren damit schneller zeichnen. Je größer die gezeichnete Fläche ist, desto langsamer wird das Ganze aber. Bei Flächen bildschirmgroßer Flächen kann es gegenüber Canvas.Rectangle überhaupt nicht mehr mithalten. Hier habe ich z. B. die Zeichnung eines Rechtecks programmiert:

Code: Alles auswählen

Procedure TFastBitmap.Rechteck(Integer1, Integer2, Integer3, Integer4: Integer);
var
  Zaehler1, Zaehler2: Integer;
begin
  for Zaehler1:=Integer1 to Integer3 do
  begin
    for Zaehler2:=Integer2 to Integer4 do
      Pixels[Zaehler1, Zaehler2]:=Farbe;
    for Zaehler2:=Integer2 downto Integer4 do
      Pixels[Zaehler1, Zaehler2]:=Farbe;
  end;
  for Zaehler1:=Integer1 downto Integer3 do
  begin
    for Zaehler2:=Integer2 to Integer4 do
      Pixels[Zaehler1, Zaehler2]:=Farbe;
    for Zaehler2:=Integer2 downto Integer4 do
      Pixels[Zaehler1, Zaehler2]:=Farbe;
  end;
end;

Farbe ist hierbei ein Wert vom Typ TColor.

Einzelne Pixel lassen sich so sehr schnell zeichnen, aber bei Massenzuweisungen scheint Canvas einen Methodik zu haben, die viel schneller ist, und die mir überhaupt nicht erklärlich ist. Einfacher kann man das doch nicht programmieren, und irgendwie muss jedem Pixel doch eine Farbe zugewiesen werden.

Ein weiteres Problem gibt es auch bei kleineren Flächen. Will man sie mit geglätteten Kanten zeichnen, muss man im Kantenbereich die Farbe jedes einzelnen Pixels einzeln berechnen. Die Ausgabe des berechneten Pixels geht zwar im Vergleich mit Canvas.Pixels hier super schnell, aber die Berechnung an sich dauert viel zu lange. Das ist zwar etwas was Canvas auch nicht kann, aber zweifelsohne ist es grundsätzlich ja möglich, denn z. B. bei einem modernen Computerspiel hat ja quasi jeder Pixel eine eigene Farbe. Das heißt Millionen Pixel werden vielfach pro Sekunde berechnet.

Daraus ergeben sich zwei Fragen:
- Ist es möglich eine Farbe gleichzeitig schnell ganz vielen Pixeln zuzuweisen? Da Canvas das hinkriegt, stellt sich eher die Frage nach dem wie.
- Wie ist es möglich in sehr kurzer Zeit, die Berechnung Millionen unterschiedlicher Pixel vorzunehmen?

Bei der zweiten Frage geht es eher um Schnick-Schnack. Davon ist vieles eh schwierig zu berechnen, vielleicht greife ich da mal auf was vorgefertigtes zurück. Bei der ersten Frage hingegen geht es um die Anzeige der Grundinformationen die einfach schnell genug sein muss.

Hier noch der gesamte relevante Teil des Programms:

Code: Alles auswählen

Type
 
  TFastBitmap = class
    Procedure Linie(Integer1, Integer2, Integer3, Integer4: Integer);
    Procedure Rechteck(Integer1, Integer2, Integer3, Integer4: Integer);
    Procedure Dreieck(Point1, Point2, Point3: TPoint);
  private
    function GetSize: TPoint;
    procedure SetSize(const AValue: TPoint);
  public
    Pixels: array of array of TColor;
    property Size: TPoint read GetSize write SetSize;
  end;
 
  TForm1 = class(TForm)
    Procedure TimerTimer(Sender: TObject);
  end;
 
Var
  Sollzeit, Istzeit, Anfangszeit: Integer;
  Form1: TForm1;
  Timer: TTimer;
  Bitmap: TBitmap;
  Zaehler1, Zaehler2: integer;
  Point: Array [1..3] of TPoint;
  FastBitmap1: TFastBitmap;
  Punkt: TPoint;
  Farbe: TColor;
 
function TFastBitmap.GetSize: TPoint;
  begin
    Result.X := Length(Pixels);
    if Result.X > 0 then Result.Y := Length(Pixels[0])
      else Result.Y := 0;
  end;
 
procedure TFastBitmap.SetSize(const AValue: TPoint);
  begin
    SetLength(Pixels, AValue.X, AValue.Y);
  end;
 
procedure FastBitmapToBitmap(FastBitmap: TFastBitmap; Bitmap: TBitmap);
var
  X, Y: Integer;
  PixelPtr: PInteger;
  PixelRowPtr: PInteger;
  RawImage: TRawImage;
  BytePerPixel: Integer;
begin
  try
    Bitmap.BeginUpdate(False);
    RawImage := Bitmap.RawImage;
    PixelRowPtr := PInteger(RawImage.Data);
    BytePerPixel := RawImage.Description.BitsPerPixel div 8;
    for Y := 0 to FastBitmap.Size.Y - 1 do begin
      PixelPtr := PixelRowPtr;
      for X := 0 to FastBitmap.Size.X - 1 do begin
        PixelPtr^ := FastBitmap.Pixels[X, Y];
        Inc(PByte(PixelPtr), BytePerPixel);
      end;
      Inc(PByte(PixelRowPtr), RawImage.Description.BytesPerLine);
    end;
  finally
    Bitmap.EndUpdate(False);
  end;
end;
 
Procedure TFastBitmap.Linie(Integer1, Integer2, Integer3, Integer4: Integer);
var
  P: Array [1..2] of TPoint;
  yNr1, yNr2, xNr1, xNr2: Integer;
  Zaehler1: Integer;
begin
  P[1].x:=Integer1;
  P[1].y:=Integer2;
  P[2].x:=Integer3;
  P[2].y:=Integer4;
 
  if P[1].y<=P[2].y then
  begin
    yNr1:=1;
    yNr2:=2;
  end else
  begin
    yNr1:=2;
    yNr2:=1;
  end;
 
  for Zaehler1:=P[yNr1].y to P[yNr2].y do
    Pixels[round(P[yNr1].x+(P[yNr2].x-P[yNr1].x)*(Zaehler1-P[yNr1].y)/(P[yNr2].y-P[yNr1].y+1e-100)),Zaehler1]:=Farbe;
 
  if P[1].x<=P[2].x then
  begin
    xNr1:=1;
    xNr2:=2;
  end else
  begin
    xNr1:=2;
    xNr2:=1;
  end;
 
  for Zaehler1:=P[xNr1].x to P[xNr2].x do
    Pixels[Zaehler1,round(P[xNr1].y+(P[xNr2].y-P[xNr1].y)*(Zaehler1-P[xNr1].x)/(P[xNr2].x-P[xNr1].x+1e-100))]:=Farbe;
end;
 
Procedure TFastBitmap.Rechteck(Integer1, Integer2, Integer3, Integer4: Integer);
var
  Zaehler1, Zaehler2: Integer;
begin
  for Zaehler1:=Integer1 to Integer3 do
  begin
    for Zaehler2:=Integer2 to Integer4 do
      Pixels[Zaehler1, Zaehler2]:=Farbe;
    for Zaehler2:=Integer2 downto Integer4 do
      Pixels[Zaehler1, Zaehler2]:=Farbe;
  end;
  for Zaehler1:=Integer1 downto Integer3 do
  begin
    for Zaehler2:=Integer2 to Integer4 do
      Pixels[Zaehler1, Zaehler2]:=Farbe;
    for Zaehler2:=Integer2 downto Integer4 do
      Pixels[Zaehler1, Zaehler2]:=Farbe;
  end;
end;
 
Procedure TFastBitmap.Dreieck(Point1, Point2, Point3: TPoint);
Var
  Zaehler, Zaehler2: Integer;
  yNr1, yNr2, yNr3: Integer;
  P: Array [1..3] of Tpoint;
  x1, x2: Real;
  xNr1, xNr2: Real;
begin
  P[1]:=Point1;
  P[2]:=Point2;
  P[3]:=Point3;
  if (P[1].y<=P[2].y) and (P[1].y<=P[3].y) then begin
    yNr1:=1;
    if P[2].y<=P[3].y then
    begin
      yNr2:=2;
      yNr3:=3;
    end else
    begin
      yNr2:=3;
      yNr3:=2;
    end;
  end else
  if P[2].y<=P[3].y then
  begin
    yNr1:=2;
    if P[1].y<=P[3].y then
    begin
      yNr2:=1;
      yNr3:=3;
    end else
    begin
      yNr2:=3;
      yNr3:=1;
    end;
  end else
  begin
    yNr1:=3;
    if P[1].y<=P[2].y then
    begin
      yNr2:=1;
      yNr3:=2;
    end else
    begin
      yNr2:=2;
      yNr3:=1;
      end;
    end;
 
  for Zaehler:=P[yNr1].y to P[yNr2].y do
  begin
    x1:=P[yNr1].x+(P[yNr2].x-P[yNr1].x)*(Zaehler-P[yNr1].y)/(P[yNr2].y-P[yNr1].y+1e-100);
    x2:=P[yNr1].x+(P[yNr3].x-P[yNr1].x)*(Zaehler-P[yNr1].y)/(P[yNr3].y-P[yNr1].y+1e-100);
    if x1<x2 then begin xNr1:=x1; xNr2:=x2; end else begin xNr1:=x2; xNr2:=x1; end;
    for Zaehler2:=round(xNr1) to round(xNr2) do FastBitmap1.Pixels[Zaehler2,Zaehler]:=Farbe;
  end;
 
  for Zaehler:=P[yNr2].y to P[yNr3].y do
  begin
    x1:=P[yNr2].x+(P[yNr3].x-P[yNr2].x)*(Zaehler-P[yNr2].y)/(P[yNr3].y-P[yNr2].y+1e-100);
    x2:=P[yNr1].x+(P[yNr3].x-P[yNr1].x)*(Zaehler-P[yNr1].y)/(P[yNr3].y-P[yNr1].y+1e-100);
    if x1<x2 then begin xNr1:=x1; xNr2:=x2; end else begin xNr1:=x2; xNr2:=x1; end;
    for Zaehler2:=round(xNr1) to round(xNr2) do FastBitmap1.Pixels[Zaehler2,Zaehler]:=Farbe;
  end;
 
  Linie(Point[1].x,Point[1].y,Point[2].x,Point[2].y);
  Linie(Point[1].x,Point[1].y,Point[3].x,Point[3].y);
  Linie(Point[2].x,Point[2].y,Point[3].x,Point[3].y);
 
end;

Gibt es hier grundsätzliche Möglichkeiten, das zu beschleunigen?

Antworten