LED数码管显示时间的OCX，需要的拿走！源码贴上！

Private Type POINTAPI
x As Long
y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function FillRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long) As Long
Private Declare Function PtInRegion Lib "gdi32" (ByVal hRgn As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Const ALTERNATE = 1
Const WINDING = 2

Dim hRgn As Long
Dim LEDCaption As String


Private Sub Timer1_Timer()
Dim a As String
Dim i As Integer
Dim x As Single
Dim y As Single
Dim v As Single
Dim z As Single
Dim k As Integer
Dim j As Integer
Dim l As Single
a = Time
For j = 1 To Len(a)
    If Mid(LTrim(a), j, 1) = ":" Then
        k = k + 1
    End If
Next j
Picture1.Refresh
l = 50
z = 130
v = Picture1.Height / 240
x = Picture1.Width / v - (Len(a) - k) * z - k * l
y = 15
For i = 1 To Len(a)
    NumuberLED x, y, v / 15, Mid(LTrim(a), i, 1)
    If Mid(LTrim(a), i, 1) = ":" Then
        x = x + l
    Else
        x = x + z
    End If
Next i
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
On Error Resume Next
BackColor = PropBag.ReadProperty("BackColor", Picture1.BackColor)
FillColor = PropBag.ReadProperty("FillColor", Picture1.FillColor)
ForeColor = PropBag.ReadProperty("ForeColor", Picture1.ForeColor)
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("BackColor", Picture1.BackColor)
Call PropBag.WriteProperty("FillColor", Picture1.FillColor)
Call PropBag.WriteProperty("ForeColor", Picture1.ForeColor)
End Sub


Public Property Get BackColor() As OLE_COLOR
BackColor = Picture1.BackColor
End Property
Public Property Let BackColor(ByVal newBackColor As OLE_COLOR)
Picture1.BackColor = newBackColor
PropertyChanged "BackColor"
End Property
Public Property Get FillColor() As OLE_COLOR
FillColor = Picture1.FillColor
End Property
Public Property Let FillColor(ByVal newFillColor As OLE_COLOR)
Picture1.FillColor = newFillColor
PropertyChanged "FillColor"
End Property

Public Property Get ForeColor() As OLE_COLOR
ForeColor = Picture1.ForeColor
End Property
Public Property Let ForeColor(ByVal newForeColor As OLE_COLOR)
Picture1.ForeColor = newForeColor
PropertyChanged "ForeColor"
End Property



Sub NumuberLED(Topx As Single, Topy As Single, Bili As Single, Numuber As String)
        Select Case Numuber
            Case "0"
                LED1 Topx, Topy, Bili
                LED2 Topx, Topy, Bili
                LED6 Topx, Topy, Bili
'                LED7 Topx, Topy, Bili
                LED5 Topx, Topy, Bili
                LED3 Topx, Topy, Bili
                LED4 Topx, Topy, Bili
            Case "1"
                'LED1 Topx, Topy, Bili
                LED2 Topx, Topy, Bili
'                LED6 Topx, Topy, Bili
                'LED7 Topx, Topy, Bili
                'LED5 Topx, Topy, Bili
                LED3 Topx, Topy, Bili
                'LED4 Topx, Topy, Bili
            Case "2"
                LED1 Topx, Topy, Bili
                LED2 Topx, Topy, Bili
                'LED6 Topx, Topy, Bili
               LED7 Topx, Topy, Bili
                LED5 Topx, Topy, Bili
                'LED3 Topx, Topy, Bili
                LED4 Topx, Topy, Bili
            Case "3"
                LED1 Topx, Topy, Bili
                LED2 Topx, Topy, Bili
'                LED6 Topx, Topy, Bili
                LED7 Topx, Topy, Bili
                'LED5 Topx, Topy, Bili
                LED3 Topx, Topy, Bili
                LED4 Topx, Topy, Bili
            Case "4"
                'LED1 Topx, Topy, Bili
               LED2 Topx, Topy, Bili
               LED6 Topx, Topy, Bili
                LED7 Topx, Topy, Bili
'                LED5 Topx, Topy, Bili
                LED3 Topx, Topy, Bili
'                LED4 Topx, Topy, Bili
            Case "5"
                LED1 Topx, Topy, Bili
                'LED2 Topx, Topy, Bili
                LED6 Topx, Topy, Bili
                LED7 Topx, Topy, Bili
                'LED5 Topx, Topy, Bili
                LED3 Topx, Topy, Bili
                LED4 Topx, Topy, Bili
            Case "6"
                LED1 Topx, Topy, Bili
                'LED2 Topx, Topy, Bili
               LED6 Topx, Topy, Bili
                LED7 Topx, Topy, Bili
                LED5 Topx, Topy, Bili
                LED3 Topx, Topy, Bili
                LED4 Topx, Topy, Bili
            Case "7"
               LED1 Topx, Topy, Bili
                LED2 Topx, Topy, Bili
'               LED6 Topx, Topy, Bili
                'LED7 Topx, Topy, Bili
                'LED5 Topx, Topy, Bili
                LED3 Topx, Topy, Bili
                'LED4 Topx, Topy, Bili
            Case "8"
               LED1 Topx, Topy, Bili
                LED2 Topx, Topy, Bili
                LED6 Topx, Topy, Bili
                LED7 Topx, Topy, Bili
                LED5 Topx, Topy, Bili
                LED3 Topx, Topy, Bili
               LED4 Topx, Topy, Bili
            Case "9"
               LED1 Topx, Topy, Bili
               LED2 Topx, Topy, Bili
                LED6 Topx, Topy, Bili
                LED7 Topx, Topy, Bili
                'LED5 Topx, Topy, Bili
                LED3 Topx, Topy, Bili
                LED4 Topx, Topy, Bili
            Case "."

                LED8 Topx, Topy, Bili
               
            Case ":"

                LED9 Topx, Topy, Bili
            Case Else
                'LED1 Topx, Topy, Bili
                LED2 Topx, Topy, Bili
                LED3 Topx, Topy, Bili
                'LED4 Topx, Topy, Bili
                LED5 Topx, Topy, Bili
               LED6 Topx, Topy, Bili
               LED7 Topx, Topy, Bili

        End Select


    End Sub
Sub LED1(m As Single, n As Single, p As Single)

Dim xxx(5) As POINTAPI
Dim lB As Long
xxx(0).x = (13 + m + 20) * p: xxx(0).y = (10 + n + 20) * p
xxx(1).x = (23 + m + 20) * p: xxx(1).y = (0 + n + 20) * p
xxx(2).x = (77 + m + 20) * p: xxx(2).y = (0 + n + 20) * p
xxx(3).x = (87 + m + 20) * p: xxx(3).y = (10 + n + 20) * p
xxx(4).x = (77 + m + 20) * p: xxx(4).y = (20 + n + 20) * p
xxx(5).x = (23 + m + 20) * p: xxx(5).y = (20 + n + 20) * p
hRgn = CreatePolygonRgn(xxx(0), 6, ALTERNATE)
If hRgn <> 0 Then
       lB = CreateSolidBrush(Picture1.ForeColor)
       Debug.Print FillRgn(Picture1.hdc, hRgn, lB)
End If
DeleteObject hRgn
DeleteObject lB
Dim xx(5) As POINTAPI
xx(0).x = (13 + m) * p: xx(0).y = (10 + n) * p
xx(1).x = (23 + m) * p: xx(1).y = (0 + n) * p
xx(2).x = (77 + m) * p: xx(2).y = (0 + n) * p
xx(3).x = (87 + m) * p: xx(3).y = (10 + n) * p
xx(4).x = (77 + m) * p: xx(4).y = (20 + n) * p
xx(5).x = (23 + m) * p: xx(5).y = (20 + n) * p
hRgn = CreatePolygonRgn(xx(0), 6, ALTERNATE)
If hRgn <> 0 Then
    lB = CreateSolidBrush(Picture1.FillColor)
       Debug.Print FillRgn(Picture1.hdc, hRgn, lB)
End If
DeleteObject hRgn
DeleteObject lB
End Sub
Sub LED2(m As Single, n As Single, p As Single)
Dim xxx(5) As POINTAPI
Dim lB As Long
xxx(0).x = (90 + m + 20) * p: xxx(0).y = (13 + n + 20) * p
xxx(1).x = (100 + m + 20) * p: xxx(1).y = (23 + n + 20) * p
xxx(2).x = (100 + m + 20) * p: xxx(2).y = (87 + n + 20) * p
xxx(3).x = (90 + m + 20) * p: xxx(3).y = (97 + n + 20) * p
xxx(4).x = (80 + m + 20) * p: xxx(4).y = (87 + n + 20) * p
xxx(5).x = (80 + m + 20) * p: xxx(5).y = (23 + n + 20) * p

hRgn = CreatePolygonRgn(xxx(0), 6, ALTERNATE)
If hRgn <> 0 Then
       lB = CreateSolidBrush(Picture1.ForeColor)
       Debug.Print FillRgn(Picture1.hdc, hRgn, lB)
End If
DeleteObject hRgn
DeleteObject lB

Dim xx(5) As POINTAPI
xx(0).x = (90 + m) * p: xx(0).y = (13 + n) * p
xx(1).x = (100 + m) * p: xx(1).y = (23 + n) * p
xx(2).x = (100 + m) * p: xx(2).y = (87 + n) * p
xx(3).x = (90 + m) * p: xx(3).y = (97 + n) * p
xx(4).x = (80 + m) * p: xx(4).y = (87 + n) * p
xx(5).x = (80 + m) * p: xx(5).y = (23 + n) * p

hRgn = CreatePolygonRgn(xx(0), 6, ALTERNATE)
If hRgn <> 0 Then
    lB = CreateSolidBrush(Picture1.FillColor)
       Debug.Print FillRgn(Picture1.hdc, hRgn, lB)
End If
DeleteObject hRgn
DeleteObject lB
End Sub
Sub LED3(m As Single, n As Single, p As Single)
Dim xxx(5) As POINTAPI
Dim lB As Long
xxx(0).x = (90 + m + 20) * p: xxx(0).y = (103 + n + 20) * p
xxx(1).x = (100 + m + 20) * p: xxx(1).y = (113 + n + 20) * p
xxx(2).x = (100 + m + 20) * p: xxx(2).y = (177 + n + 20) * p
xxx(3).x = (90 + m + 20) * p: xxx(3).y = (187 + n + 20) * p
xxx(4).x = (80 + m + 20) * p: xxx(4).y = (177 + n + 20) * p
xxx(5).x = (80 + m + 20) * p: xxx(5).y = (113 + n + 20) * p

hRgn = CreatePolygonRgn(xxx(0), 6, ALTERNATE)
If hRgn <> 0 Then
   lB = CreateSolidBrush(Picture1.ForeColor)

   Debug.Print FillRgn(Picture1.hdc, hRgn, lB)
End If
DeleteObject hRgn
DeleteObject lB

Dim xx(5) As POINTAPI
xx(0).x = (90 + m) * p: xx(0).y = (103 + n) * p
xx(1).x = (100 + m) * p: xx(1).y = (113 + n) * p
xx(2).x = (100 + m) * p: xx(2).y = (177 + n) * p
xx(3).x = (90 + m) * p: xx(3).y = (187 + n) * p
xx(4).x = (80 + m) * p: xx(4).y = (177 + n) * p
xx(5).x = (80 + m) * p: xx(5).y = (113 + n) * p

hRgn = CreatePolygonRgn(xx(0), 6, ALTERNATE)
If hRgn <> 0 Then
lB = CreateSolidBrush(Picture1.FillColor)

   Debug.Print FillRgn(Picture1.hdc, hRgn, lB)
End If
DeleteObject hRgn
DeleteObject lB
End Sub
Sub LED4(m As Single, n As Single, p As Single)
Dim xxx(5) As POINTAPI
Dim lB As Long
xxx(0).x = (13 + m + 20) * p: xxx(0).y = (190 + n + 20) * p
xxx(1).x = (23 + m + 20) * p: xxx(1).y = (180 + n + 20) * p
xxx(2).x = (77 + m + 20) * p: xxx(2).y = (180 + n + 20) * p
xxx(3).x = (87 + m + 20) * p: xxx(3).y = (190 + n + 20) * p
xxx(4).x = (77 + m + 20) * p: xxx(4).y = (200 + n + 20) * p
xxx(5).x = (23 + m + 20) * p: xxx(5).y = (200 + n + 20) * p

hRgn = CreatePolygonRgn(xxx(0), 6, ALTERNATE)
If hRgn <> 0 Then
   lB = CreateSolidBrush(Picture1.ForeColor)

   Debug.Print FillRgn(Picture1.hdc, hRgn, lB)
End If
DeleteObject hRgn
DeleteObject lB

Dim xx(5) As POINTAPI
xx(0).x = (13 + m) * p: xx(0).y = (190 + n) * p
xx(1).x = (23 + m) * p: xx(1).y = (180 + n) * p
xx(2).x = (77 + m) * p: xx(2).y = (180 + n) * p
xx(3).x = (87 + m) * p: xx(3).y = (190 + n) * p
xx(4).x = (77 + m) * p: xx(4).y = (200 + n) * p
xx(5).x = (23 + m) * p: xx(5).y = (200 + n) * p

hRgn = CreatePolygonRgn(xx(0), 6, ALTERNATE)
If hRgn <> 0 Then
lB = CreateSolidBrush(Picture1.FillColor)

   Debug.Print FillRgn(Picture1.hdc, hRgn, lB)
End If
DeleteObject hRgn
DeleteObject lB
End Sub
Sub LED5(m As Single, n As Single, p As Single)
Dim xxx(5) As POINTAPI
Dim lB As Long
xxx(0).x = (10 + m + 20) * p: xxx(0).y = (103 + n + 20) * p
xxx(1).x = (20 + m + 20) * p: xxx(1).y = (113 + n + 20) * p
xxx(2).x = (20 + m + 20) * p: xxx(2).y = (177 + n + 20) * p
xxx(3).x = (10 + m + 20) * p: xxx(3).y = (187 + n + 20) * p
xxx(4).x = (0 + m + 20) * p: xxx(4).y = (177 + n + 20) * p
xxx(5).x = (0 + m + 20) * p: xxx(5).y = (113 + n + 20) * p

hRgn = CreatePolygonRgn(xxx(0), 6, ALTERNATE)
If hRgn <> 0 Then
   lB = CreateSolidBrush(Picture1.ForeColor)

   Debug.Print FillRgn(Picture1.hdc, hRgn, lB)
End If
DeleteObject hRgn
DeleteObject lB

Dim xx(5) As POINTAPI

xx(0).x = (10 + m) * p: xx(0).y = (103 + n) * p
xx(1).x = (20 + m) * p: xx(1).y = (113 + n) * p
xx(2).x = (20 + m) * p: xx(2).y = (177 + n) * p
xx(3).x = (10 + m) * p: xx(3).y = (187 + n) * p
xx(4).x = (0 + m) * p: xx(4).y = (177 + n) * p
xx(5).x = (0 + m) * p: xx(5).y = (113 + n) * p

hRgn = CreatePolygonRgn(xx(0), 6, ALTERNATE)
If hRgn <> 0 Then
lB = CreateSolidBrush(Picture1.FillColor)

   Debug.Print FillRgn(Picture1.hdc, hRgn, lB)
End If
DeleteObject hRgn
DeleteObject lB
End Sub
Sub LED6(m As Single, n As Single, p As Single)
Dim xxx(5) As POINTAPI
Dim lB As Long
xxx(0).x = (10 + m + 20) * p: xxx(0).y = (13 + n + 20) * p
xxx(1).x = (20 + m + 20) * p: xxx(1).y = (23 + n + 20) * p
xxx(2).x = (20 + m + 20) * p: xxx(2).y = (87 + n + 20) * p
xxx(3).x = (10 + m + 20) * p: xxx(3).y = (97 + n + 20) * p
xxx(4).x = (0 + m + 20) * p: xxx(4).y = (87 + n + 20) * p
xxx(5).x = (0 + m + 20) * p: xxx(5).y = (23 + n + 20) * p

hRgn = CreatePolygonRgn(xxx(0), 6, ALTERNATE)
If hRgn <> 0 Then
   lB = CreateSolidBrush(Picture1.ForeColor)

   Debug.Print FillRgn(Picture1.hdc, hRgn, lB)
End If
DeleteObject hRgn
DeleteObject lB

Dim xx(5) As POINTAPI

xx(0).x = (10 + m) * p: xx(0).y = (13 + n) * p
xx(1).x = (20 + m) * p: xx(1).y = (23 + n) * p
xx(2).x = (20 + m) * p: xx(2).y = (87 + n) * p
xx(3).x = (10 + m) * p: xx(3).y = (97 + n) * p
xx(4).x = (0 + m) * p: xx(4).y = (87 + n) * p
xx(5).x = (0 + m) * p: xx(5).y = (23 + n) * p

hRgn = CreatePolygonRgn(xx(0), 6, ALTERNATE)
If hRgn <> 0 Then
lB = CreateSolidBrush(Picture1.FillColor)

   Debug.Print FillRgn(Picture1.hdc, hRgn, lB)
End If
DeleteObject hRgn
DeleteObject lB
End Sub
Sub LED7(m As Single, n As Single, p As Single)
Dim xxx(5) As POINTAPI
Dim lB As Long
xxx(0).x = (13 + m + 20) * p: xxx(0).y = (100 + n + 20) * p
xxx(1).x = (23 + m + 20) * p: xxx(1).y = (90 + n + 20) * p
xxx(2).x = (77 + m + 20) * p: xxx(2).y = (90 + n + 20) * p
xxx(3).x = (87 + m + 20) * p: xxx(3).y = (100 + n + 20) * p
xxx(4).x = (77 + m + 20) * p: xxx(4).y = (110 + n + 20) * p
xxx(5).x = (23 + m + 20) * p: xxx(5).y = (110 + n + 20) * p

hRgn = CreatePolygonRgn(xxx(0), 6, ALTERNATE)
If hRgn <> 0 Then
   lB = CreateSolidBrush(Picture1.ForeColor)

   Debug.Print FillRgn(Picture1.hdc, hRgn, lB)
End If
DeleteObject hRgn
DeleteObject lB

Dim xx(5) As POINTAPI

xx(0).x = (13 + m) * p: xx(0).y = (100 + n) * p
xx(1).x = (23 + m) * p: xx(1).y = (90 + n) * p
xx(2).x = (77 + m) * p: xx(2).y = (90 + n) * p
xx(3).x = (87 + m) * p: xx(3).y = (100 + n) * p
xx(4).x = (77 + m) * p: xx(4).y = (110 + n) * p
xx(5).x = (23 + m) * p: xx(5).y = (110 + n) * p

hRgn = CreatePolygonRgn(xx(0), 6, ALTERNATE)
If hRgn <> 0 Then
lB = CreateSolidBrush(Picture1.FillColor)

   Debug.Print FillRgn(Picture1.hdc, hRgn, lB)
End If
DeleteObject hRgn
DeleteObject lB
End Sub
Sub LED8(m As Single, n As Single, p As Single)
Dim xxx(3) As POINTAPI
Dim lB As Long
xxx(0).x = (0 + m + 20) * p: xxx(0).y = (180 + n + 20) * p
xxx(1).x = (20 + m + 20) * p: xxx(1).y = (180 + n + 20) * p
xxx(2).x = (20 + m + 20) * p: xxx(2).y = (200 + n + 20) * p
xxx(3).x = (0 + m + 20) * p: xxx(3).y = (200 + n + 20) * p

hRgn = CreatePolygonRgn(xxx(0), 4, ALTERNATE)
If hRgn <> 0 Then
   lB = CreateSolidBrush(Picture1.ForeColor)

   Debug.Print FillRgn(Picture1.hdc, hRgn, lB)
End If
DeleteObject hRgn
DeleteObject lB

Dim xx(3) As POINTAPI

xx(0).x = (0 + m) * p: xx(0).y = (180 + n) * p
xx(1).x = (20 + m) * p: xx(1).y = (180 + n) * p
xx(2).x = (20 + m) * p: xx(2).y = (200 + n) * p
xx(3).x = (0 + m) * p: xx(3).y = (200 + n) * p

hRgn = CreatePolygonRgn(xx(0), 4, ALTERNATE)
If hRgn <> 0 Then
lB = CreateSolidBrush(Picture1.FillColor)

   Debug.Print FillRgn(Picture1.hdc, hRgn, lB)
End If
DeleteObject hRgn
DeleteObject lB
End Sub

Sub LED9(m As Single, n As Single, p As Single)
Dim xxx(3) As POINTAPI
Dim lB As Long
xxx(0).x = (0 + m + 20) * p: xxx(0).y = (160 + n + 20) * p
xxx(1).x = (20 + m + 20) * p: xxx(1).y = (160 + n + 20) * p
xxx(2).x = (20 + m + 20) * p: xxx(2).y = (180 + n + 20) * p
xxx(3).x = (0 + m + 20) * p: xxx(3).y = (180 + n + 20) * p

hRgn = CreatePolygonRgn(xxx(0), 4, ALTERNATE)
If hRgn <> 0 Then
   lB = CreateSolidBrush(Picture1.ForeColor)

   Debug.Print FillRgn(Picture1.hdc, hRgn, lB)
End If
DeleteObject hRgn
DeleteObject lB

Dim xx(3) As POINTAPI
xx(0).x = (0 + m) * p: xx(0).y = (160 + n) * p
xx(1).x = (20 + m) * p: xx(1).y = (160 + n) * p
xx(2).x = (20 + m) * p: xx(2).y = (180 + n) * p
xx(3).x = (0 + m) * p: xx(3).y = (180 + n) * p

hRgn = CreatePolygonRgn(xx(0), 4, ALTERNATE)
If hRgn <> 0 Then
lB = CreateSolidBrush(Picture1.FillColor)

   Debug.Print FillRgn(Picture1.hdc, hRgn, lB)
End If
DeleteObject hRgn
DeleteObject lB

Dim xxxx(3) As POINTAPI
xxxx(0).x = (0 + m + 20) * p: xxxx(0).y = (80 + n + 20) * p
xxxx(1).x = (20 + m + 20) * p: xxxx(1).y = (80 + n + 20) * p
xxxx(2).x = (20 + m + 20) * p: xxxx(2).y = (100 + n + 20) * p
xxxx(3).x = (0 + m + 20) * p: xxxx(3).y = (100 + n + 20) * p

hRgn = CreatePolygonRgn(xxxx(0), 4, ALTERNATE)
If hRgn <> 0 Then
   lB = CreateSolidBrush(Picture1.ForeColor)

   Debug.Print FillRgn(Picture1.hdc, hRgn, lB)
End If
DeleteObject hRgn
DeleteObject lB

Dim xxxxx(3) As POINTAPI
xxxxx(0).x = (0 + m) * p: xxxxx(0).y = (80 + n) * p
xxxxx(1).x = (20 + m) * p: xxxxx(1).y = (80 + n) * p
xxxxx(2).x = (20 + m) * p: xxxxx(2).y = (100 + n) * p
xxxxx(3).x = (0 + m) * p: xxxxx(3).y = (100 + n) * p

hRgn = CreatePolygonRgn(xxxxx(0), 4, ALTERNATE)
If hRgn <> 0 Then
lB = CreateSolidBrush(Picture1.FillColor)

   Debug.Print FillRgn(Picture1.hdc, hRgn, lB)
End If
DeleteObject hRgn
DeleteObject lB
End Sub

Private Sub UserControl_Initialize()
Picture1.Top = 0
Picture1.Left = 0
Picture1.Height = UserControl.Height
Picture1.Width = UserControl.Width


End Sub

Private Sub UserControl_Resize()
Picture1.Top = 0
Picture1.Left = 0
Picture1.Height = UserControl.Height
Picture1.Width = UserControl.Width

End Sub