Canvas.Arc Problem

[himitsu]

Zitat:

Da die Y-Achse von TCanvas invertiert ist

Joar umrechnen, aber es müsste auch gehen den ViewPort/MapMode des HDC (Canvas.Handle) zu ändern.

SetMapMode
SetViewportOrgEx
SetViewportExtEx



Vielleicht wird es aber "einfacher", wenn du SVG im Skia (TSkSvg/TSkPaintBox/TSkAnimatedPaintBox/TSkAnimatedImage) anstatt GDI (TCanvas/TBitmap/TImage/...) verwendets?

[DaCoda]

Vielen Dank @himitsu.
Allerdings bevorzuge ich den Vorschlag von Uwe in diesem Fall.

Ich habe nun die Unit etwas abgeändert:

Code:

unit tbGCodeRenderer;

interface

uses
{$IFNDEF RELEASE}
  DebugIntF,
{$ENDIF}
  tbUtils,

  System.SysUtils,
  System.Classes,
  System.Math,
  System.Types,

  WinApi.Windows,

  Vcl.Graphics;

type
  TGCodeRenderer = class
  private
    FCanvas: TCanvas;
    FScale: Double;
    FCurrentX, FCurrentY: Double;
    FAbsoluteMode: Boolean;
    GCode: string;
    X, Y, I, J, R: Double;
    TargetX, TargetY, CenterX, CenterY, Radius: Double;
    Clockwise: Boolean;
    HasX, HasY, HasI, HasJ, HasR: Boolean;
  public
    constructor Create(Canvas: TCanvas; Scale: Double);

    procedure Clear;
    procedure DrawLine(ToX, ToY: Double; Move: Boolean);
    procedure DrawArc(CX, CY, Radius, StartAngle, EndAngle: Double; Clockwise: Boolean);
    procedure ParseGCodeLine(const GCodeLine: string);
    function AdjustY(Y: Double): Double;
  end;

implementation

constructor TGCodeRenderer.Create(Canvas: TCanvas; Scale: Double);
begin
  FCanvas := Canvas;
  FCanvas.Pen.Width := 1;
  FScale := Scale;
  FCurrentX := 0;
  FCurrentY := 0;
  FAbsoluteMode := True;
end;

procedure TGCodeRenderer.Clear;
begin
  FCanvas.Brush.Color := clBlack;
  FCanvas.FillRect(FCanvas.ClipRect);
  FCanvas.Pen.Width := 1;
end;

function TGCodeRenderer.AdjustY(Y: Double): Double;
begin
  Result := FCanvas.ClipRect.Bottom - Y;
end;

procedure TGCodeRenderer.DrawLine(ToX, ToY: Double; Move: Boolean);
begin
  if Move then begin
    FCanvas.Pen.Color := clGray;
  end else begin
    FCanvas.Pen.Color := clYellow;
  end;

  FCanvas.MoveTo(Round(FCurrentX * FScale), Round(AdjustY(FCurrentY * FScale)));
  FCanvas.LineTo(Round(ToX * FScale), Round(AdjustY(ToY * FScale)));

  FCurrentX := ToX;
  FCurrentY := ToY;
end;

procedure TGCodeRenderer.DrawArc(CX, CY, Radius, StartAngle, EndAngle: Double; Clockwise: Boolean);
var
  StartX, StartY, EndX, EndY: Double;
  ArcRect: TRect;
begin
  StartX := CX + Radius * Cos(StartAngle);
  StartY := CY + Radius * Sin(StartAngle);
  EndX := CX + Radius * Cos(EndAngle);
  EndY := CY + Radius * Sin(EndAngle);

  ArcRect := Rect(
    Round((CX - Radius) * FScale),
    Round((CY - Radius) * FScale),
    Round((CX + Radius) * FScale),
    Round((CY + Radius) * FScale)
    );

  FCanvas.Pen.Color := clLime;

  if Clockwise then
    FCanvas.Arc(ArcRect.Left, Round(AdjustY(ArcRect.Top)), ArcRect.Right, Round(AdjustY(ArcRect.Bottom)), Round(EndX * FScale), Round(AdjustY(EndY * FScale)), Round(StartX * FScale), Round(AdjustY(StartY * FScale)))
  else
    FCanvas.Arc(ArcRect.Left, Round(AdjustY(ArcRect.Top)), ArcRect.Right, Round(AdjustY(ArcRect.Bottom)), Round(StartX * FScale), Round(AdjustY(StartY * FScale)), Round(EndX * FScale), Round(AdjustY(EndY * FScale)));

  FCurrentX := EndX;
  FCurrentY := EndY;
end;

procedure TGCodeRenderer.ParseGCodeLine(const GCodeLine: string);
var
  Parts: TArray<string>;
  Loop: Integer;
begin
  Parts := GCodeLine.Split([' '], TStringSplitOptions.ExcludeEmpty);
  GCode := '';
  X := 0;
  Y := FCanvas.ClipRect.Height;
  I := 0;
  J := 0;
  R := 0;
  HasX := False;
  HasY := False;
  HasI := False;
  HasJ := False;
  HasR := False;
  Clockwise := False;

  for Loop := 0 to Length(Parts) - 1 do begin
    if Parts[Loop].StartsWith('G') then begin
      GCode := Parts[Loop];
    end;

    if Pos('X', Parts[Loop]) > 0 then begin
      try
        X := StrToFloatWithDecimalPoint(Copy(Parts[Loop], Pos(Parts[Loop], 'X') + 2, 5));
      except

      end;
      HasX := True;
    end;

    if Pos('Y', Parts[Loop]) > 0 then begin
      try
        Y := StrToFloatWithDecimalPoint(Copy(Parts[Loop], Pos(Parts[Loop], 'Y') + 2, 5));
      except

      end;
      HasY := True;
    end;

    if Pos('I', Parts[Loop]) > 0 then begin
      try
        I := StrToFloatWithDecimalPoint(Copy(Parts[Loop], Pos(Parts[Loop], 'I') + 2, 5));
      except

      end;
      HasI := True;
    end;

    if Pos('J', Parts[Loop]) > 0 then begin
      try
        J := StrToFloatWithDecimalPoint(Copy(Parts[Loop], Pos(Parts[Loop], 'J') + 2, 5));
      except

      end;
      HasJ := True;
    end;

    if Pos('R', Parts[Loop]) > 0 then begin
      try
        R := StrToFloatWithDecimalPoint(Copy(Parts[Loop], Pos(Parts[Loop], 'R') + 2, 5));
      except

      end;
      HasR := True;
    end;

    if Pos('G90', Parts[Loop]) > 0 then
      FAbsoluteMode := True
    else if Pos('G91', Parts[Loop]) > 0 then
      FAbsoluteMode := False;
  end;

  if (GCode = 'G0') or (GCode = 'G00') then begin
    if FAbsoluteMode then begin
      if HasX then TargetX := X else TargetX := FCurrentX;
      if HasY then TargetY := Y else TargetY := FCurrentY;
    end else begin
      TargetX := FCurrentX + X;
      TargetY := FCurrentY + Y;
    end;
    DrawLine(TargetX, TargetY, True);
    FCurrentX := TargetX;
    FCurrentY := TargetY;
  end else if (GCode = 'G1') or (GCode = 'G01') then begin
    if FAbsoluteMode then begin
      if HasX then
        TargetX := X
      else TargetX := FCurrentX;

      if HasY then
        TargetY := Y
      else TargetY := FCurrentY;
    end else begin
      TargetX := FCurrentX + X;
      TargetY := FCurrentY + Y;
    end;

    DrawLine(TargetX, TargetY, False);
  end else if (GCode = 'G2') or (GCode = 'G02') then begin
    Clockwise := True;
    if FAbsoluteMode then begin
      TargetX := X;
      TargetY := Y;
    end else begin
      TargetX := FCurrentX + X;
      TargetY := FCurrentY + Y;
    end;

    if HasI and HasJ then begin
      CenterX := FCurrentX + I;
      CenterY := FCurrentY + J;
      Radius := Hypot(I, J);
      DrawArc(CenterX, CenterY, Radius, ArcTan2(FCurrentY - CenterY, FCurrentX - CenterX), ArcTan2(TargetY - CenterY, TargetX - CenterX), Clockwise);
    end;
  end else if (GCode = 'G3') or (GCode = 'G03') then begin
    Clockwise := False;
    if FAbsoluteMode then begin
      TargetX := X;
      TargetY := Y;
    end else begin
      TargetX := FCurrentX + X;
      TargetY := FCurrentY + Y;
    end;

    if HasI and HasJ then begin
      CenterX := FCurrentX + I;
      CenterY := FCurrentY + J;
      Radius := Hypot(I, J);
      DrawArc(CenterX, CenterY, Radius, ArcTan2(FCurrentY - CenterY, FCurrentX - CenterX), ArcTan2(TargetY - CenterY, TargetX - CenterX), Clockwise);
    end;
  end;
end;

end.

Nun steht nix mehr auf dem Kopf, aber die Arc-Prozedur macht immer noch "Gekrikel"

Die Dateien Testdatei_001.nc und Testdatei_003.nc sehen ganz gut aus, aber die Testdatei_002 wird irgenwie nur gekrickel

[Uwe Raabe]

Funktioniert hier einwandfrei mit dem neuen Code (nachdem ich die uses aufgeräumt und die StrToFloatWithDecimalPoint wieder eingefügt habe):

[DaCoda]

Vielen Dank Uwe,

Das funktioniert tatsächlich korrekt, wenn Scale = 1.0, 2.0... Also wenn Scale z.B. 2.41 ist, dann malt das DrawArc wieder falsch, wenn Scale "gerade" ist dann stimmt das Ergebnis.

[Uwe Raabe]

Hier ist Scale = 4.67

[DaCoda]

Hallo Uwe,
ja ich teste hier auch gerade. Manche Werte stimmen. Manche eben nicht.
2.41 oder 3.14 z.B. gehen nicht... Nun steh ich wieder blöd da

Vielen Dank für deine Tips, ich finde es toll, das du dir so viel Zeit für dieses Forum nimmst.

[Uwe Raabe]

Ja, das sind die üblichen Probleme, mit denen man sich beim Zeichnen von Bögen herumärgern muss. Ursache sind hier die Fälle, bei denen nach der Umrechnung der Start- und Endkoordinaten von Double nach Integer die Ergebnisse identisch sind. Eigentlich kann man da keinen Bogen malen, aber wenn man es dennoch versucht, macht Windows einen Vollkreis daraus. Bei Linien fällt das halt nicht auf.

Es bleibt also keine Wahl: Man muss erst die Umrechnung machen, dann jeweils die X- und Y-Werte auf Gleichheit prüfen und - falls beide gleich - den Arc-Befehl überspringen.