form1.frm
来自「云台镜头控制系统 很好用」· FRM 代码 · 共 955 行 · 第 1/2 页
FRM
955 行
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H008080FF&
Height = 360
Index = 0
Left = 720
TabIndex = 10
Text = "Message1"
Top = 240
Width = 5175
End
Begin VB.CheckBox Chkse
Height = 255
Index = 7
Left = 240
TabIndex = 8
Top = 3600
Width = 255
End
Begin VB.CheckBox Chkse
Height = 255
Index = 6
Left = 240
TabIndex = 7
Top = 3120
Width = 255
End
Begin VB.CheckBox Chkse
Height = 300
Index = 5
Left = 240
TabIndex = 6
Top = 2640
Width = 255
End
Begin VB.CheckBox Chkse
Height = 255
Index = 4
Left = 240
TabIndex = 5
Top = 2160
Width = 255
End
Begin VB.CheckBox Chkse
Height = 255
Index = 3
Left = 240
TabIndex = 4
Top = 1680
Width = 255
End
Begin VB.CheckBox Chkse
Height = 255
Index = 2
Left = 240
TabIndex = 3
Top = 1200
Width = 255
End
Begin VB.CheckBox Chkse
Height = 255
Index = 1
Left = 240
TabIndex = 2
Top = 720
Width = 255
End
Begin VB.CheckBox Chkse
Height = 255
Index = 0
Left = 240
TabIndex = 1
Top = 240
Width = 255
End
Begin VB.Line Line8
X1 = 0
X2 = 8400
Y1 = 3960
Y2 = 3960
End
Begin VB.Line Line7
X1 = 0
X2 = 8400
Y1 = 3480
Y2 = 3480
End
Begin VB.Line Line6
X1 = 0
X2 = 8400
Y1 = 3000
Y2 = 3000
End
Begin VB.Line Line5
X1 = 0
X2 = 8400
Y1 = 2520
Y2 = 2520
End
Begin VB.Line Line4
X1 = 0
X2 = 8400
Y1 = 2040
Y2 = 2040
End
Begin VB.Line Line3
X1 = 0
X2 = 8400
Y1 = 1560
Y2 = 1560
End
Begin VB.Line Line2
X1 = 0
X2 = 8400
Y1 = 1080
Y2 = 1080
End
Begin VB.Line Line1
X1 = 0
X2 = 8400
Y1 = 600
Y2 = 600
End
End
Begin VB.Label Label7
Caption = "Sending"
Height = 375
Left = 240
TabIndex = 52
Top = 5400
Width = 855
End
Begin VB.Label Label6
Caption = "Used Space"
Height = 255
Left = 120
TabIndex = 51
Top = 6000
Width = 1095
End
Begin VB.Label Label5
Caption = "Mode"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 7560
TabIndex = 38
Top = 900
Width = 615
End
Begin VB.Label Label4
Caption = "Flash"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6840
TabIndex = 37
Top = 885
Width = 615
End
Begin VB.Label Label3
Caption = "Speed"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6120
TabIndex = 36
Top = 885
Width = 615
End
Begin VB.Label Label2
Caption = "Message"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2880
TabIndex = 26
Top = 880
Width = 855
End
Begin VB.Label Label1
Caption = "Select"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 240
TabIndex = 9
Top = 880
Width = 615
End
Begin VB.Image Image1
Height = 600
Left = 480
Picture = "Form1.frx":0F7A
Top = 120
Width = 7500
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Sub DispHz()
Dim TempSrcFile As String
Dim TempDestFile As String
Dim TempFile As String
Dim HzFile As String
Dim p(1 To 2) As Byte
Dim C1, C2
Dim rec As Integer
Dim Location, L As Long '汉字在字库中的位置
Dim HzBy(0 To 23) As Byte '转换完的32字节的字模数据
Dim AscBy(0 To 11) As Byte '暂存转换过程中的32字节字模数据
Dim HzAll() As Byte '存放全部字模数据的动态数组
Dim LoopAll As Integer
Dim comda As String
Dim i, hzlen, HzPos, ascb As Integer
Dim HzRec, msg As String
'HzPos = 1 '置字符串的首字节为当前字节
TempFile = "temp.ini"
Open TempFile For Output As #3
For i = 0 To 7
Print #3, "[Option" & i + 1&; "] "
Print #3, Chkse(i).Value
Print #3, Text(i).Text
Print #3, Combo(i).Text
Print #3, Combom(i).Text
Print #3, Check(i).Value
Print #3, ""
Next i
'Print #3, ComSele.Text
Close #3
On Error GoTo chusb
TempFile = "temp.bin"
Open TempFile For Binary Access Write As #5
MSComm1.Settings = "9600,n,8,1"
MSComm1.CommPort = 3
comda = &HAA
If MSComm1.PortOpen = False Then
MSComm1.PortOpen = True
End If
MSComm1.Output = comda
For L = 0 To 7
If Chkse(L).Value = 1 Then
hzlen = Len(Text(L).Text) '计算字符串长度
TempFile = "temp"
Open TempFile For Output As #1
Print #1, Text(L).Text
Close #1
For LoopAll = 1 To hzlen
'msg = TxtMsg(l).Text
'Asc (Mid$(TxtMsg(L).Text, LoopAll, 1))
If Asc(Mid$(Text(L).Text, LoopAll, 1)) < 0 Then
TempFile = "temp"
Open TempFile For Binary Access Read As #3 '按二进制方式打开
Get #3, LoopAll, p
Close #3
C1 = CStr(p(1)) - &HA1 '区内码
C2 = CStr(p(2)) - &HA1 '位内码
rec = C1 * 94 + C2
Location = CLng(rec) * 24 + 1 '该汉字在12*12点阵字库中字模第一个字节的位置
Open "HZK12" For Binary Access Read As #1
Get #1, Location, HzBy
Close #1
Loopch:
If MSComm1.OutBufferCount = 0 Then
MSComm1.Output = HzBy '得到汉字字模数据->HzBy
Else
GoTo Loopch
End If
Put #5, , HzBy
Else
TempFile = "temp"
Open TempFile For Binary Access Read As #3 '按二进制方式打开
Get #3, LoopAll, p(1)
Close #3
Location = CStr(p(1)) * 12 + 1 '内码
Open "ASC12" For Binary Access Read As #1
Get #1, Location, AscBy
Close #1
'MSComm1.Output = AscBy '得到非汉字字模数据->AscBy
Loopcl:
If MSComm1.OutBufferCount = 0 Then
MSComm1.Output = AscBy '得到非汉字字模数据->AscBy
Else
GoTo Loopcl
End If
Put #5, , AscBy
End If
Next LoopAll
If Combom(L).Text = "Left" Then
comda = 1
End If
If Combom(L).Text = "Right" Then
comda = 2
End If
If Combom(L).Text = "up" Then
comda = 3
End If
If Combom(L).Text = "Down" Then
comda = 4
End If
If Combom(L).Text = "Freeze" Then
comda = 5
End If
If Check(L).Value = 1 Then
comda = comda Or &H80
End If
Loopca:
If MSComm1.OutBufferCount = 0 Then
MSComm1.Output = Combo(L).Text
MSComm1.Output = comda
Hex (comda)
Put #5, , comda
Else
GoTo Loopca
End If
End If
If ProBar1.Value < 80 Then
ProBar1.Value = ProBar1.Value + 10
End If
Next L
Close #5
comda = &HBB
MSComm1.Output = comda
MSComm1.PortOpen = False
MsgBox "GOOD!! data send completed OK"
ProBar1.Value = 0
chusb:
If Err.Number = 8002 Then
MsgBox "please insert you usb data line!", vbExclamation
Resume
'Err.Number = 0
End If
End Sub
Private Sub Chkse_Click(Index As Integer)
Timer1.Enabled = True
End Sub
Private Sub Command1_Click()
Call DispHz
End Sub
Private Sub Command2_Click()
Load Form2
Form2.Visible = True
End Sub
Private Sub Command3_Click()
End
End Sub
Private Sub Form_Load()
Dim i As Integer
Dim st As String
Dim TempFile As String
MSComm1.CommPort = 3
On Error GoTo chkerr
If MSComm1.PortOpen = False Then
MSComm1.PortOpen = True
End If
MSComm1.PortOpen = False
TempFile = "temp.ini"
Open TempFile For Input As #3
For i = 0 To 7
Input #3, st
Input #3, st
Chkse(i).Value = st
Input #3, st
Text(i).Text = st
Input #3, st
Combo(i).Text = st
Input #3, st
Combom(i).Text = st
Input #3, st
Check(i).Value = st
Input #3, st
Next i
'Input #3, st
'Label1.Caption = "USB TO COM" & MSComm1.CommPort 'ComSele.Text = st
Close #3
Exit Sub
chkerr:
If Err.Number = 8002 Then
'MsgBox "please insert you usb data line!"
MsgBox "please insert you usb data line!", vbExclamation
End
End If
Exit Sub
End Sub
Private Sub Text_Change(Index As Integer)
Timer1.Enabled = True
End Sub
Private Sub Timer1_Timer()
Dim i, L As Integer
Dim strlen
For i = 0 To 7
If Chkse(i).Value = 1 Then
L = Len(Text(i).Text)
strlen = strlen + L
End If
Next i
If strlen <= 300 Then
Picture2.Visible = False
ProBar2.Value = strlen
strlen = 0
Else
Picture2.Visible = True
MsgBox "Sorry! date full please delete any word", vbExclamation
Timer1.Enabled = False
End If
End Sub
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?