Einfache Anti-Aliasing-Funktion für Delphi 7

Question

Ich brauche eine sehr einfache Funktion zum Zeichnen einer Menge von Linien mit Anti-Aliasing. Es muss dem Delphi-Paradigma folgen: Selbständig und SYSTEMUNABHÄNGIG (kein DLL-Hell), schnell, einfach. Kennt jemand solch eine Bibliothek?

Bisher habe ich versucht:

WuLine
swissdelphicenter.ch/torry/showcode.php?id=1812
Ich glaube nicht, dass der Autor dieses Codes es jemals ausgeführt hat. Es dauert eine Sekunde, um eine einzige Linie zu zeichnen! Offensichtlich dient es nur zu Lehrzwecken :)

Anti-Aliasing-Zeichnung aus TMetaFile
Link: blog.synopse.info/post/2010/04/02/Antialiased-drawing-from-TMetaFile
Ich habe es noch nicht wirklich ausprobiert (ich werde es vielleicht bald tun). Es funktioniert nur mit TMetaFiles. Es lädt nur eine EMF-Datei und zeichnet sie mit Anti-Aliasing-Funktionen. Außerdem ist viel Code auf dieser Website nur demonstrativ/lehrreich.

Image32
Sehr schöne Bibliothek - bisher am vollständigsten. Ich könnte es verwenden, aber es ist überdimensioniert für das, was ich brauche.
Nachteile:
- Der Fußabdruck, den die Anwendung hinzufügt, ist ziemlich groß.
- Wirklich schwer zu bedienen.
- Sie müssen sich selbst in die undurchsichtige Dokumentation vertiefen, selbst für einfache Aufgaben. - Der bereitgestellte Democode ist viel zu komplex.
- Fehlerhaft!
- Keine aktuellen Updates (um die Fehler zu beheben)

Anti-Grain Geometry Bibliothek
Die Bibliothek braucht einen anständigen Installer. Die Autoren der Bibliothek sind Linux/Mac-Benutzer. Die Windows-Implementierung sieht seltsam aus. Über die Bibliothek selbst kann ich nichts weiter sagen.

Funktion basierend auf Xiaolin Wu (von Andreas Rejbrand)
Schau dir nur ein paar Beiträge unten an. Andreas Rejbrand hat eine sehr kompakte Lösung bereitgestellt. Beste Lösung bisher.

---

Es sieht so aus, als ob ich erklären müsste, warum ich große 3rd-Party-Bibliotheken und VCLs nicht mag:

• Sie müssen sie installieren
• Eine große Bibliothek bedeutet viele Fehler, was bedeutet
• Sie müssen nach Updates suchen (und sie erneut installieren)
• Wenn Sie Delphi neu installieren, müssen Sie sie noch einmal installieren (ja, ich hasse es, VCLs zu installieren)
• Für VCLs bedeutet dies, dass Sie einige zusätzliche Symbole in Ihrer bereits überfüllten Palette laden müssen.
• (manchmal) keinen Support
• GROßER Fußabdruck, der der Größe Ihrer Anwendung hinzugefügt wird
• Eine große Bibliothek bedeutet (nicht immer, aber in den meisten Fällen) schwer zu bedienen - schwieriger als notwendig.
• (für externe DLLs und APIs) wird Ihre Anwendung systemabhängig - wirklich ärgerlich!

Answer 1

Es ist nicht sehr schwer, den Anti-Aliasing-Algorithmus von Xiaolin Wu zur Darstellung von Linien in Delphi zu implementieren. Ich habe der Wikipedia-Artikel als Referenz, als ich die folgende Prozedur schrieb (eigentlich habe ich nur den Pseudocode nach Delphi übersetzt und einen Fehler korrigiert und Unterstützung für einen farbigen Hintergrund hinzugefügt):

procedure DrawAntialisedLine(Canvas: TCanvas; const AX1, AY1, AX2, AY2: real; const LineColor: TColor);

var
  swapped: boolean;

  procedure plot(const x, y, c: real);
  var
    resclr: TColor;
  begin
    if swapped then
      resclr := Canvas.Pixels[round(y), round(x)]
    else
      resclr := Canvas.Pixels[round(x), round(y)];
    resclr := RGB(round(GetRValue(resclr) * (1-c) + GetRValue(LineColor) * c),
                  round(GetGValue(resclr) * (1-c) + GetGValue(LineColor) * c),
                  round(GetBValue(resclr) * (1-c) + GetBValue(LineColor) * c));
    if swapped then
      Canvas.Pixels[round(y), round(x)] := resclr
    else
      Canvas.Pixels[round(x), round(y)] := resclr;
  end;

  function rfrac(const x: real): real; inline;
  begin
    rfrac := 1 - frac(x);
  end;

  procedure swap(var a, b: real);
  var
    tmp: real;
  begin
    tmp := a;
    a := b;
    b := tmp;
  end;

var
  x1, x2, y1, y2, dx, dy, gradient, xend, yend, xgap, xpxl1, ypxl1,
  xpxl2, ypxl2, intery: real;
  x: integer;

begin

  x1 := AX1;
  x2 := AX2;
  y1 := AY1;
  y2 := AY2;

  dx := x2 - x1;
  dy := y2 - y1;
  swapped := abs(dx) < abs(dy);
  if swapped then
  begin
    swap(x1, y1);
    swap(x2, y2);
    swap(dx, dy);
  end;
  if x2 < x1 then
  begin
    swap(x1, x2);
    swap(y1, y2);
  end;

  gradient := dy / dx;

  xend := round(x1);
  yend := y1 + gradient * (xend - x1);
  xgap := rfrac(x1 + 0.5);
  xpxl1 := xend;
  ypxl1 := floor(yend);
  plot(xpxl1, ypxl1, rfrac(yend) * xgap);
  plot(xpxl1, ypxl1 + 1, frac(yend) * xgap);
  intery := yend + gradient;

  xend := round(x2);
  yend := y2 + gradient * (xend - x2);
  xgap := frac(x2 + 0.5);
  xpxl2 := xend;
  ypxl2 := floor(yend);
  plot(xpxl2, ypxl2, rfrac(yend) * xgap);
  plot(xpxl2, ypxl2 + 1, frac(yend) * xgap);

  for x := round(xpxl1) + 1 to round(xpxl2) - 1 do
  begin
    plot(x, floor(intery), rfrac(intery));
    plot(x, floor(intery) + 1, frac(intery));
    intery := intery + gradient;
  end;

end;

Um diese Funktion zu verwenden, geben Sie einfach die Leinwand an, auf die gezeichnet werden soll (ähnlich wie bei den Windows-GDI-Funktionen, die einen Gerätekontext (DC) erfordern), und geben Sie die Anfangs- und Endpunkte der Linie an. Beachten Sie, dass der obige Code eine schwarz Linie, und dass der Hintergrund muss weiß sein . Es ist nicht schwer, dies auf jede Situation zu verallgemeinern, auch nicht auf alpha-transparente Zeichnungen. Passen Sie einfach die plot Funktion, bei der c \in [0, 1] ist die Opazität des Pixels bei (x, y) .

Beispiel für die Verwendung:

Erstellen Sie ein neues VCL-Projekt und fügen Sie

procedure TForm1.FormCreate(Sender: TObject);
begin
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Color := clWhite;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  Canvas.FillRect(ClientRect);
  DrawAntialisedLine(Canvas, Width div 2, Height div 2, X, Y, clBlack);
end;

(Vergrößern)

OpenGL

Wenn Sie ein leistungsstarkes und qualitativ hochwertiges Rendering in 2D oder 3D benötigen und alle Zeichnungen selbst vornehmen, ist OpenGL im Allgemeinen die beste Wahl. Es ist sehr einfach, eine OpenGL-Anwendung in Delphi zu schreiben. Siehe http://privat.rejbrand.se/smooth.exe für ein Beispiel, das ich in nur zehn Minuten erstellt habe. Verwenden Sie die rechte Maustaste, um zwischen gefüllten Polygonen und Umrissen umzuschalten, und klicken und halten Sie die linke Maustaste zum Schießen!

Update

Ich habe den Code nur auf einen farbigen Hintergrund (z. B. ein Foto) angewendet.

(Vergrößern)

Update - Die ultraschnelle Methode

Der obige Code ist ziemlich langsam, weil die Bitmap.Pixels Eigentum ist erstaunlich langsam. Wenn ich mit Grafiken arbeite, stelle ich eine Bitmap immer mit einem zweidimensionalen Array von Farbwerten dar, was viel, viel, viel schneller ist. Und wenn ich mit dem Bild fertig bin, konvertiere ich es in eine GDI-Bitmap. Ich habe auch eine Funktion, die aus einer GDI-Bitmap ein Pixmap-Array erzeugt.

Ich habe den obigen Code geändert, um auf einem Array anstelle einer GDI-Bitmap zu zeichnen, und das Ergebnis ist vielversprechend:

• Erforderliche Zeit zum Rendern von 100 Zeilen
• GDI-Bitmap: 2.86 s
• Pixel-Anordnung: 0.01 s

Wenn wir die

type
  TPixmap = array of packed array of RGBQUAD;

und definieren

procedure TForm3.DrawAntialisedLineOnPixmap(var Pixmap: TPixmap; const AX1, AY1, AX2, AY2: real; const LineColor: TColor);
var
  swapped: boolean;

  procedure plot(const x, y, c: real);
  var
    resclr: TRGBQuad;
  begin
    if swapped then
    begin
      if (x < 0) or (y < 0) or (x >= ClientWidth) or (y >= ClientHeight) then
        Exit;
      resclr := Pixmap[round(y), round(x)]
    end
    else
    begin
      if (y < 0) or (x < 0) or (y >= ClientWidth) or (x >= ClientHeight) then
        Exit;
      resclr := Pixmap[round(x), round(y)];
    end;
    resclr.rgbRed := round(resclr.rgbRed * (1-c) + GetRValue(LineColor) * c);
    resclr.rgbGreen := round(resclr.rgbGreen * (1-c) + GetGValue(LineColor) * c);
    resclr.rgbBlue := round(resclr.rgbBlue * (1-c) + GetBValue(LineColor) * c);
    if swapped then
      Pixmap[round(y), round(x)] := resclr
    else
      Pixmap[round(x), round(y)] := resclr;
  end;

  function rfrac(const x: real): real; inline;
  begin
    rfrac := 1 - frac(x);
  end;

  procedure swap(var a, b: real);
  var
    tmp: real;
  begin
    tmp := a;
    a := b;
    b := tmp;
  end;

var
  x1, x2, y1, y2, dx, dy, gradient, xend, yend, xgap, xpxl1, ypxl1,
  xpxl2, ypxl2, intery: real;
  x: integer;

begin

  x1 := AX1;
  x2 := AX2;
  y1 := AY1;
  y2 := AY2;

  dx := x2 - x1;
  dy := y2 - y1;
  swapped := abs(dx) < abs(dy);
  if swapped then
  begin
    swap(x1, y1);
    swap(x2, y2);
    swap(dx, dy);
  end;
  if x2 < x1 then
  begin
    swap(x1, x2);
    swap(y1, y2);
  end;

  gradient := dy / dx;

  xend := round(x1);
  yend := y1 + gradient * (xend - x1);
  xgap := rfrac(x1 + 0.5);
  xpxl1 := xend;
  ypxl1 := floor(yend);
  plot(xpxl1, ypxl1, rfrac(yend) * xgap);
  plot(xpxl1, ypxl1 + 1, frac(yend) * xgap);
  intery := yend + gradient;

  xend := round(x2);
  yend := y2 + gradient * (xend - x2);
  xgap := frac(x2 + 0.5);
  xpxl2 := xend;
  ypxl2 := floor(yend);
  plot(xpxl2, ypxl2, rfrac(yend) * xgap);
  plot(xpxl2, ypxl2 + 1, frac(yend) * xgap);

  for x := round(xpxl1) + 1 to round(xpxl2) - 1 do
  begin
    plot(x, floor(intery), rfrac(intery));
    plot(x, floor(intery) + 1, frac(intery));
    intery := intery + gradient;
  end;

end;

und die Umrechnungsfunktionen

var
  pixmap: TPixmap;

procedure TForm3.CanvasToPixmap;
var
  y: Integer;
  Bitmap: TBitmap;
begin

  Bitmap := TBitmap.Create;
  try
    Bitmap.SetSize(ClientWidth, ClientHeight);
    Bitmap.PixelFormat := pf32bit;

    BitBlt(Bitmap.Canvas.Handle, 0, 0, ClientWidth, ClientHeight, Canvas.Handle, 0, 0, SRCCOPY);

    SetLength(pixmap, ClientHeight, ClientWidth);
    for y := 0 to ClientHeight - 1 do
      CopyMemory(@(pixmap[y][0]), Bitmap.ScanLine[y], ClientWidth * sizeof(RGBQUAD));

  finally
    Bitmap.Free;
  end;

end;

procedure TForm3.PixmapToCanvas;
var
  y: Integer;
  Bitmap: TBitmap;
begin
  Bitmap := TBitmap.Create;

  try
    Bitmap.PixelFormat := pf32bit;
    Bitmap.SetSize(ClientWidth, ClientHeight);

    for y := 0 to Bitmap.Height - 1 do
      CopyMemory(Bitmap.ScanLine[y], @(Pixmap[y][0]), ClientWidth * sizeof(RGBQUAD));

    Canvas.Draw(0, 0, Bitmap);

  finally
    Bitmap.Free;
  end;

end;

dann können wir schreiben

procedure TForm3.FormPaint(Sender: TObject);
begin

  // Get the canvas as a bitmap, and convert this to a pixmap
  CanvasToPixmap;

  // Draw on this pixmap (very fast!)
  for i := 0 to 99 do
    DrawAntialisedLineOnPixmap(pixmap, Random(ClientWidth), Random(ClientHeight), Random(ClientWidth), Random(ClientHeight), clRed);

  // Convert the pixmap to a bitmap, and draw on the canvas
  PixmapToCanvas;

end;

die in weniger als einer Hundertstelsekunde 100 entzerrte Linien auf dem Formular darstellt.

Es scheint jedoch einen kleinen Fehler im Code zu geben, wahrscheinlich in der Funktion Canvas -> Pixmap. Aber im Moment bin ich viel zu müde, um zu debuggen (kam gerade von der Arbeit nach Hause).

Answer 2

Ich glaube, dass GDI+ standardmäßig Anti-Aliasing-Zeichnung unterstützt. Ich weiß nicht, ob aktuelle Delphi-Versionen eine GdiPlus.pas haben, aber es gibt Kopien online verfügbar.

Answer 3

Sie können TAgg2D ausprobieren. Es handelt sich um eine vereinfachte API für 2D-Zeichnung über AggPas. So können Sie einfache Funktionen wie:

• Linie (x1, y1, x2, y2)
• Rechteck (x1, y1, x2, y2)
• Aurundetes Rechteck (x1, y1, x2, y2, r)

Einfach!

Answer 4

Versuche es mit der Anti-Grain Geometry Bibliothek

Answer 5

Laden Sie Graphics32 herunter. Erstellen Sie eine neue Instanz von TBitmap32. Rufen Sie die Methode TBitmap32.RenderText auf:

procedure TBitmap32.RenderText(X, Y: Integer; const Text: String; AALevel: Integer; Color: TColor32);

if AALevel > -1, dann sollten Sie Text mit Anti-Aliasing erhalten.

Wenn Sie fertig sind, Text(e) auf Ihrer TBitmap32-Instanz zu schreiben, können Sie diese Instanz mit der Methode DrawTo auf beliebige Canvas zeichnen:

procedure TBitmap32.DrawTo(hDst: HDC; DstX, DstY: Integer);