this Sub draws a Rhomb(us), aka: Diamond or Lozenge. Defined by the parameters:
xc, yc (2D center/center params.) as well as, wid, hei (width/height params.).
The Rhomb can be rotated, changing the ang(le) parameter (optional).
bcl, fcl (Border-/Fill-Color) and a Boolean fll, to specify: filled (yes/no) (all opt.).
A small demo-example is part of the code:
Code: Select all
' DrawRhomb_Sub-test2.bas -- (c) 2019-02-27, MrSwiss
'
' compile: -s gui
'
Sub DrawRhomb( _ ' draw a rhomb(us) (aka: diamond, lozenge)
ByVal xc As Single, _ ' X-axis rhomb center
ByVal yc As Single, _ ' y-axis rhomb center
ByVal wid As Single, _ ' width of rhomb
ByVal hei As Single, _ ' height of rhomb
ByVal ang As Single=0.0, _ ' rhomb angle of rotation (optional)
ByVal bcl As ULong=&hFFFFFFFF, _ ' border color (optional)
ByVal fcl As ULong=0, _ ' fill color (optional)
ByVal fll As Boolean=FALSE _ ' fill flag (default: none)
)
#Ifndef Pi ' only if not externally defined
Static As Double Pi = 4d * Atn(1d) ' semi circle (rad)
Static As Double d_r = Atn(1d) / 45.0 ' deg to rad mul. factor
#EndIf
Dim As Single SinAng, CosAng, Theta, D_Theta, _ ' angles
x, y, rx, ry ' position points
' initialize local variables
ang *= d_r : SinAng = Sin(ang) : CosAng = Cos(ang)
Theta = 0.0 : D_Theta = Pi * .5 ' 90° in RAD
' calculate the first point (2D vector)
x = wid * Cos(Theta) : y = hei * Sin(Theta)
' rotate it
rx = xc + x * CosAng + y * SinAng
ry = yc - x * SinAng + y * CosAng
' set start point (aka: graphics cursor)
PSet (rx, ry) ' doesn't change anything visible!
' draw the rhomb
For i As UInteger = 0 To 3 ' four points
Theta += D_Theta ' add delta, 90° RAD
x = wid * Cos(Theta) ' new pos.
y = hei * Sin(Theta)
rx = xc + x * CosAng + y * SinAng ' rotate it
ry = yc - x * SinAng + y * CosAng
Line -(rx, ry), bcl ' draw line (relative, border color)
Next
If fll Then Paint (xc, yc), fcl, bcl' fill if requested (fill color)
End Sub
' demo code
ScreenRes(1024, 800, 32)
#Define UL_Rng(l, h) ( CULng(Rnd() * ((h) - (l)) + (l)) )
Randomize(Timer, 3)
For i As UInteger = 1 To 300
Rnd() : Rnd() : Rnd() : Rnd() : _
Rnd() : Rnd() : Rnd() : Rnd()
Next
Dim As ULong angle = 180, x = 511, y = 399, _ ' max. angle | center/center
w = UL_Rng(180, 300), _ ' random width
h = UL_Rng(100, 200), _ ' random height
bc = &hFFFF3F00, fc = &hFF007FFF ' preset colors
Dim As Boolean clsf = FALSE, fllf = TRUE ' Cls-/fill-flags
' MAIN-Loop
Do
ScreenLock
If clsf Then Cls : clsf = FALSE
DrawRhomb(x, y, w, h, angle, bc, fc, fllf)
ScreenUnLock
angle -= 5 ' smaller angle = CW rotation!
If angle = 0 Then ' reset condition and new init
angle = 180 : clsf = TRUE : fllf = Not fllf
bc = UL_Rng(&hFF000000, &hFFFFFFFF) ' 24 bit RGB only
x = UL_Rng(199, 823)
h = UL_Rng(180, 320)
fc = UL_Rng(&hFF3F3F3F, &hFFBFBFBF)
y = UL_Rng(199, 599)
w = UL_Rng(180, 320)
End If
Sleep(16, 1) ' approx. 60 Hz (aka: FPS)
Loop Until InKey() = Chr(255, 107) ' [Alt]+[F4] press or a [X] click
' ----- EOF -----