Delphi-PRAXiS
Seite 1 von 2  1 2      

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Multimedia (https://www.delphipraxis.net/16-multimedia/)
-   -   Canvas.Arc Problem (https://www.delphipraxis.net/215869-canvas-arc-problem.html)

DaCoda 19. Sep 2024 13:49

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 :-)

Uwe Raabe 19. Sep 2024 14:37

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:
Round(X*Scale)
und bei Y ein
Delphi-Quellcode:
OffsetY - Round(Y*Scale)
.

DaCoda 19. Sep 2024 14:54

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 (?)

Uwe Raabe 19. Sep 2024 15:22

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:
if ClockWise
eben auf
Delphi-Quellcode:
if not Clockwise
umstellen. Ich würde aber die saubere Lösung empfehlen.

himitsu 19. Sep 2024 15:37

AW: Canvas.Arc Problem
 
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?

DaCoda 19. Sep 2024 16:55

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:
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 19. Sep 2024 17:23

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):

DaCoda 19. Sep 2024 18:33

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.

Uwe Raabe 19. Sep 2024 18:50

AW: Canvas.Arc Problem
 
Hier ist Scale = 4.67

DaCoda 19. Sep 2024 18:57

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 17:39 Uhr.
Seite 1 von 2  1 2      

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