DrawRhomb() Sub (with rotate)

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

DrawRhomb() Sub (with rotate)

Post by MrSwiss »

Hi all,

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 -----
Post Reply