form1.frm

vb 上位机更改点阵显示的数据

Dim State As String
'Form2.Visible = True
State = MsgBox("真的要退出程序吗？", vbOKCancel + 32, "信息") '弹出信息框
Select Case State
Case vbOK '确定

End '关闭系统
Case vbCancel '取消
Cancel = -1
Unload Form2
End Select
End Sub

Private Sub Command4_Click() '打开
CDialog1.ShowOpen '打开
Dim strfilename
Dim FileNum, strT1 As String, strT2 As String
'f1 = App.Path & "\"
strfilename = CDialog1.FileName '获取要打开的文件的文件名
'If strfilename <> "" Then Text1 = ""
FileNum = FreeFile '获取文件号
Open strfilename For Input As FileNum '打开文本文件
Do While Not EOF(FileNum) '不是文件的结尾继续读,直到读完整个文本的所有字.
Line Input #FileNum, strT1
strT2 = strT2 + strT1 + Chr(13) + Chr(10) '逐字写入数组.
Loop
Close FileNum '关闭文件
Text1 = strT2 '把文件的内容写入文本框中.




On Error Resume Next '出错控制.
'CDialog1.ShowOpen
End Sub

Private Sub Command5_Click() '另存
On Error Resume Next
CDialog1.ShowSave
End Sub


Private Sub Command6_Click()
Text1.Text = "天祥电子www.txmcu.com"
End Sub

Private Sub Form_Load()
'Dim mypath1
MSComm1.CommPort = 1                   '设置串口4
MSComm1.Settings = "19200,N,8,1" '波特率9600bit/s，无校验，8位数据，1位停止位

MSComm1.OutBufferSize = 1024 '发送缓冲区大小
'MSComm1.PortOpen = True
'*******************************************

Text1.Text = "李健毕业设计"
'*****************标题控制区*****************
Form1.Caption = App.Path '窗体标题改为程序文件所在的路径
'********************************************
Call hzLenandstore
Label3.Caption = n

'**************************************
mypath1 = App.Path & "\" '获取文件所在目录
zitipath = mypath1 & "hzk16" '获取字库所在地址
'************************************************
'Combo1.AddItem "Com0"
Combo1.AddItem "COM1" '加载combo
Combo1.AddItem "COM2"
Combo1.AddItem "COM3"
Combo1.AddItem "COM4"
Combo2.AddItem "宋体"
Combo2.AddItem "仿宋"
Combo2.AddItem "楷体"
Combo2.AddItem "黑体"
End Sub





Private Sub MSComm1_OnComm() '中断事件
'Select Case MSComm1.CommEvent '检验串口事件
'错误处理


'Case comEvReceive  '在发生接受到数据事件时执行以下命令:
'MSComm1.RThreshold = 0 '不准后续接受字节引起中断事件

'…… '可以根据具体的问题，在此处添加相应的处理程序
'End Select


'在通讯过程中所发生的通讯错误是CommEvent属性返回的。
'当CommEvent属性值发生改变时，表明有通讯错误，就会产生OnComm事件。
'可以利用自动引发OnComm事件的特点在接收过程中加入状态显示码。
'这样可以监视通讯线路状态，得到单片机和主机及单片机和单片机之间的通讯进程。
On Error Resume Next

End Sub
Public Sub hzLenandstore() '将要发送的汉字存入数组中,去除空格,和西文字符
n = 0
Dim L As Integer, i As Integer, j As Integer
L = Len(Text1.Text) '获取文本框中字的字数,此字数不仅包括汉字还包含西文字符,和空格.
For i = 1 To L
If Asc(Mid(Text1.Text, i, 1)) < 0 Then '由于中文的最高位为1,ascii码小于零.
n = n + 1 '得到中文字的字数
End If
Next i
ReDim hzstr1(1 To n) '重新定义存储汉字的数组长度.
j = 1
For i = 1 To L
If Asc(Mid(Text1.Text, i, 1)) < 0 Then
hzstr1(j) = Mid(Text1.Text, i, 1) '把汉字存入数组中.
j = j + 1 'ascii
End If
Next i
End Sub
'功能打开字库文件,并从字库中把输入的各个汉字的横排点阵代码取出来
Public Sub Subchange1()
Dim hzk166() As Byte '定义存放汉字库的数组
Dim qwm '存储区位码
Dim qm '区码
Dim wm '位码
Dim i As Integer, j As Integer
'Dim k As Integer
'Dim bytethz As Byte
Dim intfilenum '定义文件号
'Dim mypath
Dim filena
'mypath = App.Path & "\"
filena = zitipath ' 把字库地址传递过来
'filena = mypath & "hzk16"
intfilenum = FreeFile '获取文件号
Open filena For Binary As #intfilenum '以二进制打开字库文件
Sum = LOF(intfilenum) '获取字库文件的长度,以字节计算
ReDim hzk166(1 To Sum) '重新定义存放字库数组的长度
Get #intfilenum, , hzk166 '将汉字库整体存如数组hzk166()
Close #intfilenum '关闭字库文件,防止发生错误
ReDim zmhp(1 To n, 1 To 32) 'As Byte
For i = 1 To UBound(hzstr1) '字数循环,有几个字循环几次
qwm = Hex(Asc(hzstr1(i)) - &HA0A0) '获取汉字的区位码
If Len(qwm) = 3 Then '获取汉字的区位码
qm = Mid(qwm, 1, 1)
wm = Mid(qwm, 2, 2)
ElseIf Len(qwm) = 4 Then
qm = Mid(qwm, 1, 2)
wm = Mid(qwm, 3, 2) '由于标点为三位汉字为四位要获得正确的区位码,必须给予长度判断.否则会出错
End If
address1 = 32 * ((CLng("&H" & qm) - 1) * 94 + (CLng("&H" & wm) - 1)) '获取汉字所在字库的地址
For j = 1 To 32 '每个字为32个字节
'bytehz = Hex(hzk166(address1 + j))
'If Len(bithz) = 1 Then
'bithz = 0 & bithz
'End If
zmhp(i, j) = hzk166(address1 + j) '将点阵数据存入,数组
On Error Resume Next
Next j
Next i
End Sub
Public Sub subchange2() '将横排转化为竖排
Dim i As Integer, k As Integer
Dim j As Integer
Dim m As Integer
Dim bithz1 As Byte '用来判断该位的值
Dim z As Byte '用来临时存放,竖立排的中间两,其值的获得是通过从横排数据,根据汉字的排列顺序,逐步加起来的.
Dim qq As Byte '确定要取的是横排的那一位
ReDim zmsp(1 To n, 1 To 32)

For i = 1 To n
'i = 1
j = 1
For k = 1 To 2 '作为取左半部分,和右半部分的开关
'Debug.Print "_____"
qq = &H80 '初值为1000,0000  通过/＆h２，逐步向后将１移动，取最后一位时为００００，０００１
'If (qq >= &H1) Then
For m = 1 To 8
'Debug.Print "_____"'运算根据16*16点阵横排与竖排的存放特性进行计算.
z = &H0
If ((zmhp(i, k) And qq) = 0) Then bithz1 = &H0 Else bithz1 = &H1 '8
z = &H80 * bithz1 '作位最高位
If ((zmhp(i, k + 2) And qq) = 0) Then bithz1 = &H0 Else bithz1 = &H1 '7
z = z + (&H40 * bithz1)
If ((zmhp(i, k + 4) And qq) = 0) Then bithz1 = &H0 Else bithz1 = &H1 '6
z = z + (&H20 * bithz1)
If ((zmhp(i, k + 6) And qq) = 0) Then bithz1 = &H0 Else bithz1 = &H1 '5
z = z + (&H10 * bithz1)
If ((zmhp(i, k + 8) And qq) = 0) Then bithz1 = &H0 Else bithz1 = &H1 '4
z = z + (&H8 * bithz1)
If ((zmhp(i, k + 10) And qq) = 0) Then bithz1 = &H0 Else bithz1 = &H1 '3
z = z + (&H4 * bithz1)
If ((zmhp(i, k + 12) And qq) = 0) Then bithz1 = &H0 Else bithz1 = &H1 '2
z = z + (&H2 * bithz1)
If ((zmhp(i, k + 14) And qq) = 0) Then bithz1 = &H0 Else bithz1 = &H1 '1
z = z + (&H1 * bithz1) '作为最底位
zmsp(i, j) = z '取的为上部分
j = j + 1
z = 0
If ((zmhp(i, k + 16) And qq) = 0) Then bithz1 = &H0 Else bithz1 = &H1 '8
z = &H80 * bithz1
If ((zmhp(i, k + 18) And qq) = 0) Then bithz1 = &H0 Else bithz1 = &H1 '7
z = z + (&H40 * bithz1)
If ((zmhp(i, k + 20) And qq) = 0) Then bithz1 = &H0 Else bithz1 = &H1 '6
z = z + (&H20 * bithz1)
If ((zmhp(i, k + 22) And qq) = 0) Then bithz1 = &H0 Else bithz1 = &H1 '5
z = z + (&H10 * bithz1)
If ((zmhp(i, k + 24) And qq) = 0) Then bithz1 = &H0 Else bithz1 = &H1 '4
z = z + (&H8 * bithz1)
If ((zmhp(i, k + 26) And qq) = 0) Then bithz1 = &H0 Else bithz1 = &H1 '3
z = z + (&H4 * bithz1)
If ((zmhp(i, k + 28) And qq) = 0) Then bithz1 = &H0 Else bithz1 = &H1 '2
z = z + (&H2 * bithz1)
If ((zmhp(i, k + 30) And qq) = 0) Then bithz1 = &H0 Else bithz1 = &H1 '1
z = z + (&H1 * bithz1)
zmsp(i, j) = z '下一部分
j = j + 1 '            这一不分有些麻烦,要看的话多注意理解vb中16进制数的运算
z = 0
qq = (qq / &H2) '取横排的下一位*****************哈哈，但愿大家能看懂××××××××××××××
Next m
Next k
Next i
End Sub '将横排存放的汉字转化位,竖排存放的由于vb没有移位运算只有按位相与,进行判断.



Private Sub Text1_Change() '文本框控制
'If n > 20 Then
'X = MsgBox("程序设定最多发送20字", 16)
'End If
'If Combo2.Text = "宋体" Then Text1.Font = "宋体"

'If Combo2.Text = "仿宋" Then Text1.Font = "仿宋_GB2312"

'If Combo2.Text = "楷体" Then Text1.Font = "楷体_GB2312"

'If Combo2.Text = "黑体" Then Text1.Font = "黑体"




On Error Resume Next
Call hzLenandstore
Label3.Caption = n
End Sub
'为毕业设计而写*****************************************************
'程序编写的时间很长,经过多次修改,逐渐完备,但感觉还有很多不足之处,希望有人能指点下
'对我的感觉真的很辛苦.但是也感受到了很多成功的喜悦.....当每次解决一个又一个问题时......
'李健2007年3月(注).
'tel:
'QQ:102126913
'最后希望大家珍惜作者的劳动成果.........................
'
'08-4-22
'因为朋友需要部分更新

Private Sub Timer1_Timer() '定时发送时间控制程序
'Dim tt(1 To 16, 1 To 32) '存放发送的时间数据，例子，发送的内容为：现在时间：17时56分（京），共14个字
'tt(1) =
If Check1.Value Then Call subsendtime '如果check1选中,就定时发送时间.





'If Check1.Value = 1 Then

'End If
End Sub

Public Sub subsendtime() '发送时间子程序
Dim i
Dim t1(1 To 4) As String
Dim h, min, sec
Dim h1, h2, m1, m2

If Len(Time) = 8 Then
h1 = Mid(Time, 1, 1)
h2 = Mid(Time, 2, 1)
m1 = Mid(Time, 4, 1)
m2 = Mid(Time, 5, 1)
Else
h1 = 0
h2 = Mid(Time, 1, 1)
m1 = Mid(Time, 3, 1)
m2 = Mid(Time, 4, 1)
End If

t1(1) = h1
t1(2) = h2
t1(3) = m1
t1(4) = m2
't1() = [h1,h2,m1,m2]
'For i = 1 To 4
' Debug.Print t1(i);
'Next  i
' Debug.Print Chr(13)
'Debug.Print time
'Debug.Print "," & Len(time)
 For i = 1 To 4
 Select Case (t1(i))
 Case 1
 t1(i) = "１"
 Case 2
 t1(i) = "２"
 Case 3
 t1(i) = "３"
 Case 4
 t1(i) = "４"
 Case 5
 t1(i) = "５"
 Case 6
 t1(i) = "６"
 Case 7
 t1(i) = "７"
 Case 8
 t1(i) = "８"
 Case 9
 t1(i) = "９"
 Case 0
 t1(i) = "０"
End Select

 Next i
 'hzstr1()="现在时间："&t1(1)&t1(2)&"时"t1(3)&t(4)&"分"
'hzstr1() = [十,克]
hzstr1(1) = "现"
hzstr1(2) = "在"
hzstr1(3) = "时"
hzstr1(4) = "刻"
'hzstr1(5) = "："
hzstr1(5) = t1(1)
hzstr1(6) = t1(2)
hzstr1(7) = "时"
hzstr1(8) = t1(3)
hzstr1(9) = t1(4)
hzstr1(10) = "分"
n = 11

Call Subchange1
Call subchange2

If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
Dim port 'As Integer
If Combo1.Text = "COM1" Then port = 1

If Combo1.Text = "COM2" Then port = 2

If Combo1.Text = "COM3" Then port = 3

If Combo1.Text = "COM4" Then port = 4
MSComm1.CommPort = port
If MSComm1.PortOpen = False Then MSComm1.PortOpen = True '判断串口是否打开
'***********************************************字体控制部分***

If Combo2.Text = "宋体" Then zitipahth = mypath1 & "hzk16"

If Combo2.Text = "仿宋" Then zitipahth = mypath1 & "hzk16f"

If Combo2.Text = "楷体" Then zitipahth = mypath1 & "hzk16"

If Combo2.Text = "黑体" Then zitipahth = mypath1 & "hzk16"





Dim send1(1 To 1024) As Byte
Dim m As Integer
'Debug.Print
send1(1) = CByte(n)
send1(2) = CByte(n) '发送要输出字的长度,便于单片机控制屏幕显示,此为长度控制,在单片中的存放位置为text[1]
send1(3) = CByte(n)
For i = 3 To 1024 '采用固定字节发送,
send1(i) = CByte(&H0) '给要发送的定字长所有数据先清0
Next i
m = 65 '根据屏幕的大小给出要发送字的起始位置
'MSComm1.OutBufferCount = 0
'MSComm1.Output = CByte(n)
For i = 1 To n
For j = 1 To 32

send1(m) = zmsp(i, j) '把要发送的字的字模按字的先后存入一个数组里
'MSComm1.Output = zmhp(i, j) '发送数据
'Debug.Print "&H"; Hex(zmsp(i, j)) & ",";
'Debug.Print Hex(send1(m)) & "H,";
m = m + 1
Next j
'MSComm1.Output = send1
'Debug.Print "/*"; hzstr1(i); "*/"
'Debug.Print Chr(13)
Next i
MSComm1.OutBufferCount = 0 '发送缓冲区清空
MSComm1.Output = send1() '将数据发送个单片机


'Debug.Print t1(1); t1(2); t1(3); t1(4) & Chr(13)
End Sub