Canvas.Arc Problem

[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