本帖最后由 sunruiyeyipeng 于 2011-3-13 20:32 编辑
这个VB程序（）用来生成【共阴/共阳】数码管的字型码。代码如下：
希望高手能看懂，说不定，优化这个代码。
Function creatcode()
'Creat Mask Code By
Dim codes As String
codes = getio(Ldp) & getio(Lg) & getio(Lf) & getio(Le) & getio(Ld) & getio(Lc) & getio(Lb) & getio(La)
Call bintohex(codes)
End Function
Function getio(objt As Object)
If objt.BackColor = vbWhite Then
getio = "0"
Else
getio = "1"
End If
End Function
Function bintohex(ByVal str As String)
Dim i As Integer
Dim b, c As Long
'MsgBox str
For i = 1 To 4
b = b + Val(Mid(str, i, 1)) * 2 ^ (4 - i)
Next i
For i = 5 To 8
c = c + Val(Mid(str, i, 1)) * 2 ^ (8 - i)
Next i
'MsgBox "b=" & b & " c=" & c
Text1 = "0x" & hexs(b) & hexs(c)
End Function
Function hexs(ByVal s As Variant)
Select Case Val(s)
Case 0 To 9
hexs = s
Case 10
hexs = "a"
Case 11
hexs = "b"
Case 12
hexs = "c"
Case 13
hexs = "d"
Case 14
hexs = "e"
Case 15
hexs = "f"
End Select
End Function
Private Sub Command1_Click()
End
End Sub
Private Sub Command2_Click()
La.BackColor = vbWhite
Lb.BackColor = vbWhite
Lc.BackColor = vbWhite
Ld.BackColor = vbWhite
Le.BackColor = vbWhite
Lf.BackColor = vbWhite
Lg.BackColor = vbWhite
Ldp.BackColor = vbWhite
Text1.Text = ""
End Sub
Private Sub La_Click()
If La.BackColor = vbWhite Then
La.BackColor = vbRed
Else
La.BackColor = vbWhite
End If
Call creatcode
End Sub
Private Sub Lb_Click()
If Lb.BackColor = vbWhite Then
Lb.BackColor = vbRed
Else
Lb.BackColor = vbWhite
End If
Call creatcode
End Sub
Private Sub Lc_Click()
If Lc.BackColor = vbWhite Then
Lc.BackColor = vbRed
Else
Lc.BackColor = vbWhite
End If
Call creatcode
End Sub
Private Sub Ld_Click()
If Ld.BackColor = vbWhite Then
Ld.BackColor = vbRed
Else
Ld.BackColor = vbWhite
End If
Call creatcode
End Sub
Private Sub Ldp_Click()
If Ldp.BackColor = vbWhite Then
Ldp.BackColor = vbRed
Else
Ldp.BackColor = vbWhite
End If
Call creatcode
End Sub
Private Sub Le_Click()
If Le.BackColor = vbWhite Then
Le.BackColor = vbRed
Else
Le.BackColor = vbWhite
End If
Call creatcode
End Sub
Private Sub Lf_Click()
If Lf.BackColor = vbWhite Then
Lf.BackColor = vbRed
Else
Lf.BackColor = vbWhite
End If
Call creatcode
End Sub
Private Sub Lg_Click()
If Lg.BackColor = vbWhite Then
Lg.BackColor = vbRed
Else
Lg.BackColor = vbWhite
End If
Call creatcode
End Sub |
本帖子中包含更多资源
您需要 登录 才可以下载或查看，没有账号？注册
×
|
楼主
