So, hier nun der Code, der mit der Umkreismethode arbeitet:
Damit die Dreiecke noch etwas schöner aussehen, werden die Punkte am anfang nicht komplett zufällig verteilt, sonden auf einem Raster nur verschoben.
Code: Alles auswählen
; Knotenpunkte
Structure Node
X.i
Y.i
EndStructure
; Verbindungslinie zwischen Knoten
Structure Route
*Node1.Node
*Node2.Node
EndStructure
; Prüft, ob ein anderer Knoten innerhalb des Umkreises des Dreiecks (aus den Knoten 1, 2, 3) liegt
Procedure InTriangleCircle(List Node.Node(), *Node1.Node, *Node2.Node, *Node3.Node)
Protected x1.f = *Node1\X
Protected x2.f = *Node2\X
Protected x3.f = *Node3\X
Protected y1.f = *Node1\Y
Protected y2.f = *Node2\Y
Protected y3.f = *Node3\Y
; Bestimmung des Umkreises
Protected CircleX.f, CircleY.f, CircleRadius.f
Protected Z = (x3*(y1-y2)+x1*(y2-y3)+x2*(y3-y1))
CircleX = (x3*x3*(y1-y2)+(x1*x1+(y1-y2)*(y1-y3))*(y2-y3)+x2*x2*(y3-y1)) / Z / 2
CircleY = (-x2*x2*x3 + x1*x1*(x3-x2) + x3*(y1*y1 - y2*y2) + x1*(x2*x2-x3*x3+y2*y2-y3*y3)+x2*(x3*x3-y1*y1+y3*y3)) / Z / 2
CircleRadius = 0.5 * Sqr((x1*x1-2*x1*x2+x2*x2+(y1-y2)*(y1-y2))*(x1*x1-2*x1*x3+x3*x3+(y1-y3)*(y1-y3))*(x2*x2-2*x2*x3+x3*x3+(y2-y3)*(y2-y3))/(Z*Z))
; Abfrage ob Knoten drin liegt
ForEach Node()
If Node() <> *Node1 And Node() <> *Node2 And Node() <> *Node3
If (Node()\X-CircleX)*(Node()\X-CircleX) + (Node()\Y-CircleY)*(Node()\Y-CircleY) < CircleRadius*CircleRadius
ProcedureReturn #True
EndIf
EndIf
Next
EndProcedure
; Fügt die Verbindungslinie hinzu, falls sie noch nicht existiert
Procedure AddRouteIfNotExist(List Route.Route(), *Node1.Node, *Node2.Node)
ForEach Route()
If (Route()\Node1 = *Node1 And Route()\Node2 = *Node2) Or (Route()\Node1 = *Node2 And Route()\Node2 = *Node1)
ProcedureReturn #False
EndIf
Next
AddElement(Route())
Route()\Node1 = *Node1
Route()\Node2 = *Node2
EndProcedure
; Führt eine Triangulation aus, dabei werden Knoten übergeben und die Verbindungslinien zurückgegeben
Procedure DelaunayTriangulation(List Node.Node(), List Route.Route())
Protected *Node1.Node, *Node2.Node, *Node3.Node
; Alle 3-Punkt-Kombinationen durchlaufen
ForEach Node()
*Node1 = Node()
While NextElement(Node())
*Node2 = Node()
While NextElement(Node())
*Node3 = Node()
PushListPosition(Node())
; Verbindungslinie erstellen, falls nötig
If Not InTriangleCircle(Node(), *Node1, *Node2, *Node3)
AddRouteIfNotExist(Route(), *Node1, *Node2)
AddRouteIfNotExist(Route(), *Node2, *Node3)
AddRouteIfNotExist(Route(), *Node3, *Node1)
EndIf
PopListPosition(Node())
Wend
ChangeCurrentElement(Node(), *Node2)
Wend
ChangeCurrentElement(Node(), *Node1)
Next
EndProcedure
;- Beispiel
NewList Node.Node()
NewList Route.Route()
Define X, Y
For Y = 0 To 5
For X = 0 To 7
AddElement(Node())
Node()\X = X*100+Random(50)+25
Node()\Y = Y*100+Random(50)+25
Next
Next
DelaunayTriangulation(Node(), Route())
Enumeration
#Window
#Gadget
EndEnumeration
OpenWindow(#Window, 0, 0, 800, 600, "WindowTitle", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
CanvasGadget(#Gadget, 0, 0, WindowWidth(#Window), WindowHeight(#Window))
If StartDrawing(CanvasOutput(#Gadget))
ForEach Route()
LineXY(Route()\Node1\X, Route()\Node1\Y, Route()\Node2\X, Route()\Node2\Y, $000000)
Next
StopDrawing()
EndIf
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
End
Case #PB_Event_Gadget
Select EventGadget()
EndSelect
EndSelect
ForEver
Bitte nicht über die Berechung des Umkreises wundern, habe dort nicht optimiert, sondern einfach die Lösung des Gleichungssystem übernommen.
