LED数码管显示时间的OCX，需要的拿走！源码贴上！
LED控件.zip
(12.39 KB)
程序代码：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
斜字体
[此贴子已经被作者于2022-9-22 15:50编辑过]
