液晶时钟代码

Question

谁有液晶时钟的代码?(利用显示图片来达到液晶显示的那种),我在网上找了好久都没有找到,谁有源代码的请发个给我.(不要生成控件的),有的请发到

Answer 1

Option ExplicitPrivate Type Coordinate
    X As Integer
    Y As Integer
End TypeDim BasePoint As Coordinate
Dim SegWidth As Integer
Dim SegHeight As Integer
Dim p As FormProperty Let BackColor(Color As Long)
    p.BackColor = Color
End PropertyPrivate Sub DrawNumber(Number As Integer)
    Select Case Number
        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 SubPrivate Sub DrawSegment(SegNum As Integer)
    '
    '      1
    '     ___
    '    |   |
    ' 6  |   |  2
    '    |-7-|
    ' 5  |   |  3
    '    |___|
    '
    '      4
    '
    Select Case SegNum
        Case 1
            p.Line (BasePoint.X + 1, BasePoint.Y)-(BasePoint.X + SegWidth - 1, BasePoint.Y)
            p.Line (BasePoint.X + 2, BasePoint.Y + 1)-(BasePoint.X + SegWidth - 2, BasePoint.Y + 1)
            p.Line (BasePoint.X + 3, BasePoint.Y + 2)-(BasePoint.X + SegWidth - 3, BasePoint.Y + 2)
        Case 2
            p.Line (BasePoint.X + SegWidth - 1, BasePoint.Y + 1)-(BasePoint.X + SegWidth - 1, BasePoint.Y + (SegHeight \ 2) - 1)
            p.Line (BasePoint.X + SegWidth - 2, BasePoint.Y + 2)-(BasePoint.X + SegWidth - 2, BasePoint.Y + (SegHeight \ 2))
            p.Line (BasePoint.X + SegWidth - 3, BasePoint.Y + 3)-(BasePoint.X + SegWidth - 3, BasePoint.Y + (SegHeight \ 2) - 1)
        Case 3
            p.Line (BasePoint.X + SegWidth - 1, BasePoint.Y + (SegHeight \ 2) + 2)-(BasePoint.X + SegWidth - 1, BasePoint.Y + SegHeight)
            p.Line (BasePoint.X + SegWidth - 2, BasePoint.Y + (SegHeight \ 2) + 1)-(BasePoint.X + SegWidth - 2, BasePoint.Y + SegHeight - 1)
            p.Line (BasePoint.X + SegWidth - 3, BasePoint.Y + (SegHeight \ 2) + 2)-(BasePoint.X + SegWidth - 3, BasePoint.Y + SegHeight - 2)
        Case 4
            p.Line (BasePoint.X + 3, BasePoint.Y + SegHeight - 2)-(BasePoint.X + SegWidth - 3, BasePoint.Y + SegHeight - 2)
            p.Line (BasePoint.X + 2, BasePoint.Y + SegHeight - 1)-(BasePoint.X + SegWidth - 2, BasePoint.Y + SegHeight - 1)
            p.Line (BasePoint.X + 1, BasePoint.Y + SegHeight)-(BasePoint.X + SegWidth - 1, BasePoint.Y + SegHeight)
        Case 5
            p.Line (BasePoint.X, BasePoint.Y + (SegHeight \ 2) + 2)-(BasePoint.X, BasePoint.Y + SegHeight)
            p.Line (BasePoint.X + 1, BasePoint.Y + (SegHeight \ 2) + 1)-(BasePoint.X + 1, BasePoint.Y + SegHeight - 1)
            p.Line (BasePoint.X + 2, BasePoint.Y + (SegHeight \ 2) + 2)-(BasePoint.X + 2, BasePoint.Y + SegHeight - 2)
        Case 6
            p.Line (BasePoint.X, BasePoint.Y + 1)-(BasePoint.X, BasePoint.Y + (SegHeight \ 2) - 1)
            p.Line (BasePoint.X + 1, BasePoint.Y + 2)-(BasePoint.X + 1, BasePoint.Y + (SegHeight \ 2))
            p.Line (BasePoint.X + 2, BasePoint.Y + 3)-(BasePoint.X + 2, BasePoint.Y + (SegHeight \ 2) - 1)
        Case 7
            p.Line (BasePoint.X + 3, BasePoint.Y + (SegHeight \ 2) - 1)-(BasePoint.X + SegWidth - 3, BasePoint.Y + (SegHeight \ 2) - 1)
            p.Line (BasePoint.X + 2, BasePoint.Y + (SegHeight \ 2))-(BasePoint.X + SegWidth - 2, BasePoint.Y + (SegHeight \ 2))
            p.Line (BasePoint.X + 3, BasePoint.Y + (SegHeight \ 2) + 1)-(BasePoint.X + SegWidth - 3, BasePoint.Y + (SegHeight \ 2) + 1)
    End Select
End SubPublic Property Let Caption(ByVal Value As String)
    Dim OrigX As Integer    OrigX = BasePoint.X
    p.Cls    While Value <> ""
        If Mid(Value, 1, 1) = ":" Then
            p.Line (BasePoint.X + (SegWidth \ 2) - 3, BasePoint.Y + (SegHeight \ 2) - 6)-(BasePoint.X + (SegWidth \ 2), BasePoint.Y + (SegHeight \ 2) - 3), , BF
            p.Line (BasePoint.X + (SegWidth \ 2) - 3, BasePoint.Y + (SegHeight \ 2) + 4)-(BasePoint.X + (SegWidth \ 2), BasePoint.Y + (SegHeight \ 2) + 7), , BF
            BasePoint.X = BasePoint.X + SegWidth
        ElseIf Mid(Value, 1, 1) = "-" Then
            DrawSegment 7
            BasePoint.X = BasePoint.X + SegWidth + 3
        ElseIf Mid(Value, 1, 1) = " " Then
            BasePoint.X = BasePoint.X + SegWidth
        Else
            DrawNumber (val(Mid(Value, 1, 1)))
            BasePoint.X = BasePoint.X + SegWidth + 3
        End If
        Value = Right$(Value, Len(Value) - 1)
    Wend
    BasePoint.X = OrigX
End PropertyProperty Let ForeColor(Color As Long)
    p.ForeColor = Color
End PropertyPublic Sub NewLCD(PBox As Form, sX As Long, sY As Long)
    Set p = PBox
    p.ScaleMode = 3                                        ' pixel
    p.AutoRedraw = True
    BasePoint.X = sX
    BasePoint.Y = sY
    SegHeight = 20
    SegWidth = (SegHeight \ 2) + 2
End Sub

Answer 2

2楼的是不用图片模拟LED显示,而我要的是要用通过显示0到9的图片来模拟LED显示.你所贴的代码我早有了

Answer 3

多年前的作品，可以给你参考参考 http://download.csdn.net/source/511674

Answer 4

如果不相“拖个尾巴”，可以将控件的代码像加一具类模块样，以“添加user control”的方式直接加到工程中。没有必要一定得先编译一个控件然后再将其添加到工程中。

Answer 5

Option ExplicitPublic Enum RasterOps    SRCCOPY = &HCC0020
    SRCAND = &H8800C6
    SRCINVERT = &H660046
    nXor = &H660046
    SRCPAINT = &HEE0086
    nOR = &HEE0086
    SRCERASE = &H4400328
    WHITENESS = &HFF0062
    BLACKNESS = &H42    NOTSRCCOPY = &H330008
    NOTSRCERASE = &H1100A6
    MERGECOPY = &HC000CA
    MERGEPAINT = &HBB0226
    DSTINVERT = &H550009    PATCOPY = &HF00021
    PATPAINT = &HFB0A09
    PATINVERT = &H5A0049
    R_WHITE = 16
End Enum
 
' BitBlt API Public Declaration
    Public Declare Function BitBlt Lib "gdi32" ( _
        ByVal hDestDC As Long, _
        ByVal X As Long, _
        ByVal Y As Long, _
        ByVal nWidth As Long, _
        ByVal nHeight As Long, _
        ByVal hSrcDC As Long, _
        ByVal xSrc As Long, _
        ByVal ySrc As Long, _
        ByVal dwRop As RasterOps _
        ) As Long
Private Sub tmrTime_Timer()
On Error Resume Next    Dim h, m, s
    Dim s1, s2, h1, h2, m1, m2
    h = Hour(Now)
    m = Minute(Now)
    s = Second(Now)
    
    h1 = Int(h / 10)
    h2 = h Mod 10
    m1 = Int(m / 10)
    m2 = m Mod 10
    s1 = Int(s / 10)
    s2 = s Mod 10
    
    frmMain.Caption = Format(Time, "hh:mm:ss")
    'Debug.Print h1, h2, m1, m2, s1, s2
    '秒
    BitBlt DestPic.hdc, 78, 0, 15, 25, NewPic.hdc, s1 * 15, 0, SRCCOPY
    BitBlt DestPic.hdc, 93, 0, 15, 25, NewPic.hdc, s2 * 15, 0, SRCCOPY
    ':
    BitBlt DestPic.hdc, 32, 0, 8, 25, NewPic.hdc, 150, 0, SRCCOPY
    '分
    BitBlt DestPic.hdc, 40, 0, 15, 25, NewPic.hdc, m1 * 15, 0, SRCCOPY
    BitBlt DestPic.hdc, 55, 0, 15, 25, NewPic.hdc, m2 * 15, 0, SRCCOPY
    '时
    BitBlt DestPic.hdc, 2, 0, 15, 25, NewPic.hdc, h1 * 15, 0, SRCCOPY
    BitBlt DestPic.hdc, 17, 0, 15, 25, NewPic.hdc, h2 * 15, 0, SRCCOPY
    ':
    BitBlt DestPic.hdc, 70, 0, 8, 25, NewPic.hdc, 150, 0, SRCCOPY
        
    'Debug.Print h1, h2, m1, m2, s1, s2
End Sub