Opaciy Problem in Firemonkey

[ht47]

Hallo,

ich experimentiere derzeitig ein wenig mit Delphi XE7 und Firemonkey. Ich habe aber ein Problem mit Drawline und der Opacity Einstellung.

Ich benutze eine Form mit einem Button und einer Paintbox. Im OnClick des Buttons nutze ich folgenden Code:

begin
PaintBox1.Canvas.BeginScene;
PaintBox1.Canvas.DrawLine(PointF(10,10),PointF(110 ,10),1);
PaintBox1.Canvas.DrawLine(PointF(110,10),PointF(11 0,110),1);
PaintBox1.Canvas.DrawLine(PointF(110,110),PointF(1 0,110),1);
PaintBox1.Canvas.DrawLine(PointF(10,110),PointF(10 ,10),1);
PaintBox1.EndScene;
end;

Das Zeichnen funktioniert eigentlich problemlos. Nur werden die Linie nicht in vollem schwarz gezeichnet, sondern höchstens in 50 % Deckung. Woran kann das liegen ?

Grüße

Holger

[Darlo]

Was für eine Tickness hast Du dnen eingestellt? Kann es sein, dass bei Tickness := 1 das aufgrund von Kantenglättung einfach so wirkt?

[Der schöne Günther]

Hallo und Willkommen in den Heiligen Hallen des Wissens und des Wahnsinns

Der Deckungsgrad ist mit 1.0 schon richtig gewählt. Es liegt an der Dicke des Stifts. Füge nach deinem BeginScene() mal die Zeile PaintBox1.Canvas.StrokeThickness := 0.75; ein und der Effekt verstärkt sich noch!

Es wäre nämlich zu einfach gewesen auf glatten Koordinaten wie (100 | 0) zu zeichnen, du musst jeweils die halbe Stiftbreite wieder abziehen.

Hier als Beispiel einmal das ständige Abziehen einmal in eine lokale Prozedur "draw" ausgelagert. Im Nachhinein merke ich dass es wohl schlauer gewesen wäre das als Klassenhelfer zu machen

Delphi-Quellcode:

procedure TForm3.Button1Click(Sender: TObject);
var
   fromPoint:   TPointF;
   toPoint:   TPointF;
   draw:      TProc<TPointF, TPointF>;
begin
   draw :=
      procedure(fromPoint, toPoint: TPointF)
      var
         offset: Single;
      begin
         offset := PaintBox1.Canvas.StrokeThickness / 2.0;
         fromPoint.Offset(-offset, -offset);
         toPoint.Offset(-offset, -offset);
         PaintBox1.Canvas.DrawLine(fromPoint, ToPoint, 1.0);
      end;

   PaintBox1.Canvas.BeginScene();
   try
      fromPoint := TPointF.Create(10, 10);
      toPoint := fromPoint; toPoint.Offset(100, 0);
      draw(fromPoint, toPoint);

      fromPoint.Offset(100, 0); toPoint.Offset(0, 100);
      draw(fromPoint, toPoint);

      fromPoint.Offset(0, 100); toPoint.Offset(-100, 0);
      draw(fromPoint, toPoint);

      fromPoint.Offset(-100, 0); toPoint.Offset(0, -100);
      draw(fromPoint, toPoint);
   finally
      PaintBox1.Canvas.EndScene();
   end;
end;

[Rollo62]

Man könnte auch gleich ein Polygon zeichnen wenn mehrere Linien verbunden sind:

Code:

procedure S4Canvas_Polyline_Draw(const Canvas: TCanvas;
                                 const Points: TPolygon;
                                 const AOpacity: Single);
var
  I: Integer;
{$IFNDEF IOS}
  Path: TPathData;
{$ENDIF IOS}

begin

{$IFDEF IOS}

  try
    // BugFix: Must draw the polygon as single-line sequence: TPathData doesn'T work here
    //Update:
    // Das war bei XE8, mit Rx10 noch nicht getestet, vielleicht passt es jetzt.
    // Hat sicher etwas mit SceneScale zu tun ...

    for I := 1 to High(Points) do
    begin
       Canvas.DrawLine(Points[I-1], Points[I], AOpacity );
    end;

  finally

  end;


{$ELSE not IOS}

  Path := TPathData.Create;

  try
    for I := 0 to High(Points) do
    begin
      if I = 0 then
        Path.MoveTo(Points[I])
      else
        Path.LineTo(Points[I]);
    end;

    Canvas.DrawPath(Path, AOpacity);

  finally
    Path.Free;
    Path := nil;
  end;


{$ENDIF not IOS}

end;

Rollo

[ht47]

Hallo,

Danke für die Hilfe. Jetzt funktioniert es.

Holger