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.