AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Canvas.Arc Problem

Ein Thema von DaCoda · begonnen am 19. Sep 2024 · letzter Beitrag vom 21. Sep 2024
Antwort Antwort
Seite 1 von 2  1 2      
DaCoda

Registriert seit: 21. Jul 2006
Ort: Hamburg
123 Beiträge
 
Delphi 12 Athens
 
#1

Canvas.Arc Problem

  Alt 19. Sep 2024, 12:49
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
Angehängte Dateien
Dateityp: zip Test.zip (90,4 KB, 7x aufgerufen)
Debuggers don’t remove bugs, they only show them in slow-motion.
  Mit Zitat antworten Zitat
Benutzerbild von Uwe Raabe
Uwe Raabe

Registriert seit: 20. Jan 2006
Ort: Lübbecke
11.360 Beiträge
 
Delphi 12 Athens
 
#2

AW: Canvas.Arc Problem

  Alt 19. Sep 2024, 13:37
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 Round(X*Scale) und bei Y ein OffsetY - Round(Y*Scale) .
Uwe Raabe
Certified Delphi Master Developer
Embarcadero MVP
Blog: The Art of Delphi Programming
  Mit Zitat antworten Zitat
DaCoda

Registriert seit: 21. Jul 2006
Ort: Hamburg
123 Beiträge
 
Delphi 12 Athens
 
#3

AW: Canvas.Arc Problem

  Alt 19. Sep 2024, 13:54
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 (?)
Debuggers don’t remove bugs, they only show them in slow-motion.
  Mit Zitat antworten Zitat
Benutzerbild von Uwe Raabe
Uwe Raabe

Registriert seit: 20. Jan 2006
Ort: Lübbecke
11.360 Beiträge
 
Delphi 12 Athens
 
#4

AW: Canvas.Arc Problem

  Alt 19. Sep 2024, 14:22
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 if ClockWise eben auf if not Clockwise umstellen. Ich würde aber die saubere Lösung empfehlen.
Uwe Raabe
Certified Delphi Master Developer
Embarcadero MVP
Blog: The Art of Delphi Programming
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.846 Beiträge
 
Delphi 12 Athens
 
#5

AW: Canvas.Arc Problem

  Alt 19. Sep 2024, 14:37
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.

MSDN-Library durchsuchenSetMapMode
MSDN-Library durchsuchenSetViewportOrgEx
MSDN-Library durchsuchenSetViewportExtEx



Vielleicht wird es aber "einfacher", wenn du SVG im Skia (TSkSvg/TSkPaintBox/TSkAnimatedPaintBox/TSkAnimatedImage) anstatt GDI (TCanvas/TBitmap/TImage/...) verwendets?
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests

Geändert von himitsu (19. Sep 2024 um 14:44 Uhr)
  Mit Zitat antworten Zitat
DaCoda

Registriert seit: 21. Jul 2006
Ort: Hamburg
123 Beiträge
 
Delphi 12 Athens
 
#6

AW: Canvas.Arc Problem

  Alt 19. Sep 2024, 15:55
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
Debuggers don’t remove bugs, they only show them in slow-motion.
  Mit Zitat antworten Zitat
Benutzerbild von Uwe Raabe
Uwe Raabe

Registriert seit: 20. Jan 2006
Ort: Lübbecke
11.360 Beiträge
 
Delphi 12 Athens
 
#7

AW: Canvas.Arc Problem

  Alt 19. Sep 2024, 16:23
Funktioniert hier einwandfrei mit dem neuen Code (nachdem ich die uses aufgeräumt und die StrToFloatWithDecimalPoint wieder eingefügt habe):
Miniaturansicht angehängter Grafiken
19-09-2024_17-21-26.jpg  
Uwe Raabe
Certified Delphi Master Developer
Embarcadero MVP
Blog: The Art of Delphi Programming
  Mit Zitat antworten Zitat
DaCoda

Registriert seit: 21. Jul 2006
Ort: Hamburg
123 Beiträge
 
Delphi 12 Athens
 
#8

AW: Canvas.Arc Problem

  Alt 19. Sep 2024, 17:33
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.
Debuggers don’t remove bugs, they only show them in slow-motion.
  Mit Zitat antworten Zitat
Benutzerbild von Uwe Raabe
Uwe Raabe

Registriert seit: 20. Jan 2006
Ort: Lübbecke
11.360 Beiträge
 
Delphi 12 Athens
 
#9

AW: Canvas.Arc Problem

  Alt 19. Sep 2024, 17:50
Hier ist Scale = 4.67
Uwe Raabe
Certified Delphi Master Developer
Embarcadero MVP
Blog: The Art of Delphi Programming
  Mit Zitat antworten Zitat
DaCoda

Registriert seit: 21. Jul 2006
Ort: Hamburg
123 Beiträge
 
Delphi 12 Athens
 
#10

AW: Canvas.Arc Problem

  Alt 19. Sep 2024, 17:57
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.
Debuggers don’t remove bugs, they only show them in slow-motion.
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 1 von 2  1 2      


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 21:16 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz