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)
(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__
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)
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)