📄 frm_main.frm
字号:
Height = 1365
Left = 480
TabIndex = 19
Top = 3390
Width = 1305
Begin VB.OptionButton OptCheck
Caption = "Odd"
Height = 255
Index = 1
Left = 240
TabIndex = 22
Top = 660
Width = 735
End
Begin VB.OptionButton OptCheck
Caption = "Even"
Height = 255
Index = 2
Left = 240
TabIndex = 21
Top = 990
Width = 795
End
Begin VB.OptionButton OptCheck
Caption = "None"
Height = 255
Index = 0
Left = 240
TabIndex = 20
Top = 330
Value = -1 'True
Width = 765
End
End
Begin VB.Frame Frame4
Caption = "Stop Bits"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 645
Left = 450
TabIndex = 17
Top = 5670
Width = 1335
Begin VB.ComboBox Combo3
Height = 300
ItemData = "Frm_main.frx":1CE4
Left = 330
List = "Frm_main.frx":1CF1
TabIndex = 18
Text = "1"
Top = 240
Width = 885
End
End
Begin VB.Frame Frame5
Caption = "Data Bits"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 705
Left = 480
TabIndex = 15
Top = 4830
Width = 1305
Begin VB.ComboBox Combo2
Height = 300
ItemData = "Frm_main.frx":1D00
Left = 300
List = "Frm_main.frx":1D13
TabIndex = 16
Text = "8"
Top = 270
Width = 885
End
End
Begin VB.Label Label3
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = ".Send Code (HEX)."
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3360
TabIndex = 31
Top = 3390
Width = 2565
End
Begin VB.Label Label5
Height = 315
Left = 120
TabIndex = 14
Top = 3390
Width = 2355
End
End
Begin VB.Image Image1
Height = 645
Left = 300
Picture = "Frm_main.frx":1D26
Top = 120
Width = 2250
End
Begin VB.Label Label2
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "AV Control System"
BeginProperty Font
Name = "Arial"
Size = 15
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 4590
TabIndex = 0
Top = 540
Width = 3105
End
Begin VB.Menu mnu_file
Caption = "File(&F)"
Begin VB.Menu mnu_newflile
Caption = "New File"
Shortcut = ^N
End
Begin VB.Menu mnu_loadflile
Caption = "Open File"
Shortcut = ^O
End
Begin VB.Menu mnu_savefile
Caption = "Save File"
Shortcut = ^S
End
Begin VB.Menu mnu_saveasfile
Caption = "Save As"
Shortcut = ^A
End
Begin VB.Menu mnu_sp
Caption = "-"
End
Begin VB.Menu mnu_exit
Caption = "Exit"
Shortcut = ^Q
End
End
End
Attribute VB_Name = "Frm_main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Const CiniFile = "\Avconfig.ini"
Dim iniFile As String
Dim CheckIndex As Integer
Dim BounIndex As Integer
Dim DataIndex As Integer
Dim StopIndex As Integer
Dim lsendbyte() As Byte
Dim TSendByte() As Byte
Dim lAcceptByte() As Byte
Dim intSendNum As Integer
Dim lsetting As String
Dim CommandFlag As Integer
Dim HexFlag As Integer
Dim lFlag As Boolean
Dim OldHexFlag As Integer
Dim SendIndex As Integer
Dim AvSendByte(3) As MySend
Dim ConverFlag(3) As Integer
Dim OldConverFlag(3) As Integer
Dim RetrunFlag As Integer
Dim TimeDelayFlag As Integer
Dim DelayTime As Integer
Dim SendDelayTime As Integer
Dim Oldtext(3) As String
Dim OldHexText(3) As String
Dim SendStr(3) As String
Dim AutoSaveFileFlag As Integer '自动保存当前文件的标志 1(保存),0(不保存)
Dim nAgainSendTime As Integer
Private Sub Combo1_Click()
If Combo1 <> MSComm1.CommPort Then
Call CloseComm
Call OpenComm
End If
End Sub
Private Sub Combo2_Click()
DataIndex = Combo2.ListIndex + 1
End Sub
Private Sub Combo3_Click()
StopIndex = Combo3.ListIndex + 1
End Sub
Private Sub Command1_Click()
Command1.Enabled = False
Command2.Enabled = True
Command3.Enabled = True
' Command5.Enabled = True
Timer2.Enabled = False
SendDelayTime = 0
Command6.Enabled = True
End Sub
Private Sub Command2_Click()
Dim n As Integer
SendIndex = 0
RetrunFlag = 1
ReDim lsendbyte(0)
lsendbyte(0) = 255
ReDim TSendByte(0)
TSendByte(0) = 255
For n = 0 To 3
ConverFlag(n) = 0
OldConverFlag(n) = 0
ReDim AvSendByte(n).SendBytes(0) As Byte
AvSendByte(n).SendBytes(0) = 255
ConverFlag(n) = 0
Oldtext(n) = ""
OldHexText(n) = ""
Next
Text1 = ""
Text2 = ""
Command3.Enabled = True
Command6.Enabled = False
End Sub
Private Sub Command3_Click()
'Conversion Code to Send code
Dim n As Integer
Dim tmpstr As String
n = Len(Trim(Text1))
If n = 0 Then Exit Sub
If CommandFlag > 0 Then
If HexFlag = 1 Then
If n Mod 2 = 0 Then
Else
'MsgBox "Data type error!", vbCritical + vbOKOnly, "Error Information"
'Exit Sub
End If
End If
tmpstr = Trim(Text1.Text)
Oldtext(CommandFlag - 1) = tmpstr
Call ConvSendStr(tmpstr)
Call DisplayShow(CommandFlag - 1)
Call SendOtherByteT(CommandFlag - 1)
ConverFlag(CommandFlag - 1) = 1
OldConverFlag(CommandFlag - 1) = 1
ReDim lsendbyte(0) As Byte
lsendbyte(0) = 0
End If
Command3.Enabled = True
Command6.Enabled = True
End Sub
Private Sub Command3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
Me.PopupMenu mnu_file
End If
End Sub
'Private Sub Command5_Click()
' Dim n As Integer
' Dim m As Integer
' Dim j As Integer
' Dim tmp As String
' Dim tmpstr As String
'
'
' For m = 0 To 3
' n = UBound(AvSendByte(m).SendBytes())
' For j = 0 To n
' tmpstr = Chr(AvSendByte(m).SendBytes(j))
' tmp = tmp & tmpstr
' Debug.Print AvSendByte(m).SendBytes(j)
' Next
'' MsgBox tmp
' Debug.Print tmp
' tmp = ""
' Next
'End Sub
Private Sub Command6_Click()
RetrunFlag = 0
Command1.Enabled = True
Command2.Enabled = False
Command3.Enabled = False
' Command5.Enabled = False
Command6.Enabled = False
SendDelayTime = 3
Timer2.Enabled = True
End Sub
Private Sub Form_Load()
Dim n As Integer
'获得串口号及最后的配置文件
Call GetIniFileName(App.Path & CiniFile)
'打开串口
Call OpenComm
'初始化
Call InitCode
'载入最后的配置文件
If Len(iniFile) > 0 And Len(Dir(iniFile)) > 0 Then
Call GetCodeFile(iniFile)
Call LoadOldCode(iniFile)
End If
SBar1.Panels(3).Text = iniFile
SBar1.Panels(4).Text = CDate(Date)
End Sub
Private Sub OpenComm()
On Error GoTo Err:
Dim lcommport As Integer
lcommport = Val(Combo1)
If (lcommport) = 0 Then SBar1.Panels(1).Text = "Don't open the Comm" & lcommport: Exit Sub
MSComm1.InputMode = comInputModeBinary
MSComm1.RThreshold = 1
MSComm1.CommPort = lcommport
If Len(lsetting) = 0 Then
MSComm1.Settings = "9600,n,8,1"
Else
MSComm1.Settings = lsetting
End If
If MSComm1.PortOpen = False Then
MSComm1.PortOpen = True
Frame3.Enabled = True
End If
Exit Sub
Err:
'MsgBox Err.Description
SBar1.Panels(1).Text = "Don't open the Comm!"
End Sub
Private Sub CloseComm()
On Error GoTo Err:
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
Combo1.Enabled = True
Frame3.Enabled = False
End If
Exit Sub
Err:
MsgBox Err.Description
End Sub
Private Sub ConvSendStr(ByVal lsendstr As String)
Dim n As Integer
Dim j As Integer
Dim m As Integer
Dim tmp As String
Dim tmpstr As String
Dim SendStr As String
Dim tmplong As Long
If Len(lsendstr) = 0 Then Exit Sub
tmpstr = lsendstr
n = Len(tmpstr)
For j = 1 To n
tmp = Mid(tmpstr, j, 1)
If Len(Trim(tmp)) = 0 Then
Else
SendStr = SendStr & tmp
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -