![]() |
Canvas.Arc Problem
Liste der Anhänge anzeigen (Anzahl: 1)
Hallo,
ich habe ein kleines Testprogramm gemacht, um GCode-Dateien zu zeichnen (2D vorerst, an 3D traue ich mich noch nicht) Allerdings habe ich offensichtlich einen Denkfehler bei der Canvas.Arc Routine. Hat da jemand eventuell einen Tip, wieso das so nicht hinhaut (Testdatei_002.nc) ? Testdatei_001.nc und Testdatei_003.nc scheinen richtig zu zeichnen. Als Anhang gibt es das kleine "Testprogramm und NC-Files" Vielen Dank schon mal :-) |
AW: Canvas.Arc Problem
Das Koordinatensystem des NC-Programms stimmt nicht mit dem von TCanvas überein. Bei TCanvas sind kleinere Y-Koordinaten oben und größere unten. Du musst also alle Y-Koordinaten entsprechend umrechnen. Dazu musst du den Renderer noch (mindestens) den Y-Nullpunkt (z.B. PaintArea.Height) mitgeben und von diesem dann alle Y-Werte abziehen. Am besten machst du dir entsprechende Funktionen, die aus NC-Koordinaten die Canvas-Koordinaten machen. Für X ist das ein
Delphi-Quellcode:
und bei Y ein
Round(X*Scale)
Delphi-Quellcode:
.
OffsetY - Round(Y*Scale)
|
AW: Canvas.Arc Problem
Hallo Uwe,
danke für deine Info. Mir ist bewusst, das die Datei derzeit praktisch auf dem Kopf steht. Was du schreibst ist absolut korrekt. Aber die Routine DrawArc hat irgendwie noch ein anderes Problem, weil da nur wirre Bögen gezeichnet werden. Also mit der Testdatei_001 und auch mit Testdatei_003 wird das aber schon mal "richtig" gezeichnet. In der Date 003 wird ja ein korrekter Kreis gezeichnet nur in der Testdatei_002 ist alles völlig wirr (?) |
AW: Canvas.Arc Problem
Da die Y-Achse von TCanvas invertiert ist - wie du sagst, ist die Zeichnung spiegelverkehrt in Y - vertauscht sich dabei auch die Bedeutung von Clockwise. Wenn dich das auf dem Kopf stehen nicht stört, dann musst du in DrawArc eben statt
Delphi-Quellcode:
eben auf
if ClockWise
Delphi-Quellcode:
umstellen. Ich würde aber die saubere Lösung empfehlen.
if not Clockwise
|
AW: Canvas.Arc Problem
Zitat:
![]() ![]() ![]() Vielleicht wird es aber "einfacher", wenn du SVG im Skia (TSkSvg/TSkPaintBox/TSkAnimatedPaintBox/TSkAnimatedImage) anstatt GDI (TCanvas/TBitmap/TImage/...) verwendets? |
AW: Canvas.Arc Problem
Vielen Dank @himitsu.
Allerdings bevorzuge ich den Vorschlag von Uwe in diesem Fall. Ich habe nun die Unit etwas abgeändert:
Code:
Nun steht nix mehr auf dem Kopf, aber die Arc-Prozedur macht immer noch "Gekrikel" :-)
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. Die Dateien Testdatei_001.nc und Testdatei_003.nc sehen ganz gut aus, aber die Testdatei_002 wird irgenwie nur gekrickel :-( |
AW: Canvas.Arc Problem
Liste der Anhänge anzeigen (Anzahl: 1)
Funktioniert hier einwandfrei mit dem neuen Code (nachdem ich die uses aufgeräumt und die StrToFloatWithDecimalPoint wieder eingefügt habe):
|
AW: Canvas.Arc Problem
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. |
AW: Canvas.Arc Problem
Hier ist Scale = 4.67
|
AW: Canvas.Arc Problem
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. |
Alle Zeitangaben in WEZ +1. Es ist jetzt 12:38 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz