Transparente Polygone zeichnen

[Jacks]

Hi Zusammen,

In meiner Datenbank befinden sich >10000 Polygone (jedes Polygon kann sich in Color und Style unterscheiden).
Alle Polygone möchte ich gerne mit Transparenz (unabhängig von der ausgelesenen Reihenfolge) zeichnen.

Aktuell bekomme ich leider nur folgendes Ergebnis Hier werden früh gezeichnete Polygone nur überzeichnet.

Gewünschtes Resultat jedoch:

Hat jemand einen Tipp?

Code:

Bitmap.Transparent := True;
Bitmap.TransparentColor := clWhite;
...
BitMap.canvas.brush.color := Random
BitMap.canvas.brush.style:= Random
... 
MyCanvas.Canvas.Polygon(polygon);

Danke und Grüße
Jacks

[DeddyH]

Je nach Delphi-Version könntest Du auf Firemonkey, GDI+ oder TransparentCanvas zurückgreifen.

[ibp]

schau mal hier

[TiGü]

Zitat von DeddyH:

Je nach Delphi-Version könntest Du auf Firemonkey, GDI+ oder TransparentCanvas zurückgreifen.

Oder ab Delphi 2010 auch der TDirect2DCanvas aus Vcl.Direct2D.

[Medium]

Zitat von Jacks:

(unabhängig von der ausgelesenen Reihenfolge)

Das hier ist, wenn die Auslesereihenfolge nachher auch deine Zeichenreihenfolge ist, dein Problem. Und das ist ein absolut klassisches Problem . Deinen Bildern nach hast du nur 2D-Polygone, aber sobald (beliebige) Tranzparenzen ins Spiel kommen, bist du zwangsweise in der 3. Dimension. Grund: Ein 80% deckendes Polygon auf ein 20% deckendes gezeichnet sieht anders aus als ein 20% deckendes auf einem 80% deckenden. Noch deutlicher wird es, wenn eines der beiden 100% deckt.
Egal wie man sich dreht und wendet: Du brauchst eine Z-Order, wenn du ein immer klar definiertes immer gleiches Ergebnis haben willst.

[Namenloser]

Hier mal eine alte Routine von mir:

Delphi-Quellcode:

procedure FillPolygonAlpha(Vertices: TVertexList; Dest: TBitmap;
  Color: TColor);
type
  TIntegerArray = array of integer;
var
  x,y: integer;
  i,j: integer;
  PixelPtr: PColor;
  BasePixelPtr: PColor;
  ColorPartR, ColorPartG, ColorPartB, ColorA: Byte;
  Breakpoints: TIntegerArray;

  function GetBreakpoints(Row: integer; XOffset: integer): TIntegerArray;
  var
    Pt1, Pt2: TPoint;
    PtOld, PtNew: TPoint;
    Count: integer;
    i: integer;

    procedure QuickSort(var SortList: TIntegerArray; L, R: Integer);
    var
      I, J: Integer;
      P, T: Integer;
    begin
      repeat
        I := L;
        J := R;
        P := Sortlist[(L + R) div 2];
        repeat
          while SortList[i] < P do
            Inc(I);
          while SortList[j] > P do
            Dec(J);
          if I <= J then
          begin
            T := SortList[I];
            SortList[I] := SortList[J];
            SortList[J] := T;
            Inc(I);
            Dec(J);
          end;
        until I > J;
        if L < J then
          QuickSort(SortList, L, J);
        L := I;
      until I >= R;
    end;

  begin
    PtOld := Vertices.Last;
    Count := 0;
    SetLength(Result, Vertices.Count);
    for i := 0 to Vertices.Count - 1 do
    begin
      PtNew := Vertices[i];
      if PtNew.Y > PtOld.Y then
      begin
        Pt1 := PtOld;
        Pt2 := PtNew;
      end
      else
      begin
        Pt1 := PtNew;
        Pt2 := PtOld;
      end;
      if ((PtNew.Y < Row) = (Row <= PtOld.Y)) and
         ((XOffset-Pt1.X)*(Pt2.Y-Pt1.Y) < (Pt2.X-Pt1.X)*(Row-Pt1.Y)) then
      begin
        Result[Count] :=   trunc(Pt2.X * (Row-Pt1.y) / (Pt2.Y-Pt1.Y)
                             +   Pt1.X * (Pt2.Y-Row) / (Pt2.Y-Pt1.Y));
        inc(Count);
      end;
      PtOld := PtNew;
    end;
    SetLength(Result,Count);
    if length(Result)>=1 then
      Quicksort(Result,0,high(Result));
  end;
begin

  if Vertices.Count < 3 then exit;

  Dest.PixelFormat := pf32Bit;

  ColorA := Color shr 24;
  ColorPartR := Muldiv(GetRValue(Color), ColorA,255);
  ColorPartG := Muldiv(GetGValue(Color), ColorA,255);
  ColorPartB := Muldiv(GetBValue(Color), ColorA,255);
  
  for y := EnsureRange(Vertices.BoundingBox.Top, 0, Dest.Height-1) to
           EnsureRange(Vertices.BoundingBox.Bottom, 0, Dest.Height-1) do
  begin
    BasePixelPtr := Dest.ScanLine[y];
    x := Vertices.BoundingBox.Left;
    BreakPoints := GetBreakpoints(y,x-1);
    i := 0;
    while i <= high(Breakpoints) do
    begin
      PixelPtr := BasePixelPtr;
      inc(PixelPtr, EnsureRange(Breakpoints[i], 0, Dest.Width-1));
      for j := EnsureRange(Breakpoints[i], 0, Dest.Width) to
               EnsureRange(Breakpoints[i+1], 0, Dest.Width-1) do
      begin
        PixelPtr^ :=
          ColorPartR +
          Muldiv(PixelPtr^ and $00FF0000 shr 16,255-ColorA,255) shl 16 or

          ColorPartG +
          Muldiv(PixelPtr^ and $0000FF00 shr 8,255-ColorA,255) shl 8 or

          ColorPartB +
          Muldiv(PixelPtr^ and $000000FF,255-ColorA,255);
        inc(PixelPtr);
      end;
      inc(i,2);
    end;
  end;
end;

Wahrscheinlich nicht das allerschnellste (Polygone rendern ist sowieso eine Wissenschaft für sich), aber tut seinen Job.

TVertexList ist so deklariert:

Delphi-Quellcode:

  TVertexList = class
  public
    property Items[Index: integer]: TPoint read GetItem write SetItem; default;
    { ... }

    property BoundingBox: TRect read FBoundingBox;
  end;

Die Implementierung kann man sich denken. Wenn man keine Klasse dafür verwenden will, kann man die Routine natürlich auch leicht auf array of TPoint oder so anpassen, aber dazu bin ich jetzt zu faul. Man müsste aber nur drei, vier Stellen ändern.

[Jacks]

Vielen Dank,

ich verwende XE2. Habe nun das ganze mit Direct2D umgesetzt.
Hätte nun erwartet, wenn ich alle Polygone mit einer Deckkraft von 50% zeichne, bekomme ich mein gewünschtes Ergebnis. Ist leider nicht so!

Zitat von Medium:

Ein 80% deckendes Polygon auf ein 20% deckendes gezeichnet sieht anders aus als ein 20% deckendes auf einem 80% deckenden. Noch deutlicher wird es, wenn eines der beiden 100% deckt.

Kann ich vielleicht die Deckkraft an den Brush.Color anpassen? oder bin ich da auf dem falschen Dampfer?

[Neutral General]

Was willst du denn genau erreichen? Es kommt halt immer auf die Reihenfolge an in der du zeichnest.
Wenn deine einzige Anforderung ist, dass es immer gleich aussieht kannst du ja notfalls einfach per Datenbank-ID sortieren.
Falls das nicht ausreicht musst du wie bereits erwähnt die Z-Werte speichern.

[Jacks]

Zitat von Namenloser:

Wahrscheinlich nicht das allerschnellste (Polygone rendern ist sowieso eine Wissenschaft für sich), aber tut seinen Job.

Ich brauche schon eine schnellere Methode, da ich recht große Datensätze zum zeichnen habe.

[Jacks]

Zitat von Neutral General:

Was willst du denn genau erreichen? Es kommt halt immer auf die Reihenfolge an in der du zeichnest.
Wenn deine einzige Anforderung ist, dass es immer gleich aussieht kannst du ja notfalls einfach per Datenbank-ID sortieren.
Falls das nicht ausreicht musst du wie bereits erwähnt die Z-Werte speichern.

Hatte die Hoffnung - es gibt eine Funktion für mein Problem. Aber du hast natürlich Recht!
Werde nun meine Datenbank nach Ebenen sortieren.