VB6模拟LED显示的一个类（改进）

最新推荐文章于 2022-10-09 16:07:20 发布

YFY

最新推荐文章于 2022-10-09 16:07:20 发布

阅读量1k

点赞数

本文链接：https://blog.youkuaiyun.com/YFY/article/details/2282275

版权

VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "cLEDExpand"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Rem                       cLEDExpand v1.0
Rem
Rem    主要功能：模拟LED显示时间，格式"YYYY-MM-DD HH:MM:SS" 增加汉字显示
Rem             改写模块使字符和数字间隙更加合理
Rem             改写所有函数，使变量命名更加规范(个人的规范)
Rem
Rem    参考资料: 网络上下载的一个模拟LED显示的一个类(2003-02-26)
Rem
Rem    更新时间：2003-08-10
Rem

Option Explicit

Private Type UDTCoordinate '自定义类型坐标
   xPos As Integer
   yPos As Integer
End Type
Private mudtBasePoint As UDTCoordinate '基点将要写的数字位置都是基于基点的
Private mintSegWidth   As Integer        '数字宽度（基本方框）
Private mintSegHeight As Integer        '数字高度（基本方框）
Private mpicLED        As PictureBox     'LED显示的实例

'设置一个新的LED显示类实例
Public Sub SetNewLED(ByRef picNewLED As PictureBox)
On Error Resume Next

    Set mpicLED = picNewLED
    mpicLED.ScaleMode = 3       '坐标系统的单位为象素(pixel)
    mpicLED.AutoRedraw = True   '自动更新选中

    mudtBasePoint.xPos = 2
    mudtBasePoint.yPos = 2

    mintSegHeight = mpicLED.ScaleHeight - 10
    mintSegWidth = (mintSegHeight / 2) + 2
End Sub

'关闭所有连接释放占用的内存
Public Sub CloseAll()
Set mpicLED = Nothing
End Sub

'设置设置显示字符的基点
'Public Sub SetBasePoint(ByVal xPos As Integer, ByVal yPos As Integer)
' mudtBasePoint.xPos = xPos
' mudtBasePoint.yPos = yPos
'End Sub

'设置LED显示的背景色
Public Property Let BackColor(ByVal NewBackColor As Long)
mpicLED.BackColor = NewBackColor
End Property

'获取当前LED显示的背景色
Public Property Get BackColor() As Long
BackColor = mpicLED.BackColor
End Property

'设置前景色(显示字的颜色）
Property Let ForeColor(ByVal NewForeColor As Long)
mpicLED.ForeColor = NewForeColor
End Property

'获取当前前景色(显示字的颜色）
Public Property Get ForeColor() As Long
ForeColor = mpicLED.ForeColor
End Property

'内部方法画数字
Private Sub DrawNumber(ByVal intRealNumber As Integer)
On Error Resume Next

    Select Case intRealNumber
    Case 0
        DrawSegment (1)
        DrawSegment (2)
        DrawSegment (3)
        DrawSegment (4)
        DrawSegment (5)
        DrawSegment (6)
    Case 1
        DrawSegment (2)
        DrawSegment (3)
    Case 2
        DrawSegment (1)
        DrawSegment (2)
        DrawSegment (7)
        DrawSegment (5)
        DrawSegment (4)
    Case 3
        DrawSegment (1)
        DrawSegment (2)
        DrawSegment (7)
        DrawSegment (3)
        DrawSegment (4)
    Case 4
       DrawSegment (2)
        DrawSegment (3)
        DrawSegment (7)
        DrawSegment (6)
    Case 5
       DrawSegment (1)
        DrawSegment (6)
        DrawSegment (7)
        DrawSegment (3)
        DrawSegment (4)
    Case 6
        DrawSegment (1)
        DrawSegment (6)
        DrawSegment (7)
        DrawSegment (3)
        DrawSegment (4)
        DrawSegment (5)
    Case 7
        DrawSegment (1)
        DrawSegment (2)
        DrawSegment (3)
    Case 8
        DrawSegment (1)
        DrawSegment (2)
        DrawSegment (3)
        DrawSegment (4)
        DrawSegment (5)
        DrawSegment (6)
        DrawSegment (7)
    Case 9
        DrawSegment (1)
        DrawSegment (2)
        DrawSegment (3)
        DrawSegment (4)
        DrawSegment (6)
        DrawSegment (7)
    End Select

End Sub

'内部方法画每一段的线条
Private Sub DrawSegment(ByVal SegNum As Integer)
On Error Resume Next

'LED显示7段的顺序
'
'      1
'     ___
'    |   |
' 6 |   | 2
'    |-7-|
' 5 |   | 3
'    |___|
'
'      4
'
'每一段画三条线线的长度不一样（完全规则）（1，4）（2，6）（3，5）（7）形成视觉效果

    Select Case SegNum
    Case 1
        mpicLED.Line (mudtBasePoint.xPos + 1, mudtBasePoint.yPos)-(mudtBasePoint.xPos + mintSegWidth - 1, mudtBasePoint.yPos)
        mpicLED.Line (mudtBasePoint.xPos + 2, mudtBasePoint.yPos + 1)-(mudtBasePoint.xPos + mintSegWidth - 2, mudtBasePoint.yPos + 1)
        mpicLED.Line (mudtBasePoint.xPos + 3, mudtBasePoint.yPos + 2)-(mudtBasePoint.xPos + mintSegWidth - 3, mudtBasePoint.yPos + 2)
    Case 2
        mpicLED.Line (mudtBasePoint.xPos + mintSegWidth - 1, mudtBasePoint.yPos + 1)-(mudtBasePoint.xPos + mintSegWidth - 1, mudtBasePoint.yPos + (mintSegHeight / 2) - 1)
        mpicLED.Line (mudtBasePoint.xPos + mintSegWidth - 2, mudtBasePoint.yPos + 2)-(mudtBasePoint.xPos + mintSegWidth - 2, mudtBasePoint.yPos + (mintSegHeight / 2))
        mpicLED.Line (mudtBasePoint.xPos + mintSegWidth - 3, mudtBasePoint.yPos + 3)-(mudtBasePoint.xPos + mintSegWidth - 3, mudtBasePoint.yPos + (mintSegHeight / 2) - 1)
    Case 3
        mpicLED.Line (mudtBasePoint.xPos + mintSegWidth - 1, mudtBasePoint.yPos + (mintSegHeight / 2) + 2)-(mudtBasePoint.xPos + mintSegWidth - 1, mudtBasePoint.yPos + mintSegHeight)
        mpicLED.Line (mudtBasePoint.xPos + mintSegWidth - 2, mudtBasePoint.yPos + (mintSegHeight / 2) + 1)-(mudtBasePoint.xPos + mintSegWidth - 2, mudtBasePoint.yPos + mintSegHeight - 1)
        mpicLED.Line (mudtBasePoint.xPos + mintSegWidth - 3, mudtBasePoint.yPos + (mintSegHeight / 2) + 2)-(mudtBasePoint.xPos + mintSegWidth - 3, mudtBasePoint.yPos + mintSegHeight - 2)
    Case 4
        mpicLED.Line (mudtBasePoint.xPos + 3, mudtBasePoint.yPos + mintSegHeight - 2)-(mudtBasePoint.xPos + mintSegWidth - 3, mudtBasePoint.yPos + mintSegHeight - 2)
        mpicLED.Line (mudtBasePoint.xPos + 2, mudtBasePoint.yPos + mintSegHeight - 1)-(mudtBasePoint.xPos + mintSegWidth - 2, mudtBasePoint.yPos + mintSegHeight - 1)
        mpicLED.Line (mudtBasePoint.xPos + 1, mudtBasePoint.yPos + mintSegHeight)-(mudtBasePoint.xPos + mintSegWidth - 1, mudtBasePoint.yPos + mintSegHeight)
    Case 5
        mpicLED.Line (mudtBasePoint.xPos, mudtBasePoint.yPos + (mintSegHeight / 2) + 2)-(mudtBasePoint.xPos, mudtBasePoint.yPos + mintSegHeight)
        mpicLED.Line (mudtBasePoint.xPos + 1, mudtBasePoint.yPos + (mintSegHeight / 2) + 1)-(mudtBasePoint.xPos + 1, mudtBasePoint.yPos + mintSegHeight - 1)
        mpicLED.Line (mudtBasePoint.xPos + 2, mudtBasePoint.yPos + (mintSegHeight / 2) + 2)-(mudtBasePoint.xPos + 2, mudtBasePoint.yPos + mintSegHeight - 2)
    Case 6
        mpicLED.Line (mudtBasePoint.xPos, mudtBasePoint.yPos + 1)-(mudtBasePoint.xPos, mudtBasePoint.yPos + (mintSegHeight / 2) - 1)
        mpicLED.Line (mudtBasePoint.xPos + 1, mudtBasePoint.yPos + 2)-(mudtBasePoint.xPos + 1, mudtBasePoint.yPos + (mintSegHeight / 2))
        mpicLED.Line (mudtBasePoint.xPos + 2, mudtBasePoint.yPos + 3)-(mudtBasePoint.xPos + 2, mudtBasePoint.yPos + (mintSegHeight / 2) - 1)
    Case 7
        mpicLED.Line (mudtBasePoint.xPos + 3, mudtBasePoint.yPos + (mintSegHeight / 2) - 1)-(mudtBasePoint.xPos + mintSegWidth - 3, mudtBasePoint.yPos + (mintSegHeight / 2) - 1)
        mpicLED.Line (mudtBasePoint.xPos + 2, mudtBasePoint.yPos + (mintSegHeight / 2))-(mudtBasePoint.xPos + mintSegWidth - 2, mudtBasePoint.yPos + (mintSegHeight / 2))
        mpicLED.Line (mudtBasePoint.xPos + 3, mudtBasePoint.yPos + (mintSegHeight / 2) + 1)-(mudtBasePoint.xPos + mintSegWidth - 3, mudtBasePoint.yPos + (mintSegHeight / 2) + 1)
    End Select

End Sub

'设置显示的内容
Public Sub SetCaption(ByVal blnShowHeaderInfo As Boolean, _
                            ByVal xPosHeader As Integer, _
                            ByVal yPosHeader As Integer, _
                            ByVal lngHeaderFontsize As Long, _
                            ByVal blnHeaderFontBold As Boolean, _
                            ByVal strHeaderInfo As String, _
                            ByVal xPosBasePoint As Integer, _
                            ByVal yPosBasePoint As Integer, _
                            ByVal strNewValue As String)
    On Error Resume Next

    mpicLED.Cls

    If blnShowHeaderInfo Then
        mpicLED.CurrentX = xPosHeader
        mpicLED.CurrentY = yPosHeader
        mpicLED.FontSize = lngHeaderFontsize
        mpicLED.FontBold = blnHeaderFontBold
        mpicLED.Print Trim(strHeaderInfo)
    End If

    mudtBasePoint.xPos = xPosBasePoint
    mudtBasePoint.yPos = yPosBasePoint

    Dim strDrawOne As String
    strDrawOne = ""

    While strNewValue <> ""
        'If Left$(strNewValue, 1) <> ":" Then    '# 用Line方法画线段
        '    DrawNumber (Val(Left$(strNewValue, 1)))
        '    mudtBasePoint.xPos = mudtBasePoint.xPos + mintSegWidth + 3
        'Else                              '# 用Line方法画矩形
        '    mpicLED.Line (mudtBasePoint.xPos + (mintSegWidth / 2) - 4, mudtBasePoint.yPos + (mintSegHeight / 2) - 6)-(mudtBasePoint.xPos + (mintSegWidth / 2), mudtBasePoint.yPos + (mintSegHeight / 2) - 3), , BF
        '    mpicLED.Line (mudtBasePoint.xPos + (mintSegWidth / 2) - 4, mudtBasePoint.yPos + (mintSegHeight / 2) + 4)-(mudtBasePoint.xPos + (mintSegWidth / 2), mudtBasePoint.yPos + (mintSegHeight / 2) + 7), , BF
        '    mudtBasePoint.xPos = mudtBasePoint.xPos + mintSegWidth
        'End If
        'strNewValue = Right$(strNewValue, Len(strNewValue) - 1)
        strDrawOne = Mid(strNewValue, 1, 1)
        If strDrawOne <> ":" And strDrawOne <> " " And strDrawOne <> "-" Then   '用Line方法画线段
            DrawNumber (Val(Mid(strNewValue, 1, 1)))
            mudtBasePoint.xPos = mudtBasePoint.xPos + mintSegWidth + 3
        ElseIf strDrawOne = ":" Then                           '用Line方法画矩形
            mpicLED.Line (mudtBasePoint.xPos + (mintSegWidth / 2) - 2, mudtBasePoint.yPos + (mintSegHeight / 2) - 6)-(mudtBasePoint.xPos + (mintSegWidth / 2) + 2, mudtBasePoint.yPos + (mintSegHeight / 2) - 3), , BF
            mpicLED.Line (mudtBasePoint.xPos + (mintSegWidth / 2) - 2, mudtBasePoint.yPos + (mintSegHeight / 2) + 4)-(mudtBasePoint.xPos + (mintSegWidth / 2) + 2, mudtBasePoint.yPos + (mintSegHeight / 2) + 7), , BF
            mudtBasePoint.xPos = mudtBasePoint.xPos + mintSegWidth
        ElseIf strDrawOne = " " Then
            mudtBasePoint.xPos = mudtBasePoint.xPos + mintSegWidth
        ElseIf strDrawOne = "-" Then
            mpicLED.Line (mudtBasePoint.xPos + 2, mudtBasePoint.yPos + (mintSegHeight / 2) - 2)-(mudtBasePoint.xPos + mintSegWidth - 2, mudtBasePoint.yPos + (mintSegHeight / 2) + 2), , BF
            mudtBasePoint.xPos = mudtBasePoint.xPos + mintSegWidth + 2
        End If
        strNewValue = Mid(strNewValue, 2, Len(strNewValue) - 1)
    Wend
End Sub