Wie kann man Bögen zeichnen?

[derschutzhund]

Hallöchen,

versuche gerade eine kleine Oberfläche für CNC-Programme zu erstellen.
Also CNC-Programm einlesen, analysieren und dann die Bahnen grafisch anzeigen lassen.
Klappt bisher alles recht gut nur das Zeichnen von Bögen finde ich nirgends.
Das gesamte Programm lese ich erst mal in eine Liste cncquelle() und untersuche nun jede Zeile.
Ist alles kein Problem nur habe ich keinen Befehl zum Zeichnen eines Bogens mit Mittelpunkt, Anfangspunkt, Entpunkt gefunden oder etwas ähnliches. Gibt es soetwas fertig oder muss man sich so einen Befehl selbst programmieren?

Hier mal das Teilprogramm welches die Elemente in ein Image_grafik zeichnet.
Werde es später vermutlich noch umstellen auf canvas aber ist ja unabhängig vom Zeichnen von Linien etc.

Code: Alles auswählen

     If CreateImage(0, 450, 500) And StartDrawing(ImageOutput(0))
        Box(0, 0, 450, 500, RGB(255, 255, 255))
        xalt = 0.0
        yalt = 0.0
        zalt = 0.0
        faktor = 1.0
        ForEach cncquelle()
           If cncquelle()\befehlnr = 1
           LineXY(Round(xalt*faktor,#PB_Round_Nearest),Round(yalt*faktor,#PB_Round_Nearest),Round(cncquelle()\xpos*faktor,#PB_Round_Nearest),Round(cncquelle()\ypos*faktor,#PB_Round_Nearest),RGB(1, 1,255))
           EndIf
           If cncquelle()\befehlnr = 0
           LineXY(Round(xalt*faktor,#PB_Round_Nearest),Round(yalt*faktor,#PB_Round_Nearest),Round(cncquelle()\xpos*faktor,#PB_Round_Nearest),Round(cncquelle()\ypos*faktor,#PB_Round_Nearest),RGB(1, 200,2))
           EndIf
           If cncquelle()\zpos < 0.0
              
      ;     Circle(Round(cncquelle()\xpos*faktor,#PB_Round_Nearest),Round(cncquelle()\ypos*faktor,#PB_Round_Nearest),3,RGB(200, 2,2))
           EndIf
           
           xalt = cncquelle()\xpos
           yalt = cncquelle()\ypos
        Next     
        StopDrawing() 
        SetGadgetState(Image_grafik,ImageID(0))
      EndIf

[CSHW89]

Code zwar nicht, aber google mal nach Bezierkurve.

[derschutzhund]

Ok, das ist dann der Ansatz mit Nachbildung von Bögen über einzelne Linienstückchen.
Da damit immer noch keine verschiedenen Liniendicken möglich sind werde ich mir mal eigene Linien / Bogenbefehle über Punktzeichnung erstellen.
Komisch, dass es wohl keinen Linienbefehl für beliebige Winkel mit verschiedenen Dicken mit PB-Befehlen gibt!
Habe irgenwo mal einen Forumsbeitrag von 2003 gelesen wo das auch schon mal angemerkt wurde!

[NicTheQuick]

Wenn es nur unter Windows gehen soll, dann suche mal im Forum nach GDI+ von Danilo. Das kann sowas.

[derschutzhund]

Hallo NicTheQuick,

sollte eigentlich schon nicht nur für Windows sein.

[Christian+]

Linien und Kurven mit verschiedenen dicken muss man in Pure Basic leider selbst implementieren.
Ich habe erst vor einigen Tagen für einen Beitrag in diesem Forum den Bresenham-Algorithmus für Linien verwendet der sich für diese Problem eigentlich recht gut eignet.
In Verbindung mit deinem dicken Linen und Kurven Problem musste ich deswegen jetzt einfach Mal kurz Testen ob ich den Bresenham-Algorithmus da nicht gleich nochmal wiederverwenden kann.
Herausgekommen ist der folgende Code für Linien und Kuven mit beliebiger Dicke:

Code: Alles auswählen

EnableExplicit

; ------------------------------------------------------------------------------------------------------------
; Basierend auf http://www.purebasic.fr/german/viewtopic.php?p=320376#p320376
; ------------------------------------------------------------------------------------------------------------
Procedure ThickLineXY(x1.i, y1.i, x2.i, y2.i, s.i, color.i)
  Protected dy.i = y2 - y1
  Protected dx.i = x2 - x1
  Protected stepx.i, stepy.i, fraction.i
  If dy < 0 : dy = -dy : stepy = -1 : Else : stepy = 1 : EndIf
  If dx < 0 : dx = -dx : stepx = -1 : Else : stepx = 1 : EndIf
  dy = dy << 1
  dx = dx << 1
  s = s >> 1
  Circle(x1, y1, s, color)
  If dx > dy
    fraction = dy - (dx >> 1)
    While x1 <> x2 
      If fraction >= 0
        y1 + stepy
        fraction - dx
      EndIf
      x1 + stepx
      fraction + dy
      Circle(x1, y1, s, color)
    Wend
  Else 
    fraction = dx - (dy >> 1)
    While y1 <> y2
      If fraction >= 0
        x1 + stepx
        fraction - dy
      EndIf
      y1 + stepy
      fraction + dx
      Circle(x1, y1, s, color)
    Wend
  EndIf
EndProcedure
; ------------------------------------------------------------------------------------------------------------

; ------------------------------------------------------------------------------------------------------------
; Basierend auf http://cubic.org/docs/bezier.htm
; ------------------------------------------------------------------------------------------------------------
Structure PointXY
  x.f
  y.f
EndStructure

Macro lerp(_dest, _a, _b, _t)
  _dest\x = _a\x + (_b\x - _a\x) * _t
  _dest\y = _a\y + (_b\y - _a\y) * _t
EndMacro

Procedure ThickBezierCurve(*a.PointXY, *b.PointXY, *c.PointXY, *d.PointXY, s.i, Color.i)
  Protected ab.PointXY, bc.PointXY, cd.PointXY, abbc.PointXY, bccd.PointXY, p.PointXY, oldp.PointXY
  Protected i.i = 0
  Protected t.f
  While i <= 25
    t = i / 25.0
    lerp(ab, *a, *b, t)
    lerp(bc, *b, *c, t)
    lerp(cd, *c, *d, t)
    lerp(abbc, ab, bc, t)
    lerp(bccd, bc, cd, t)
    lerp(p, abbc, bccd, t)
    If i > 0
      ThickLineXY(oldp\x, oldp\y, p\x, p\y, s, Color)
    EndIf
    oldp\x = p\x
    oldp\y = p\y
    i + 1
  Wend
EndProcedure
; ------------------------------------------------------------------------------------------------------------

; ------------------------------------------------------------------------------------------------------------
; Beispiel
; ------------------------------------------------------------------------------------------------------------
OpenWindow(0, 0, 0, 800, 600, "ThickBezierCurve")
CreateImage(0, 800, 600, 24)
StartDrawing(ImageOutput(0))

Define a.PointXY : a\x = 100 : a\y = 100
Define b.PointXY : b\x = 200 : b\y = 500
Define c.PointXY : c\x = 600 : c\y = 100
Define d.PointXY : d\x = 700 : d\y = 500

ThickBezierCurve(@a, @b, @c, @d, 10, RGB(255,0,0))

StopDrawing()
ImageGadget(0, 0, 0, 0, 0, ImageID(0))
Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
; ------------------------------------------------------------------------------------------------------------

[derschutzhund]

Habe inzwischen eine eigene Routine für beliebige Linien erstellt.
Vom Zeichenelement verwende ich auch den Circle-Befehl.
Dabei ist mir aufgefallen, dass ja immer gleich 2 Pixel dazu kommen. Ist also eher immer ein größerer Unterschied von z.B. 1 bis 2 -> bei 1 ist der Punkt 3 Pixel breit und bei 2 ist der Punkt 5 Pixel dick.

Die Bezierfunktion ist eher nicht geeignet um einen richtigen Bogen zu erstellen. Werde da auch mal was eigenes testen.

Hier meine Routine die allerdings für Reale Maße ist die dann in der Linienfunktion umgerechnet wird.

Code: Alles auswählen

Procedure LinieXYD(x1.f,y1.f,x2.f,y2.f,d.f,fakt.f,maxiy.i)
   Define absx.f, absy.f, i.i, m.f, t.f, yaf.f, xaf.f
   Define xi1.i, yi1.i, xi2.i, yi2.i, di.i
   
   xi1 = Round(x1*fakt,#PB_Round_Nearest)
   xi2 = Round(x2*fakt,#PB_Round_Nearest)
   yi1 = maxiy - Round(y1*fakt,#PB_Round_Nearest)
   yi2 = maxiy - Round(y2*fakt,#PB_Round_Nearest)
   
   di = Round(d*fakt/2.8,#PB_Round_Nearest)
   
;   Circle(i,50,Round(0.3*faktor/2.8,#PB_Round_Nearest),RGB(200, 2,2))    
  
   absx = Abs(xi1-xi2)
   absy = Abs(yi1-yi2)
   
   If absx > 0     
     m = (yi2-yi1)/(xi2-xi1)
     t = yi1 - (m*xi1)
   EndIf
   
   If absx > absy
      If xi1 < xi2
         For i = xi1 To xi2
            yaf = m*i + t
            Circle(i,Round(yaf,#PB_Round_Nearest),di,RGB(200, 2,2))
         Next   
      Else
         For i = xi2 To xi1
            yaf = m*i + t
            Circle(i,Round(yaf,#PB_Round_Nearest),di,RGB(200, 2,2))            
         Next
      EndIf
   Else
      If yi1 < yi2
         For i = yi1 To yi2
            If absx = 0
               xaf = xi1
            Else   
               xaf =  (i - t)/m
            EndIf   
         Circle(Round(xaf,#PB_Round_Nearest),i,di,RGB(200, 2,2))   
         Next   
      Else
         For i = yi2 To yi1
            If absx = 0
               xaf = xi1
            Else              
               xaf =  (i - t)/m
            EndIf   
         Circle(Round(xaf,#PB_Round_Nearest),i,di,RGB(200, 2,2))               
         Next   
      EndIf
   EndIf
EndProcedure   

[Christian+]

Ok deine Linienfunktion Arbeit ja ähnlich das Problem mit der Dicke lässt sich wohl nur lösen wenn man auf die Circle Funktion verzichtet doch der Trick mir dieser macht das ganze erheblich einfacher und auch recht flott.

Warum die Bezierfunktion nicht für richtige Bögen geeignet sein soll verstehe ich nicht. Du kannst mit einer Bezierkurve jeden beliebigen Bogen näherungsweise Abbilden und das so exakt, dass du keinen Unterschied wahrnehmen kannst. Hier mal ein Beispiel wie du dabei sogar ganz leicht einen Kreis zeichnen kannst. Ok das ging auch einfacher wie aus 4 Teilen aber ich denke Viertelkreise zu zeichnen ist interessanter, da man diese öfter Braucht.

Code: Alles auswählen

Procedure BezierCircle(centerx.i, centery.i, radius.i, s.i, color.i)
  Protected a.PointXY, b.PointXY,c.PointXY, d.PointXY  
 
  a\x = centerx + radius : a\y = centery
  b\x = centerx + radius : b\y = centery + radius*0.552
  c\x = centerx + radius*0.552 : c\y = centery + radius
  d\x = centerx : d\y = centery + radius  
  ThickBezierCurve(@a, @b, @c, @d, s, color)
  
  a\x = centerx - radius : a\y = centery
  b\x = centerx - radius : b\y = centery + radius*0.552
  c\x = centerx - radius*0.552 : c\y = centery + radius
  d\x = centerx : d\y = centery + radius  
  ThickBezierCurve(@a, @b, @c, @d, s, color)
  
  a\x = centerx + radius : a\y = centery
  b\x = centerx + radius : b\y = centery - radius*0.552
  c\x = centerx + radius*0.552 : c\y = centery - radius
  d\x = centerx : d\y = centery - radius  
  ThickBezierCurve(@a, @b, @c, @d, s, color)
  
  a\x = centerx - radius : a\y = centery
  b\x = centerx - radius : b\y = centery - radius*0.552
  c\x = centerx - radius*0.552 : c\y = centery - radius
  d\x = centerx : d\y = centery - radius  
  ThickBezierCurve(@a, @b, @c, @d, s, color)
EndProcedure

Edit:
Falls du nur Viertelkreise brauchst (oder mal Kreise zeichnest) geht es allerdings auch noch erheblich schneller als mit Bezierkurven:

Code: Alles auswählen

Enumeration
  #TR = 1 << 0
  #BR = 1 << 1
  #BL = 1 << 2
  #TL = 1 << 3
  #ALL = #TR | #BR | #BL | #TL
EndEnumeration

Procedure ThickCirclePart(x0.i, y0.i, radius.i, s.i, color.i, mode.i = #ALL)
  Protected f.i = 1 - radius
  Protected ddF_x.i = 0
  Protected ddF_y.i = -2 * radius
  Protected x.i = 0
  Protected y.i = radius 
  s = s >> 1
  If mode & #TR
    Circle(x0, y0 - radius, s, color)
    Circle(x0 + radius, y0, s, color)
  EndIf
  If mode & #BR
    Circle(x0 + radius, y0, s, color)
    Circle(x0, y0 + radius, s, color) 
  EndIf
  If mode & #BL
    Circle(x0, y0 + radius, s, color)  
    Circle(x0 - radius, y0, s, color)
  EndIf
  If mode & #TL
    Circle(x0 - radius, y0, s, color)
    Circle(x0, y0 - radius, s, color)
  EndIf
  While x < y
    If f >= 0
      y - 1
      ddF_y + 2
      f + ddF_y
    EndIf
    x + 1
    ddF_x + 2
    f = f + ddF_x + 1 
    If mode & #TR      
      Circle(x0 + x, y0 - y, s, color)
      Circle(x0 + y, y0 - x, s, color)
    EndIf
    If mode & #BR
      Circle(x0 + x, y0 + y, s, color)
      Circle(x0 + y, y0 + x, s, color)
    EndIf
    If mode & #BL
      Circle(x0 - x, y0 + y, s, color)
      Circle(x0 - y, y0 + x, s, color)
    EndIf
    If mode & #TL
      Circle(x0 - x, y0 - y, s, color)  
      Circle(x0 - y, y0 - x, s, color)
    EndIf
  Wend
EndProcedure

[derschutzhund]

Klar wird das irgendwie gehen aber es ist so einfach zu unhandlich!
Ziel ist Kreisbögen unter jedem beliebigem Startwinkel / Endwinkel und Dicke, sowie als Sonderfall Vollkreis.
Werde mich gleich mal daran setzen!

[derschutzhund]

Hier meine erste Version:
- berechnet einen Bogen gegen den Uhrzeiger
- zeichnet diesen Winkel mit einer einstellbaren Auflösung, die dem Teilwinkel in Grad zwischen zwei Linienstückchen entspricht
- zeichnet Vollkreise wenn Startpunkt und Endpunkt gleich sind

Wie gesagt, ist das eine erste nicht übermäßig getestet Version und hat daher bestimmt noch die eine oder andere Problemstelle.

Die Farbe könnte ich natürlich auch noch übergeben.

Code: Alles auswählen

Procedure Bogen(mx.f, my.f, sx.f, sy.f, ex.f, ey.f, d.f, genauigkeit.f, fakt.f, maxiy.i)
   Define  radius.f, Gwinkel.f, Swinkel.f, Ewinkel.f, aktwinkel.f
   Define wpx1.f, wpy1.f, wpx2.f, wpy2.f
   
   radius = Sqr(((sx-mx)*(sx-mx)) + ((sy-my)*(sy-my)))
   
   swinkel= ACos((sx-mx)/radius)*57.295776
   If my>sy : swinkel=360-swinkel : EndIf
   
   ewinkel= ACos((ex-mx)/radius)*57.295776
   If my>ey : ewinkel=360-ewinkel : EndIf
   
   If ewinkel = swinkel : swinkel = 0 : ewinkel = 360 : EndIf
   
   If ewinkel < swinkel : ewinkel = 360 -ewinkel : EndIf
   
   aktwinkel = Swinkel
   
   wpx1 = sx
   wpy1 = sy
   While aktwinkel + genauigkeit < ewinkel
      aktwinkel = aktwinkel + genauigkeit        
      wpx2 = mx + radius*Cos(Radian(aktwinkel))
      wpy2 = my + radius*Sin(Radian(aktwinkel))
      
      ; Ausgabe über eigene Linienfunktion
      LinieXYD(wpx1,wpy1,wpx2,wpy2,d,fakt,maxiy)                  
      ; Ausgabe über Standardlinie
      ;     LineXY(Round(wpx1,#PB_Round_Nearest),maxiy-Round(wpy1,#PB_Round_Nearest),Round(wpx2,#PB_Round_Nearest),maxiy-Round(wpy2,#PB_Round_Nearest),RGB(1, 1,0))
      wpx1 = wpx2
      wpy1 = wpy2
   Wend   
   If aktwinkel < ewinkel
      
      ; Ausgabe über eigene Linienfunktion
      LinieXYD(wpx1,wpy1,wpx2,wpy2,d,fakt,maxiy)      
      ; Ausgabe über Standardlinie         
      ; LineXY(Round(wpx1,#PB_Round_Nearest),maxiy-Round(wpy1,#PB_Round_Nearest),Round(ex,#PB_Round_Nearest),maxiy-Round(ey,#PB_Round_Nearest),RGB(1, 1,0))
   EndIf
EndProcedure   

; Beispielaufruf 
Procedure Bogenzeichnen(EventType)
   If StartDrawing(CanvasOutput(canvas_0))
      Box(0, 0, GadgetWidth(canvas_0), GadgetHeight(canvas_0), RGB(255,255,255))
      
      Bogen(200.0, 200.0, 300.0, 300.0, 100.0, 100.0, 10.0, 5.0, 1.0, 4800)
      DrawingMode(#PB_2DDrawing_Default)
      StopDrawing()
   EndIf      
EndProcedure