SevenSegment (FB 32/64, static lib)

User projects written in or related to FreeBASIC.
MrSwiss
Posts: 2532
Joined: Jun 02, 2013 9:27
Location: Switzerland

SevenSegment (FB 32/64, static lib)

Postby MrSwiss » Feb 10, 2018 17:24

Some Time ago, I've coded this pure FreeBASIC library. The main aim was:

a 7-Segment (single/multiple) graphical, scalable display (with a single, scaling
factor (variable), all other calculations are inside the library itself).
(Everything is integer based, therefore it isn't "smooth scaling", more "stepping".)

Consisting of:
  • SevenSegment.bi (header file, to be included in source, using the library)
  • SevenSegment32.bas (32-bit lib-source) --> libSevenSegment32.a (32-bit lib)
  • SevenSegment64.bas (64-bit lib-source) --> libSevenSegment64.a (64-bit lib)
    (both source files are identical, except: name/comments)
I'll post some examples in the following post(s).

(keeping this post free, for possible, later updates)

SevenSegment.bi:

Code: Select all

' SevenSegment.bi -- 2017-08-15, by MrSwiss

#Ifndef __SevenSegment_bi__
#Define __SevenSegment_bi__


Const As ULong  black = &hFF000000, white = &hFFFFFFFF, _   ' pre-defined color's (32bit)
                grey = &hFF7F7F7F, transp = &h00FF00FF, _   ' const's are GLOBAL!
                b_red = &hFFFF0F00, d_red = &hFF3F0000, _   ' to be preferred, over: _
                b_org = &hFFFF7F00, d_org = &hFF7F3F00, _   ' "dim shared"!
                b_yel = &hFFFFDF00, d_yel = &hFF5F5F00, _
                b_grn = &hFF00FF00, d_grn = &hFF003F00, _
                b_blu = &hFF00CFFF, d_blu = &hFF001F3F, _
                pink = &hFFFE00FE, violet = &hFF3F003F, _
                blue = &hFF007FFF, yellow = &hFFFFBF00, d_gry = &hFF3F3F3F

Type LED_Rec    ' a helper Type (not used directly)
    As Short    x_, y_, w_, h_  ' position / size
    As ULong    bc_, dc_        ' LED colors
    As Boolean  vis_, stt_      ' visible / status, both: ON or OFF
    As UByte    mod_, res_      ' mode: H / V, reserved
End Type

Type SevenSeg
  Private:
    As Short x1_, y1_, x2_, y2_ ' SevenSeg border positions x1, y1, x2, y2
    As ULong bgc_, frc_         ' colors: bg / frame
    As UByte frs_               ' frame style 0 = none/bg, 1 = single/bg , 2 = double/bg
    As LED_Rec  LR(1 To 7)      ' 1, 4 and 7 = horizontal, rest = vertical
  Public:
    Declare Sub initSS(ByVal w As Short=6, ByVal frs As UByte=0, ByVal v As Boolean=TRUE, ByVal s As Boolean=FALSE)
    Declare Sub sca_SS(ByVal w As Short=6)      ' only for re-scaling! (use initSS for first run!)
    Declare Sub pos_SS(ByVal xo As Short, ByVal yo As Short)    ' SSoffset from init (0, 0), as above
    Declare Sub clr_SS(ByVal As ULong, ByVal As ULong, ByVal As ULong=&hFF000000, ByVal As ULong=&hFFFFFFFF) ' 3rd/4th param. is opt.
    Declare Sub dec_SS(ByVal bi As UByte=16)    ' Byte decoder (16 = all OFF)
    Declare Sub dis_SS(ByVal sty As UByte=0)    ' display it (sty overrides default)
    Declare Sub gframe(ByRef x1 As Short=0, ByRef y1 As Short=0, ByRef x2 As Short=0, ByRef y2 As Short=0)  ' size getter
End Type


#Ifdef __FB_64BIT__
#Inclib "SevenSegment64"
#Else
#Inclib "SevenSegment32"
#EndIf  ' __FB_64BIT__


#EndIf  ' __SevenSegment_bi__

SevenSegment32.bas:

Code: Select all

' SevenSegment32.bas -- 2017-08-15, by MrSwiss
'
' compile: -lib

Type LED_Rec
    As Short    x_, y_, w_, h_  ' position / size
    As ULong    bc_, dc_        ' LED colors
    As Boolean  vis_, stt_      ' visible / status, both: ON or OFF
    As UByte    mod_, res_      ' mode: H / V, reserved
End Type

Type SevenSeg
  Private:
    As Short x1_, y1_, x2_, y2_ ' SevenSeg border positions: x1_, y1_, x2_, y2_
    As ULong bgc_, frc_         ' colors: bg / frame
    As UByte frs_               ' frame style 0 = none/bg, 1 = single/bg , 2 = double/bg
    As LED_Rec  LR(1 To 7)      ' 1, 4 and 7 = horizontal, rest = vertical
  Public:
    Declare Sub initSS(ByVal w As Short=6, ByVal frs As UByte=0, ByVal v As Boolean=TRUE, ByVal s As Boolean=FALSE)
    Declare Sub sca_SS(ByVal w As Short=6)      ' only for re-scaling! (use initSS for first run!)
    Declare Sub pos_SS(ByVal xo As Short, ByVal yo As Short)    ' SSoffset from init (0, 0), as above
    Declare Sub clr_SS(ByVal As ULong, ByVal As ULong, ByVal As ULong=&hFF000000, ByVal As ULong=&hFFFFFFFF) ' 3rd/4th param. is opt.
    Declare Sub dec_SS(ByVal bi As UByte=16)    ' Byte decoder (16 = all OFF)
    Declare Sub dis_SS(ByVal sty As UByte=0)    ' display it (sty overrides default)
    Declare Sub gframe(ByRef x1 As Short=0, ByRef y1 As Short=0, ByRef x2 As Short=0, ByRef y2 As Short=0)  ' size getter
End Type

' start procedure(s) implementation(s)
Sub SevenSeg.initSS( _          ' base initializer (no pos/colors yet)
    ByVal w   As Short=6, _     ' width LED (also: scaling factor!)
    ByVal frs As UByte=0, _     ' frame style (none, single, double)
    ByVal v   As Boolean=TRUE, _' visibility: ON
    ByVal s   As Boolean=FALSE _' LED status: OFF
    )
    If w < 2 Then Exit Sub      ' only 2 or larger accepted (min. size)

    Dim As Short vx = 1.1 * w, vy = vx, lw = w, lh = w * 5
   
    For i As UInteger = 1 To 7  ' LBound(This.LR) To UBound(This.LR)
        With This.LR(i)         ' dealing with sub-type LED_Rec
            Select Case As Const i
                Case 1, 4, 7    : .mod_ = 1 ' a, d, g (horizontal)
                Case 2, 3, 5, 6 : .mod_ = 0 ' b, c, e, f (vertical)
            End Select
            .w_ = lw : .h_ = lh
            If .mod_ = 1 Then Swap .w_, .h_
            .vis_ = v : .stt_ = s
            Select Case As Const i
                Case 1 : .x_ = 2 * vx : .y_ = vy
                Case 2 : .x_ = 2 * vx + lh : .y_ = 2 * vy
                Case 3 : .x_ = 2 * vx + lh : .y_ = 3 * vy + lh
                Case 4 : .x_ = 2 * vx : .y_ = 3 * vy + 2 * lh
                Case 5 : .x_ = vx : .y_ = 3 * vy + lh
                Case 6 : .x_ = vx : .y_ = 2 * vy
                Case 7 : .x_ = 2 * vx : .y_ = 2 * vy + lh
            End Select
        End With
    Next
    With This                   ' dealing with SevenSeg Type
        .x1_ = 0 : .y1_ = 0
        .x2_ = 4 * vx + lh
        .y2_ = 5 * vy + 2 * lh
        .frs_ = frs
    End With
End Sub

Sub SevenSeg.sca_SS(ByVal w As Short=6) ' only for re-scaling! (use initSS first!)
    If w < 2 Then Exit Sub      ' only 2 or larger accepted (min. size)

    Dim As Short vx = 1.1 * w, vy = vx, lw = w, lh = w * 5
   
    For i As UInteger = 1 To 7  ' LBound(This.LR) To UBound(This.LR)
        With This.LR(i)         ' dealing with sub-type LED_Rec
            .w_ = lw : .h_ = lh
            If .mod_ = 1 Then Swap .w_, .h_
            Select Case As Const i
                Case 1 : .x_ = 2 * vx : .y_ = vy
                Case 2 : .x_ = 2 * vx + lh : .y_ = 2 * vy
                Case 3 : .x_ = 2 * vx + lh : .y_ = 3 * vy + lh
                Case 4 : .x_ = 2 * vx : .y_ = 3 * vy + 2 * lh
                Case 5 : .x_ = vx : .y_ = 3 * vy + lh
                Case 6 : .x_ = vx : .y_ = 2 * vy
                Case 7 : .x_ = 2 * vx : .y_ = 2 * vy + lh
            End Select
        End With
    Next
    With This   ' calculate new frame positions (relative to current)
        .x1_ += .LR(1).x_ - 2 * vx
        .y1_ += .LR(1).y_ - vy
        .x2_ = .x1_ + (4 * vx + lh)
        .y2_ = .y1_ + (5 * vy + 2 * lh)
    End With
End Sub

Sub SevenSeg.pos_SS( _
    ByVal xo As Short, _
    ByVal yo As Short _
    )
    With This
        .x1_ = xo : .y1_ = yo
        .x2_ += xo : .y2_ += yo
    End With
End Sub

Sub SevenSeg.clr_SS( _
    ByVal bc  As ULong, _
    ByVal dc  As ULong, _
    ByVal bgc As ULong=&hFF000000, _
    ByVal frc As ULong=&hFFFFFFFF _
    )    ' 3rd param. is opt.
    With This
        .bgc_ = bgc : .frc_ = frc
        For i As UInteger = 1 To 7
            .LR(i).bc_ = bc
            .LR(i).dc_ = dc
        Next
    End With
End Sub

Sub SevenSeg.dec_SS( _
    ByVal bi As UByte=16 _
    )
    If bi > 17 OrElse bi < 0 Then Exit Sub
    ' 16 = all off, 17 = - (dash), otherwise: 0 to F (hex)
    Dim As Boolean  a, b, c, d, e, f, g

    Select Case As Const bi
        Case  0 : a = TRUE  : b = TRUE  : c = TRUE  : d = TRUE  : e = TRUE  : f = TRUE  : g = FALSE ' 0
        Case  1 : a = FALSE : b = TRUE  : c = TRUE  : d = FALSE : e = FALSE : f = FALSE : g = FALSE ' 1
        Case  2 : a = TRUE  : b = TRUE  : c = FALSE : d = TRUE  : e = TRUE  : f = FALSE : g = TRUE  ' 2
        Case  3 : a = TRUE  : b = TRUE  : c = TRUE  : d = TRUE  : e = FALSE : f = FALSE : g = TRUE  ' 3
        Case  4 : a = FALSE : b = TRUE  : c = TRUE  : d = FALSE : e = FALSE : f = TRUE  : g = TRUE  ' 4
        Case  5 : a = TRUE  : b = FALSE : c = TRUE  : d = TRUE  : e = FALSE : f = TRUE  : g = TRUE  ' 5
        Case  6 : a = TRUE  : b = FALSE : c = TRUE  : d = TRUE  : e = TRUE  : f = TRUE  : g = TRUE  ' 6
        Case  7 : a = TRUE  : b = TRUE  : c = TRUE  : d = FALSE : e = FALSE : f = FALSE : g = FALSE ' 7
        Case  8 : a = TRUE  : b = TRUE  : c = TRUE  : d = TRUE  : e = TRUE  : f = TRUE  : g = TRUE  ' 8
        Case  9 : a = TRUE  : b = TRUE  : c = TRUE  : d = TRUE  : e = FALSE : f = TRUE  : g = TRUE  ' 9
        Case 10 : a = TRUE  : b = TRUE  : c = TRUE  : d = FALSE : e = TRUE  : f = TRUE  : g = TRUE  ' A
        Case 11 : a = FALSE : b = FALSE : c = TRUE  : d = TRUE  : e = TRUE  : f = TRUE  : g = TRUE  ' b
        Case 12 : a = TRUE  : b = FALSE : c = FALSE : d = TRUE  : e = TRUE  : f = TRUE  : g = FALSE ' C
        Case 13 : a = FALSE : b = TRUE  : c = TRUE  : d = TRUE  : e = TRUE  : f = FALSE : g = TRUE  ' d
        Case 14 : a = TRUE  : b = FALSE : c = FALSE : d = TRUE  : e = TRUE  : f = TRUE  : g = TRUE  ' E
        Case 15 : a = TRUE  : b = FALSE : c = FALSE : d = FALSE : e = TRUE  : f = TRUE  : g = TRUE  ' F
        Case 16 : a = FALSE : b = FALSE : c = FALSE : d = FALSE : e = FALSE : f = FALSE : g = FALSE ' all off
        Case 17 : a = FALSE : b = FALSE : c = FALSE : d = FALSE : e = FALSE : f = FALSE : g = TRUE  ' -
    End Select

    With This   ' after decoding, set the LED's: ON/OFF status
        .LR(1).stt_ = a : .LR(2).stt_ = b
        .LR(3).stt_ = c : .LR(4).stt_ = d
        .LR(5).stt_ = e : .LR(6).stt_ = f
        .LR(7).stt_ = g
    End With
End Sub

Sub SevenSeg.dis_SS( _
    ByVal sty As UByte=0 _
    )
    Dim As Short    xoffs = This.x1_, yoffs = This.y1_

    With This
        If .frs_ <> sty Then .frs_ = sty    ' frame style override (permanent)
        Line (.x1_, .y1_)-(.x2_, .y2_), .bgc_, BF   ' background always
        If .frs_ = 1 Then
            Line (.x1_, .y1_)-(.x2_, .y2_), .frc_, B    ' single frame
        ElseIf .frs_ = 2 Then
            Line (.x1_, .y1_)-(.x2_, .y2_), .frc_, B    ' double frame
            Line (.x1_ + 1, .y1_ + 1)-(.x2_ - 1, .y2_ - 1), .frc_, B
        End If
    End With
    For i As UInteger = 1 To 7
        With This.LR(i)
            If .stt_ Then
                Line (.x_ + xoffs, .y_ + yoffs)-Step(.w_ - 1, .h_ - 1), .bc_, BF
            Else
                Line (.x_ + xoffs, .y_ + yoffs)-Step(.w_ - 1, .h_ - 1), .dc_, BF
            End If
        End With
    Next
End Sub

Sub SevenSeg.gframe( _
    ByRef x1 As Short=0, _
    ByRef y1 As Short=0, _
    ByRef x2 As Short=0, _
    ByRef y2 As Short=0 _
    )
    With This
        x1 = .x1_ : y1 = .y1_
        x2 = .x2_ : y2 = .y2_
    End With
End Sub
' end procedure(s) implementation(s)

SevenSegment64.bas:

Code: Select all

' SevenSegment64.bas -- 2017-08-15, by MrSwiss
'
' compile: -lib

Type LED_Rec
    As Short    x_, y_, w_, h_  ' position / size
    As ULong    bc_, dc_        ' LED colors
    As Boolean  vis_, stt_      ' visible / status, both: ON or OFF
    As UByte    mod_, res_      ' mode: H / V, reserved
End Type

Type SevenSeg
  Private:
    As Short x1_, y1_, x2_, y2_ ' SevenSeg border positions x1, y1, x2, y2
    As ULong bgc_, frc_         ' colors: bg / frame
    As UByte frs_               ' frame style 0 = none/bg, 1 = single/bg , 2 = double/bg
    As LED_Rec  LR(1 To 7)      ' 1, 4 and 7 = horizontal, rest = vertical
  Public:
    Declare Sub initSS(ByVal w As Short=6, ByVal frs As UByte=0, ByVal v As Boolean=TRUE, ByVal s As Boolean=FALSE)
    Declare Sub sca_SS(ByVal w As Short=6)      ' only for re-scaling! (use initSS for first run!)
    Declare Sub pos_SS(ByVal xo As Short, ByVal yo As Short)    ' SSoffset from init (0, 0), as above
    Declare Sub clr_SS(ByVal As ULong, ByVal As ULong, ByVal As ULong=&hFF000000, ByVal As ULong=&hFFFFFFFF) ' 3rd/4th param. is opt.
    Declare Sub dec_SS(ByVal bi As UByte=16)    ' Byte decoder (16 = all OFF)
    Declare Sub dis_SS(ByVal sty As UByte=0)    ' display it (sty overrides default)
    Declare Sub gframe(ByRef x1 As Short=0, ByRef y1 As Short=0, ByRef x2 As Short=0, ByRef y2 As Short=0)  ' size getter
End Type

' start procedure(s) implementation(s)
Sub SevenSeg.initSS( _          ' base initializer (no pos/colors yet)
    ByVal w   As Short=6, _     ' width LED (also: scaling factor!)
    ByVal frs As UByte=0, _     ' frame style (none, single, double)
    ByVal v   As Boolean=TRUE, _' visibility: ON
    ByVal s   As Boolean=FALSE _' LED status: OFF
    )
    If w < 2 Then Exit Sub      ' only 2 or larger accepted (min. size)

    Dim As Short vx = 1.1 * w, vy = vx, lw = w, lh = w * 5
   
    For i As UInteger = 1 To 7  ' LBound(This.LR) To UBound(This.LR)
        With This.LR(i)         ' dealing with sub-type LED_Rec
            Select Case As Const i
                Case 1, 4, 7    : .mod_ = 1 ' a, d, g (horizontal)
                Case 2, 3, 5, 6 : .mod_ = 0 ' b, c, e, f (vertical)
            End Select
            .w_ = lw : .h_ = lh
            If .mod_ = 1 Then Swap .w_, .h_
            .vis_ = v : .stt_ = s
            Select Case As Const i
                Case 1 : .x_ = 2 * vx : .y_ = vy
                Case 2 : .x_ = 2 * vx + lh : .y_ = 2 * vy
                Case 3 : .x_ = 2 * vx + lh : .y_ = 3 * vy + lh
                Case 4 : .x_ = 2 * vx : .y_ = 3 * vy + 2 * lh
                Case 5 : .x_ = vx : .y_ = 3 * vy + lh
                Case 6 : .x_ = vx : .y_ = 2 * vy
                Case 7 : .x_ = 2 * vx : .y_ = 2 * vy + lh
            End Select
        End With
    Next
    With This                   ' dealing with SevenSeg Type
        .x1_ = 0 : .y1_ = 0
        .x2_ = 4 * vx + lh
        .y2_ = 5 * vy + 2 * lh
        .frs_ = frs
    End With
End Sub

Sub SevenSeg.sca_SS(ByVal w As Short=6) ' only for re-scaling! (use initSS first!)
    If w < 2 Then Exit Sub      ' only 2 or larger accepted (min. size)

    Dim As Short vx = 1.1 * w, vy = vx, lw = w, lh = w * 5
   
    For i As UInteger = 1 To 7  ' LBound(This.LR) To UBound(This.LR)
        With This.LR(i)         ' dealing with sub-type LED_Rec
            .w_ = lw : .h_ = lh
            If .mod_ = 1 Then Swap .w_, .h_
            Select Case As Const i
                Case 1 : .x_ = 2 * vx : .y_ = vy
                Case 2 : .x_ = 2 * vx + lh : .y_ = 2 * vy
                Case 3 : .x_ = 2 * vx + lh : .y_ = 3 * vy + lh
                Case 4 : .x_ = 2 * vx : .y_ = 3 * vy + 2 * lh
                Case 5 : .x_ = vx : .y_ = 3 * vy + lh
                Case 6 : .x_ = vx : .y_ = 2 * vy
                Case 7 : .x_ = 2 * vx : .y_ = 2 * vy + lh
            End Select
        End With
    Next
    With This   ' calculate new frame positions (relative to current)
        .x1_ += .LR(1).x_ - 2 * vx
        .y1_ += .LR(1).y_ - vy
        .x2_ = .x1_ + (4 * vx + lh)
        .y2_ = .y1_ + (5 * vy + 2 * lh)
    End With
End Sub

Sub SevenSeg.pos_SS( _
    ByVal xo As Short, _
    ByVal yo As Short _
    )
    With This
        .x1_ = xo : .y1_ = yo
        .x2_ += xo : .y2_ += yo
    End With
End Sub

Sub SevenSeg.clr_SS( _
    ByVal bc  As ULong, _
    ByVal dc  As ULong, _
    ByVal bgc As ULong=&hFF000000, _
    ByVal frc As ULong=&hFFFFFFFF _
    )    ' 3rd param. is opt.
    With This
        .bgc_ = bgc : .frc_ = frc
        For i As UInteger = 1 To 7
            .LR(i).bc_ = bc
            .LR(i).dc_ = dc
        Next
    End With
End Sub

Sub SevenSeg.dec_SS( _
    ByVal bi As UByte=16 _
    )
    If bi > 17 OrElse bi < 0 Then Exit Sub
    ' 16 = all off, 17 = - (dash), otherwise: 0 to F (hex)
    Dim As Boolean  a, b, c, d, e, f, g

    Select Case As Const bi
        Case  0 : a = TRUE  : b = TRUE  : c = TRUE  : d = TRUE  : e = TRUE  : f = TRUE  : g = FALSE ' 0
        Case  1 : a = FALSE : b = TRUE  : c = TRUE  : d = FALSE : e = FALSE : f = FALSE : g = FALSE ' 1
        Case  2 : a = TRUE  : b = TRUE  : c = FALSE : d = TRUE  : e = TRUE  : f = FALSE : g = TRUE  ' 2
        Case  3 : a = TRUE  : b = TRUE  : c = TRUE  : d = TRUE  : e = FALSE : f = FALSE : g = TRUE  ' 3
        Case  4 : a = FALSE : b = TRUE  : c = TRUE  : d = FALSE : e = FALSE : f = TRUE  : g = TRUE  ' 4
        Case  5 : a = TRUE  : b = FALSE : c = TRUE  : d = TRUE  : e = FALSE : f = TRUE  : g = TRUE  ' 5
        Case  6 : a = TRUE  : b = FALSE : c = TRUE  : d = TRUE  : e = TRUE  : f = TRUE  : g = TRUE  ' 6
        Case  7 : a = TRUE  : b = TRUE  : c = TRUE  : d = FALSE : e = FALSE : f = FALSE : g = FALSE ' 7
        Case  8 : a = TRUE  : b = TRUE  : c = TRUE  : d = TRUE  : e = TRUE  : f = TRUE  : g = TRUE  ' 8
        Case  9 : a = TRUE  : b = TRUE  : c = TRUE  : d = TRUE  : e = FALSE : f = TRUE  : g = TRUE  ' 9
        Case 10 : a = TRUE  : b = TRUE  : c = TRUE  : d = FALSE : e = TRUE  : f = TRUE  : g = TRUE  ' A
        Case 11 : a = FALSE : b = FALSE : c = TRUE  : d = TRUE  : e = TRUE  : f = TRUE  : g = TRUE  ' b
        Case 12 : a = TRUE  : b = FALSE : c = FALSE : d = TRUE  : e = TRUE  : f = TRUE  : g = FALSE ' C
        Case 13 : a = FALSE : b = TRUE  : c = TRUE  : d = TRUE  : e = TRUE  : f = FALSE : g = TRUE  ' d
        Case 14 : a = TRUE  : b = FALSE : c = FALSE : d = TRUE  : e = TRUE  : f = TRUE  : g = TRUE  ' E
        Case 15 : a = TRUE  : b = FALSE : c = FALSE : d = FALSE : e = TRUE  : f = TRUE  : g = TRUE  ' F
        Case 16 : a = FALSE : b = FALSE : c = FALSE : d = FALSE : e = FALSE : f = FALSE : g = FALSE ' all off
        Case 17 : a = FALSE : b = FALSE : c = FALSE : d = FALSE : e = FALSE : f = FALSE : g = TRUE  ' -
    End Select

    With This   ' after decoding, set the LED's: ON/OFF status
        .LR(1).stt_ = a : .LR(2).stt_ = b
        .LR(3).stt_ = c : .LR(4).stt_ = d
        .LR(5).stt_ = e : .LR(6).stt_ = f
        .LR(7).stt_ = g
    End With
End Sub

Sub SevenSeg.dis_SS( _
    ByVal sty As UByte=0 _
    )
    Dim As Short    xoffs = This.x1_, yoffs = This.y1_

    With This
        If .frs_ <> sty Then .frs_ = sty    ' frame style override (permanent)
        Line (.x1_, .y1_)-(.x2_, .y2_), .bgc_, BF   ' background always
        If .frs_ = 1 Then
            Line (.x1_, .y1_)-(.x2_, .y2_), .frc_, B    ' single frame
        ElseIf .frs_ = 2 Then
            Line (.x1_, .y1_)-(.x2_, .y2_), .frc_, B    ' double frame
            Line (.x1_ + 1, .y1_ + 1)-(.x2_ - 1, .y2_ - 1), .frc_, B
        End If
    End With
    For i As UInteger = 1 To 7
        With This.LR(i)
            If .stt_ Then
                Line (.x_ + xoffs, .y_ + yoffs)-Step(.w_ - 1, .h_ - 1), .bc_, BF
            Else
                Line (.x_ + xoffs, .y_ + yoffs)-Step(.w_ - 1, .h_ - 1), .dc_, BF
            End If
        End With
    Next
End Sub

Sub SevenSeg.gframe( _
    ByRef x1 As Short=0, _
    ByRef y1 As Short=0, _
    ByRef x2 As Short=0, _
    ByRef y2 As Short=0 _
    )
    With This
        x1 = .x1_ : y1 = .y1_
        x2 = .x2_ : y2 = .y2_
    End With
End Sub
' end procedure(s) implementation(s)
MrSwiss
Posts: 2532
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: SevenSegment (FB 32/64, static lib)

Postby MrSwiss » Feb 10, 2018 17:25

First Example:
7-Segment LED Clock in Tips & Tricks section (more complex initializer).

Show case for scalability of 7-Segment display:

Code: Select all

' SevenSegment_ShowCase.bas -- 2017-08-19, by MrSwiss
'
' compile: -s gui

#Include "SevenSegment.bi"

' decimal splitter, range: 0 to 99, for single numerals result
Function Div_Mod ( _        ' UByte processing only
    ByVal iB  As UByte, _   ' dividend
    ByVal dvr As UByte=10 _ ' divisor (default 10), decimal
    ) As UShort             ' high: div res. | low: mod res.
    Div_Mod = ((iB \ dvr) Shl 8) + iB Mod dvr
End Function

' init code: clock specific positioning (spaces in between HR/MIN/SEC)
Dim As SevenSeg SS(5)       ' 6 elements, of SevenSeg (0 to 5)
Dim As UShort   startx = 50, starty = 50, endx, endy, sp_sec, sp_min, sp_hou, _
                LnStyle = &hF3F3    ' fbGFX fixed in FBC x64 1.05.0 (min. ver.)

For i As UInteger = 0 To 5
    SS(i).initSS(8)         ' '8' sizes SevenSeg (width of a LED, default = 6)
    SS(i).clr_SS(b_red, d_red)  ' bright/dark LED, bg, frame (colors)
    Select Case As Const i  ' positioning depending on prev. set pos.
        Case 0 :        SS(i).pos_SS(startx, starty)    ' first position only
        Case 1, 3, 5 :  SS(i).pos_SS(endx + 1, starty)  ' to next position
        Case 2, 4 :     SS(i).pos_SS(endx + 21, starty) ' next pos. + space = 20
    End Select
    SS(i).gframe( ,, endx)  ' get end pos. x-axis (+1 = next start pos.)
    If i = 5 Then SS(i).gframe( ,,, endy)   ' on SS(5), endpos. y-axis
Next    ' we now have start/end coordinates of the whole SevenSeg block!

' below: customized procedures using lib's primitives (extending them)
Declare Sub ColorControl(a() As SevenSeg, ByVal tm As UByte)
Declare Sub SizeControl(a() As SevenSeg, ByVal ts As UByte, ByVal ct As UByte=5)

' ===== MAIN =====
'#Define timing  ' uncomment to see run-time (comment it, for normal operation)

ScreenRes(endx + startx + 150, 2 * (endy + starty), 32, 2, 64)  ' Alpha Primitives = 64 / &H40 _
ScreenSet(1, 0)                                                 ' just in case of transparent bg
Color(black,  grey) : Cls

Dim As String   cTime = Time, TM = "MrSwiss made(TM)", _
                title = "Digital 24 hour's clock, using SevenSegment Lib"
Dim As UByte    tmp_sec, tmp_min
' example to show preprocessor code use (conditional compiling of code)
#Ifdef timing
Dim As Double   t1, t2      ' only needed if 'timing' is defined (see main top)
#EndIf

Do
    If Time <> cTime Then   ' run's once a second only
        Cls
        #Ifdef timing
        t1 = Timer          ' NOTE: previous run's time is shown!
        Draw String (10, 4), "run-time: " + Str(t2), yellow : t2 = 0.0
        #EndIf
        ' refresh time and (show) title's sequence
        cTime = Time
        Draw String (110,  18), title, white
        Draw String (238, 196), TM, white
        ' animation sequence (colors and sizes)
        tmp_sec = CUByte(Right(cTime, 2))   ' get seconds (for anim.)
        tmp_min = CUByte(Mid(cTime, 4, 2))  ' get minutes (for anim.)
        SizeControl(SS(), tmp_sec, 3)       ' change size every 3 seconds (on sec's)
        ColorControl(SS(), tmp_min)         ' check for MIN change (delegated to Sub)
        sp_hou = Div_Mod(CUByte(Left(cTime, 2)))    ' get split hours (straight away)
        sp_min = Div_Mod(tmp_min) : sp_sec = Div_Mod(tmp_sec)   ' using intermediates
        ' pre-set and diplay sequence
        If HiByte(sp_hou) = 0 Then          ' switch OFF, leading zero (on Hours only)
            SS(0).dec_SS()                  ' all segments OFF (default: on dec_SS)
        Else
            SS(0).dec_SS(HiByte(sp_hou))    ' decode it (LED's: ON/OFF status)
        End If : SS(1).dec_SS(LoByte(sp_hou))   ' lower hour part (always displayed)
        SS(2).dec_SS(HiByte(sp_min)) : SS(3).dec_SS(LoByte(sp_min)) ' minutes
        SS(4).dec_SS(HiByte(sp_sec)) : SS(5).dec_SS(LoByte(sp_sec)) ' seconds
        For i As UInteger = 0 To 5 : SS(i).dis_SS() : Next  ' display them all
        ' show max. size border lines (w = 24), reqires FBC x64 >= 1.05.0 !!!
        Var ey = 2 * (endy + starty)        ' calc. once, use many times, speed!
        Line (474, 35)-(474, ey - 20), yellow,, LnStyle ' left side
        Line (699, 35)-(699, ey - 20), yellow,, LnStyle ' right side
        Line (ey, 420)-(ey + 270, 420), yellow,,LnStyle ' bottom (top, no change)
        Flip    ' ScreenCopy: switch buffer's
        #Ifdef timing
        t2 = Timer - t1
        #EndIf
    End If
    If Len(InKey()) Then Exit Do
    Sleep(100, 1)
Loop
' ===== END-MAIN =====
' implement declared proc's ...
Sub ColorControl( _             ' SevenSeg coloring
    a() As SevenSeg, _          ' array of SevenSeg (implicit: ByRef)
    ByVal tm As UByte _         ' current minute
    )
    Static As UByte  sb, cnt    ' keep values in between call's

    If sb = tm Then Exit Sub    ' no change? --> get out!

    Dim As ULong    nfc, nbc    ' temp. colors
    sb = tm : cnt += 1          ' update sb | incr. cnt
    Select Case As Const cnt
        Case 1 : nfc = b_red : nbc = d_red  ' new color
        Case 2 : nfc = b_grn : nbc = d_grn
        Case 3 : nfc = b_blu : nbc = d_blu
        Case 4 : nfc = pink  : nbc = violet
        Case 5 : nfc = white : nbc = d_gry
    End Select
    For i As UInteger = 0 To 3  ' hours & minutes only
        a(i).clr_SS(nfc, nbc)   ' set new color's (no bg, no frame)
    Next
    If cnt Mod 2 Then           ' seconds only (different colors, alternating)
        a(4).clr_SS(b_yel, d_yel) : a(5).clr_SS(b_yel, d_yel)
    Else
        a(4).clr_SS(b_org, d_org) : a(5).clr_SS(b_org, d_org)
    End If
    If cnt = 5 Then cnt = 0     ' reset counter on maximum
    ' a().clr_SS() default: bg=black, frame=white (overwrite them, if different)
End Sub

Sub SizeControl( _              ' SevenSeg scaling
    a() As SevenSeg, _          ' array of SevenSeg (implicit: ByRef)
    ByVal ts As UByte, _        ' current second
    ByVal ct As UByte = 5 _     ' seconds to wait, for change (default: 5)
    )
    Static As UByte sb, cnt     ' keep values in between call's
    Static As Boolean d_i_r     ' FALSE = scale down, TRUE = scale up
    If cnt = 0 Then sb = ts + ct : cnt = 8 : d_i_r = TRUE   ' init once only

    If ts <> sb Then Exit Sub   ' not equal? --> get out!

    sb = ts + ct                ' update sb (curr. sec. + sec's 'to wait')
    If sb > 59 Then sb -= 60    ' minute correction (sec. range: 0 to 59)
    If d_i_r Then cnt += 1 Else cnt -= 1
    If cnt < 2 OrElse cnt > 24 Then  ' range check (allowed sizes)
        d_i_r = Not d_i_r       ' switch direction (edge condition)
        If d_i_r Then cnt = 3 Else cnt = 23  ' manually set cnt to current
    End If
    a(4).sca_SS(cnt) : a(5).sca_SS(cnt) ' set new scale factor (= LED's width)
End Sub
' ----- EOF -----

A simpler initializer, using the "getter" to place consecutive 7-Segment displays:

Code: Select all

' SevenSegment_Test2.bas -- 2017-08-11, by MrSwiss
'
' compile: -s gui

#Include "SevenSegment.bi"

' init code
' default: decimal splitter, range: 0 to 99, for single numerals result
Function Div_Mod ( _        ' UByte processing only
    ByVal iB  As UByte, _   ' dividend
    ByVal dvr As UByte=10 _ ' divisor (default 10), decimal
    ) As UShort             ' high: div res. | low: mod res.
    Div_Mod = ((iB \ dvr) Shl 8) + iB Mod dvr
End Function

Dim As SevenSeg SS(5)   ' 6 elements SevenSeg
Dim As UShort   startx, starty, endx, endy, sp_sec, sp_min, sp_hou

For i As UInteger = 0 To 5
    SS(i).initSS(4, 2)
    SS(i).clr_SS(b_red, d_red, black, blue) ' bright/dark LED, bg, frame
Next

SS(0).pos_SS(50, 50)
SS(0).gframe(startx, starty, endx, endy) ' get sizes of: SS(0)
SS(1).pos_SS(endx + 1, 50)               ' to position SS(1)
SS(1).gframe(startx, starty, endx, endy)
SS(2).pos_SS(endx + 21, 50)
SS(2).gframe(startx, starty, endx, endy)
SS(3).pos_SS(endx + 1, 50)
SS(3).gframe(startx, starty, endx, endy)
SS(4).pos_SS(endx + 21, 50)
SS(4).gframe(startx, starty, endx, endy)
SS(5).pos_SS(endx + 1, 50)
SS(5).gframe(startx, starty, endx, endy)

' ===== MAIN =====
ScreenRes(601, endy + starty, 32, 2, 64) ' Alpha Primitives = 64 / &H40
Dim As Integer  x, y : ScreenInfo(x, y)  ' get size(s) current screen
ScreenSet(1, 0)
Color(black,  grey) : Cls

Dim As String   cTime = Time, TM = "MrSwiss made(TM)", _
                title = "Digital 24 hour's clock, using SevenSegment Lib"

Do
    If Time <> cTime Then
        cTime = Time
        'Draw String ( 10,  10), "width:  " + Str(endx) ' debug only
        'Draw String ( 10,  22), "height: " + Str(endy) ' debug only
        Draw String (110,  18), title, white
        Draw String (238, endy + starty - 29), TM, white
        Draw String (350, (endy + starty) / 2 - 4), "width: " + Str(4), yellow
        sp_sec = Div_Mod(CUByte(Right(cTime, 2)))
        sp_min = Div_Mod(CUByte(Mid(cTime, 4, 2)))
        sp_hou = Div_Mod(CUByte(Left(cTime, 2)))
        If HiByte(sp_hou) = 0 Then
            SS(0).dec_SS()  ' default: all LED's OFF
        Else
            SS(0).dec_SS(HiByte(sp_hou))
        End If  ' above: switch leading zero OFF (hours only)
        SS(0).dis_SS(1)
        SS(1).dec_SS(LoByte(sp_hou)) : SS(1).dis_SS(1)
        SS(2).dec_SS(HiByte(sp_min)) : SS(2).dis_SS(1)
        SS(3).dec_SS(LoByte(sp_min)) : SS(3).dis_SS(1)
        SS(4).dec_SS(HiByte(sp_sec)) : SS(4).dis_SS(1)
        SS(5).dec_SS(LoByte(sp_sec)) : SS(5).dis_SS(1)
        Flip
    End If
    If Len(InKey()) Then Exit Do
    Sleep(50, 1)
Loop
' ===== END-MAIN =====

Return to “Projects”

Who is online

Users browsing this forum: No registered users and 2 guests