Odd Stars demo with VectorGraphics

[davido]

I was looking for ways of generating stars of both odd and even orders, below is some code that generates odd order stars.
There are two types: Solid (filled) and Line versions. The line versions are slightly larger if line thickness is greater than 1.
I hope you find them interesting.

Code: Select all

;<><><><><><><><><><><><><><><><><><><><><><><><><><>
;<><> Odd Stars by davido Tuesday 22 March 2016  <><>
;<><><><><><><><><><><><><><><><><><><><><><><><><><>

CompilerIf #PB_Compiler_Unicode
  #XmlEncoding = #PB_UTF8
CompilerElse 
  #XmlEncoding = #PB_Ascii
CompilerEndIf

#Dialog = 0
#Xml = 0
Global Event.i, XML$

Runtime Enumeration Windows
  #WinMain
EndEnumeration
Runtime Enumeration Gadgets
  #Canvas
EndEnumeration

Runtime Procedure EventMatrix()
  Protected Mx.i = GetGadgetAttribute(#Canvas,#PB_Canvas_MouseX) 
  Protected My.i = GetGadgetAttribute(#Canvas,#PB_Canvas_MouseY)
  Select EventType()
    Case #PB_EventType_LeftClick
      Debug "Mouse at: " + Str(Mx) + ":" + Str(My)
      
  EndSelect
EndProcedure

Procedure OddStars(X.i=50,Y.i=50,ArmLength.i=20,LineWidth.i=1,Order.i = 5,Colour.i=$ffff0000,FillPath.i=#False) 
  Define Angle.d = 180 - 180 / Order
  If StartVectorDrawing(CanvasVectorOutput(0))
    VectorSourceColor(Colour)
    MovePathCursor(X, Y)
    X + ArmLength
    AddPathLine(X,Y)
    For M = 1 To Order - 2
      RotateCoordinates(X,Y,Angle)
      X + ArmLength
      AddPathLine(X,Y) 
    Next M
    ClosePath()
    If FillPath
      FillPath()
    EndIf 
    StrokePath(LineWidth)
    StopVectorDrawing()
  EndIf
EndProcedure 

Runtime Procedure SetUP()
  Protected Order.i
  For Order = 3 To 17 Step 2
    OddStars(10 + (Order - 3) * 55, 50,100,1,Order,$ff0000ff,0)
    OddStars(10 + (Order - 3) * 55,155,100,1,Order,$ffff0000,1)
  Next Order
EndProcedure

XML$ = "<dialogs>"+
       "  <window id='#WinMain' name='Oddstars' text='Oddstars' minwidth='auto' minheight='auto' flags='#PB_Window_ScreenCentered |"+
       "  #PB_Window_SystemMenu | #PB_Window_SizeGadget'>" +
       "    <canvas id='#Canvas' width='900' height='250' onevent='EventMatrix()'/>"+
       "  </window>"+
       "</dialogs>"

If CatchXML(#Xml, @XML$, StringByteLength(XML$), 0, #XmlEncoding) And XMLStatus(#Xml) = #PB_XML_Success
  
  If CreateDialog(#Dialog) And OpenXMLDialog(#Dialog, #Xml, "Oddstars")
    SetUp()
    Repeat
      Event = WaitWindowEvent()
    Until Event = #PB_Event_CloseWindow 
    
  Else  
    Debug "Dialog error: " + DialogError(#Dialog)
  EndIf
Else
  Debug "XML error: " + XMLError(#Xml) + " (Line: " + XMLErrorLine(#Xml) + ")"
EndIf

[HanPBF]

I can only complain about the huge amount of code...

Thanks for sharing!!!