1602点阵取模工具代码

【原创】1602点阵取模工具代码

VB code

Private Sub Command1_Click()For i = 0 To 39Label1(i).BackColor = vbWhiteNext iText1.Text = ""End SubPrivate Sub Label1_Click(Index As Integer)If Label1(Index).BackColor = vbRed Then    Label1(Index).BackColor = vbWhiteElse    Label1(Index).BackColor = vbRedEnd IfCall CreatCodeEnd SubFunction CreatCode()Dim strs, tmp As StringDim i As IntegerFor i = 1 To 8    tmp = "000"    For j = 0 To 4        If Label1(j + 5 * (i - 1)).BackColor = vbRed Then            tmp = tmp & "1"        Else            tmp = tmp & "0"        End If    Next j    If i < 8 Then    strs = strs & bintohex(tmp) & ","    Else    strs = strs & bintohex(tmp)    End IfNext iText1.Text = strsEnd FunctionFunction 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 SelectEnd FunctionFunction 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    bintohex = "0x" & hexs(b) & hexs(c)End Function

[解决办法]
程序看上去效率很低哟，既然你搞1602这种东西，相信下位机的程序你也搞过呀，
下位机在处理这种事情的时候不就是靠位移来处理的吗，怎么到了VB你用这么低效
的方法处理这种过程呢？
比如二进制运算和16进制转换可以这样做：

VB code

...strs = ""For i = 0 To 7    byTemp = 0                ' 初始化为零，也可以认为他是 00000000b    For j = 0 To 7        byTemp = byTemp * 2   ' 这样的结果就是 byTemp = byTemp << 1; 的效果呀        If Label1((j * 8) + i).BackColor = vbRed Then   ' 这里就是判断 bit 位是否为 1            byTemp = byTemp Xor 1                       ' 如果为1才需要将最后一位这么进行异或        End If    Next    strs = strs & ",0x" & Right("0" & Hex(byTemp), 2)  ' 这里是吧计算好的字节取 16 进制字符Next i...
[解决办法]
好羡慕你们啊！会用If Then和Select Case写程序！我就不怎么会用……不过也写出来了

VB code
Option ExplicitPrivate Sub Command1_Click()  Dim tIndex As Long  For tIndex = 0 To 39    Picture1(tIndex).BackColor = vbWhite  Next tIndex  Text1.Text = ""End SubPrivate Sub Picture1_Click(Index As Integer)  With Picture1(Index)    .BackColor = (.BackColor = vbRed) And vbWhite Or (Not .BackColor = vbRed) And vbRed  End With  CreatCodeEnd SubSub CreatCode()  Dim tBytes_Index As Long, tBytes() As Byte  Dim tLine_Index As Long, tPix_Index As Long, tHexL As Byte  tBytes() = "0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00"  For tBytes_Index = 0 To 79 Step 10    tLine_Index = tBytes_Index \ 10: tHexL = 0    For tPix_Index = 0 To 3      tHexL = tHexL Or ((Picture1(tLine_Index * 5 + tPix_Index + 1).BackColor = vbRed) And 2 ^ (3 - tPix_Index))    Next    tBytes(tBytes_Index + 4) = HexEnCode((Picture1(tLine_Index * 5).BackColor = vbRed) And 1)    tBytes(tBytes_Index + 6) = HexEnCode(tHexL)  Next    Text1.Text = tBytes()End SubFunction HexEnCode(pHEX As Byte) As Byte  HexEnCode = 48 + pHEX + ((pHEX > 9) And 7)End Function 

 

查看更多 下一篇