form1.frm

LED显示屏

SBar1.Panels(2).Text = strFilename
Open strFilename For Output As FileNum
Print #FileNum, Text1
Close FileNum
End If
End Sub

Private Sub StrSee_Click(Index As Integer)
Dim bytRst(1 To 1) As Byte
bytRst(1) = 100
Comm1.SThreshold = 0
Comm1.RThreshold = 0
'Comm1.Output = bytRst
Do While (Comm1.InBufferCount = 0)
Comm1.Output = bytRst
DoEvents
Loop
Comm1.RThreshold = 1
End Sub
Private Sub StrTrans_Click(Index As Integer)
Dim strTemp As String
tFlag1 = False
'Text1 = Text1 + Space(156) + "结束"
Call subChangetext
Call subChangeH
'Call subCountH
'Debug.Print intH
'Form2.Show
'Form2.Text1 = ""
'For I = 1 To UBound(strH)
'Form2.Text1 = Form2.Text1 + strH(I) + Chr(13) + Chr(10)
'Debug.Print strMid2(I)
'Next I
Call subGetHex
strText1 = ""
Call subChangeHex
'For I = LBound(bytHexChange) To UBound(bytHexChange)
'If bytHexChange(I) >= 160 Then
'strTemp = "0" + Hex(bytHexChange(I))
'ElseIf bytHexChange(I) >= 10 Then
'If bytHexChange(I) <= 15 Then
'strTemp = "0" + Hex(bytHexChange(I))
'Else: strTemp = Hex(bytHexChange(I))
'End If
'Else: strTemp = Hex(bytHexChange(I))
'End If
'If (I Mod 16) = 1 Then
'strText1 = strText1 + "DB " + strTemp + "H,"
'ElseIf (I Mod 16) = 0 Then
'strText1 = strText1 + strTemp + "H" + Chr(13) + Chr(10)
'Else:
'strText1 = strText1 + strTemp + "H,"
'End If
'DoEvents
'Next I
'Form2.Text1 = strText1
'strText1 = ""
'Debug.Print intPing

Dim Send1(1 To 3) As Byte, Send2() As Byte, Send3(1 To 1) As Byte
On Error Resume Next
Send1(1) = &H55
Send1(2) = intPing
If intFlag1 = 1 Then
If blnFlagm = 0 Then
Send1(3) = 2
Else
Send1(3) = 3
End If
End If
If intFlag1 = 2 Then Send1(3) = 1

Comm1.Output = Send1
'Comm1.Output = Send2
PBar1.Visible = True
PBar1.Max = intPing * 4096
PBar1.Min = 1
PBar1.Visible = True
SBar1.Panels(1).Text = "正在下载"
'Debug.Print " "
For I = 1 To intPing * 4096
DoEvents
Send3(1) = bytHexChange(I)
Comm1.Output = Send3
'Debug.Print Hex(Send3(1)) + " ";
PBar1.Value = I
SBar1.Panels(1).Text = "正在下载 " + Str(Int(PBar1.Value / PBar1.Max * 100)) + "%"
Next I
PBar1.Value = 1
PBar1.Visible = False
SBar1.Panels(1).Text = "就绪"
tFlag1 = True
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As ComctlLib.Button)
If tFlag1 Then
Select Case Button.Key
Case "ButtonOpen"
Call StrOpen_Click(0)
Case "ButtonSave"
Call StrSave_Click(0)
Case "ButtonTrans"
'Call StrTrans_Click(0)
Dim bytSendTest(1 To 2) As Byte
bytSendTest(1) = &H66
bytSendTest(2) = &H99
Comm1.Output = bytSendTest
Case "ButtonDis"
Call StrTrans_Click(0)
End Select
End If
End Sub
'去掉了不要的回车和换行的文本放在了strMid2()中
Public Sub subChangetext()
'On Error Resume Next
Dim j As Integer
'Text1 = Text1 + Chr(13) + Chr(10) + " "
intI = Len(Text1)
ReDim strMid1(1 To intI + 2)
For I = 1 To intI
strMid1(I) = Mid(Text1, I, 1)
Next I
strMid1(intI + 1) = " "
strMid1(intI + 2) = " "
'统计要去除的回车换行的个数
For I = 1 To intI
If strMid1(I) = Chr(13) Then
If I < intI - 1 Then
If strMid1(I + 2) <> " " Then j = j + 2
End If
End If
Next I
'定义strMid2()存放去掉回车换行的文本
ReDim strMid2(1 To (intI - j) + 1)
j = 1
'给strMid2()赋值
For I = 1 To intI
If (strMid1(I) <> Chr(13) And strMid1(I) <> Chr(10)) Then
strMid2(j) = strMid1(I)
j = j + 1
ElseIf (strMid1(I) = Chr(13)) Then
If strMid1(I + 2) = " " Then
strMid2(j) = strMid1(I)
j = j + 1
strMid2(j) = Chr(10)
j = j + 1
End If
End If
Next I
strMid2(UBound(strMid2)) = "完"
'strMid2(UBound(strMid2)) = Chr(10)
End Sub
'每行的8个放在了strH()中
Public Sub subChangeH()
Dim I As Integer, j As Integer, intCount As Integer
intI = 1
j = 1
intCount = 1
For I = 1 To 512
strH(I) = ""
Next I
I = 1
Do While (I < UBound(strMid2))
Do While ((intCount < 17) And (strMid2(I) <> Chr(13)) And I < UBound(strMid2))
If (Asc(strMid2(I)) < 0) Then
strH(intI) = strH(intI) + strMid2(I)
intCount = intCount + 1
ElseIf (Asc(strMid2(I + 1)) < 0) Then
strH(intI) = strH(intI) + strMid2(I)
intCount = intCount + 1
ElseIf (strMid2(I + 1) <> Chr(13)) Then
strH(intI) = strH(intI) + strMid2(I) + strMid2(I + 1)
intCount = intCount + 1
I = I + 1
Else: strH(intI) = strH(intI) + strMid2(I)
End If
I = I + 1
Loop
If (strMid2(I) = Chr(13)) Then I = I + 2
intI = intI + 1
intCount = 1
Loop

'For I = LBound(strH) To UBound(strH)
'strText1 = strText1 + strH(I) + Chr(13)  + Chr(10)
'Next I
'Form2.Text1 = strText1
'Form2.Show

If intFlag1 = 1 Then
ReDim strMid1(intI + 9)
For I = 1 To intI
strMid1(I + 5) = strH(I)
Next I
ReDim strMid2(1 To (intI + 5) * 5)
For I = 1 To intI + 5
strMid2(5 * I - 4) = strMid1(I)
strMid2(5 * I - 3) = strMid1(I + 1)
strMid2(5 * I - 2) = strMid1(I + 2)
strMid2(5 * I - 1) = strMid1(I + 3)
strMid2(5 * I) = strMid1(I + 4)
Next I
'intI = (intI + 4) * 5
intI = (intI + 5) * 5
For I = LBound(strMid2) To UBound(strMid2)
strH(I) = strMid2(I)
'Debug.Print strH(I)
Next I
End If

intI = intI - 1
ReDim strMid2(1 To ((intI - 1) \ 5 + 1) * 8)
For I = 1 To (intI - 1) \ 5 + 1
For j = 1 To 5
strMid2(8 * (I - 1) + j) = strH(5 * (I - 1) + j)
Next j
Next I

intI = UBound(strMid2)
For I = 1 To UBound(strMid2)
strH(I) = strMid2(I)
'Debug.Print strH(I)
Next I

'intI = 1
'For I = 1 To UBound(strH)
'For J = 1 To Len(strH(I)) - 1
'If Asc(Mid(strH(I), J, 1)) < 0 Then
'intI = intI + 1
'ElseIf (Asc(Mid(strH(I), J + 1, 1)) > 0) Then
'intI = intI + 1
'J = J + 1
'End If
'Next J
'intI = 1
'Next I

End Sub
Public Sub subGetHex()
Dim intQwm, intQ As Long, intW As Long, intFilenum, K As Integer, intM As Integer
'计算出汉字点阵数据位置

intFilenum = FreeFile
FileNum = FreeFile
Open strFlagZ For Binary As #intFilenum
Sum = LOF(intFilenum)
ReDim byteS(1 To Sum)
Get #intFilenum, , byteS
Close #intFilenum

Open "d:\asc16.txt" For Binary As FileNum
Sum = LOF(FileNum)
ReDim bytAsc(1 To Sum)
Get #FileNum, , bytAsc
Close FileNum


'For I = 1 To Sum
'Debug.Print bytAsc(I)
'Next I
'一共有intTh个字符要发送
intTh = UBound(strH) * 8
'intI = intI - 1
For I = 1 To 4096
For j = 1 To 32
bytHex(I, j) = 0
Next j
Next I
intM = 1
For I = 1 To intI
For j = 1 To Len(strH(I))
If (Asc(Mid(strH(I), j, 1)) < 0) Then
intQwm = Asc(Mid(strH(I), j, 1)) - &HA0A0
intQ = intQwm \ 256
intW = intQwm Mod 256
intStart = 32 * ((intQ - 1) * 94 + intW - 1)
'打印汉字的点阵
For K = 1 To 32
bytHex((I - 1) * 16 + intM, K) = byteS(intStart + K)
'Debug.Print Str(K) + ": " + Hex(bytHex((I - 1) * 8 + intM, K))
Next K
intM = intM + 1
Else
If (j < Len(strH(I))) Then
If (Asc(Mid(strH(I), j + 1, 1)) > 0) Then
For K = 1 To 16
bytHex((I - 1) * 16 + intM, 2 * K - 1) = bytAsc(Asc(Mid(strH(I), j, 1)) * 16 + K)
Next K
For K = 1 To 16
bytHex((I - 1) * 16 + intM, 2 * K) = bytAsc(Asc(Mid(strH(I), j + 1, 1)) * 16 + K)
Next K
j = j + 1
intM = intM + 1
Else
For K = 1 To 16
bytHex((I - 1) * 16 + intM, 2 * K - 1) = bytAsc(Asc(Mid(strH(I), j, 1)) * 16 + K)
Next K
intM = intM + 1
End If
Else
For K = 1 To 16
bytHex((I - 1) * 16 + intM, 2 * K - 1) = bytAsc(Asc(Mid(strH(I), j, 1)) * 16 + K)
Next K
End If
End If
Next j
intM = 1
Next I
End Sub
'对数组进行处理的子过程
Public Sub subChangeHex()
'On Error Resume Next
Dim blnBflag1 As Boolean, blnBflag2 As Boolean, blnBflag3 As Boolean, blnBflag4 As Boolean, L As Integer
Dim intNow1 As Long, blnBflag5 As Boolean, blnBflag6 As Boolean, blnBflag7 As Boolean, blnBflag8 As Boolean
Dim intNow2 As Long, lng1 As Long, lngCount1 As Long, intCount As Integer
intCount = 1
If intI Mod 8 = 0 Then
intPing = intI \ 8
Else: intPing = intI \ 8 + 1
End If
lng1 = intPing * 1024 * 4
SBar1.Panels(1).Text = "正在处理"
With PBar1
.Max = lng1
.Min = 1
.Value = 1
.Visible = True
End With
ReDim bytHexChange(1 To lng1)
For I = LBound(bytHexChange) To UBound(bytHexChange)
bytHexChange(I) = 0
Next I
For I = 1 To intPing
For K = 1 To 32
For j = 1 To 16
For L = 1 To 8
lngCount1 = lngCount1 + 1
intNow1 = ((I - 1) * 4096 + (j - 1) * 16 + 256 * ((K - 1) \ 2) + 8 * ((K + 1) Mod 2) + L)
'Debug.Print intNow1;
intNow2 = (I - 1) * 128 + j
blnBflag1 = bytHex(intNow2, K) And 2 ^ (8 - L)
blnBflag2 = bytHex(intNow2 + 16, K) And 2 ^ (8 - L)
blnBflag3 = bytHex(intNow2 + 32, K) And 2 ^ (8 - L)
blnBflag4 = bytHex(intNow2 + 48, K) And 2 ^ (8 - L)
blnBflag5 = bytHex(intNow2 + 64, K) And 2 ^ (8 - L)
blnBflag6 = bytHex(intNow2 + 80, K) And 2 ^ (8 - L)
blnBflag7 = bytHex(intNow2 + 96, K) And 2 ^ (8 - L)
blnBflag8 = bytHex(intNow2 + 112, K) And 2 ^ (8 - L)
If blnBflag1 Then _
bytHexChange(intNow1) = _
bytHexChange(intNow1) + 1
If blnBflag2 Then _
bytHexChange(intNow1) = _
bytHexChange(intNow1) + 2
If blnBflag3 Then _
bytHexChange(intNow1) = _
bytHexChange(intNow1) + 4
If blnBflag4 Then _
bytHexChange(intNow1) = _
bytHexChange(intNow1) + 8
If blnBflag5 Then _
bytHexChange(intNow1) = _
bytHexChange(intNow1) + 16
If blnBflag6 Then _
bytHexChange(intNow1) = _
bytHexChange(intNow1) + 32
If blnBflag7 Then _
bytHexChange(intNow1) = _
bytHexChange(intNow1) + 64
If blnBflag8 Then _
bytHexChange(intNow1) = _
bytHexChange(intNow1) + 128
DoEvents
PBar1.Value = lngCount1
Next L
Next j
Next K
Next I
'Call subPrintdata
End Sub
Public Sub subPrintdata()
intCount = 1
Dim bytTemp As Byte
For I = 1 To intPing * 4096
bytTemp = bytHexChange(I) Xor 255
If intCount = 128 Then
If bytTemp >= 160 Then
Debug.Print "0" + Hex(bytTemp) + "H"
Else
Debug.Print Hex(bytTemp) + "H"
End If
intCount = 0
ElseIf intCount = 1 Then
If bytTemp >= 160 Then
Debug.Print "DB 0" + Hex(bytTemp) + "H,";
Else
Debug.Print "DB " + Hex(bytTemp) + "H,";
End If
Else
If bytTemp >= 160 Then
Debug.Print "0" + Hex(bytTemp) + "H,";
Else
Debug.Print Hex(bytTemp) + "H,";
End If
End If
intCount = intCount + 1
Next I
'Debug.Print UBound(bytHexChange)
End Sub