📄 frmmain.frm
字号:
VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "Mscomctl.ocx"
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form frmMain
Caption = "双机互联"
ClientHeight = 6315
ClientLeft = 4740
ClientTop = 3810
ClientWidth = 9180
LinkTopic = "frmMain"
ScaleHeight = 6315
ScaleWidth = 9180
Begin MSComDlg.CommonDialog ctrCommonDialog
Left = 6000
Top = 5760
_ExtentX = 847
_ExtentY = 847
_Version = 393216
CancelError = -1 'True
End
Begin MSCommLib.MSComm ctrMSComm
Left = 4080
Top = 5760
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
End
Begin VB.PictureBox Picture1
Height = 5535
Left = 120
ScaleHeight = 5475
ScaleWidth = 4755
TabIndex = 11
Top = 120
Width = 4815
Begin VB.Frame Frame1
Caption = "发送消息"
Height = 1335
Left = 120
TabIndex = 14
Top = 4080
Width = 4575
Begin VB.TextBox txtSend
Height = 495
Left = 240
TabIndex = 16
Top = 480
Width = 3375
End
Begin VB.CommandButton cmdSendText
Caption = "发送"
Height = 495
Left = 3720
TabIndex = 15
Top = 480
Width = 615
End
End
Begin RichTextLib.RichTextBox rtfReceive
Height = 3495
Left = 120
TabIndex = 13
Top = 480
Width = 4575
_ExtentX = 8070
_ExtentY = 6165
_Version = 393217
Enabled = -1 'True
ScrollBars = 2
TextRTF = $"frmMain.frx":0000
End
Begin VB.CommandButton cmdShow
Height = 300
Left = 3240
TabIndex = 12
Top = 90
Width = 1455
End
End
Begin VB.Frame Frame2
Caption = "文件传输"
Height = 5535
Left = 5040
TabIndex = 0
Top = 120
Width = 3975
Begin MSComctlLib.ProgressBar prgFileTransfer
Height = 495
Left = 720
TabIndex = 10
Top = 4320
Width = 2175
_ExtentX = 3836
_ExtentY = 873
_Version = 393216
Appearance = 1
End
Begin VB.CommandButton cmdFileSend
Caption = "开始传输"
Height = 495
Left = 720
TabIndex = 8
Top = 3240
Width = 2055
End
Begin VB.Frame Frame4
Caption = "文件传输"
Height = 2775
Left = 120
TabIndex = 1
Top = 240
Width = 3735
Begin VB.CommandButton cmdFileSave
Caption = "..."
Height = 375
Left = 2500
TabIndex = 7
Top = 1560
Width = 1000
End
Begin VB.CommandButton cmdFileOpen
Caption = "..."
Height = 375
Left = 2500
TabIndex = 6
Top = 720
Width = 1000
End
Begin VB.TextBox txtReceiveDir
Height = 375
Left = 360
TabIndex = 5
Top = 1680
Width = 2000
End
Begin VB.OptionButton optReceive
Caption = "接收文件"
Height = 300
Left = 245
TabIndex = 4
Top = 1320
Width = 1935
End
Begin VB.TextBox txtSendDir
Height = 375
Left = 360
TabIndex = 3
Top = 720
Width = 2000
End
Begin VB.OptionButton optSend
Caption = "发送文件"
Height = 375
Left = 245
TabIndex = 2
Top = 360
Width = 1215
End
End
Begin VB.Label Label1
Caption = "传输进度"
Height = 375
Left = 1320
TabIndex = 9
Top = 3960
Width = 1575
End
End
Begin VB.Menu OpenPort
Caption = "打开串口"
End
Begin VB.Menu ClosePort
Caption = "关闭串口"
End
Begin VB.Menu ConfigPort
Caption = "配置串口"
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'************************************************
Dim intCommPort As Long '串口号
Dim strCommSettings As String '串口设置
Dim intOutBufferSize As Long '发送缓冲区大小
Dim intInBufferSize As Long '接收缓冲区大小
Dim blnShowFlag As Boolean '显示或隐藏文件传输窗体标志
Dim intColorSet() As Long '用于记录消息显示的格式
Dim intArrayCount As Long '用于记录消息显示的格式
'************************************************
'************************************************
'关闭串口
'响应菜单功能
'************************************************
Private Sub ClosePort_Click()
Call CommPortClose
intCommFlag = 0
End Sub
'************************************************
'传输文件
'响应“开始传输”按钮
'************************************************
Private Sub cmdFileSend_Click()
On Error GoTo FileError
If blnFileTransFlag = True And intCommFlag = 1 Then
intCommFlag = 8
Call FileSendManager(0)
intCommFlag = 1
End If
FileError: '错误处理
'MsgBox (Str(Err.Number) & ":" & Err.Description)
'这一行是笔者保留下来给读者测试用
Select Case Err.Number
Case 53
MsgBox ("文件没有找到!")
End Select
If intCommFlag > 0 Then
intCommFlag = 1
Else
MsgBox ("串口没有打开!")
End If
End Sub
'************************************************
'发送信息
'响应“发送”按钮，发送信息
'************************************************
Public Sub cmdSendText_Click()
Dim bytFlag(5) As Byte '组织帧头
bytFlag(0) = 1
bytFlag(1) = 0
bytFlag(4) = 0
bytFlag(5) = 0
Dim strTemp As String
Dim intSelLen As Integer
If frmMain.ctrMSComm.PortOpen = True Then
strTemp = "发送:" + txtSend.Text
Call ReceiveDisplay(strTemp, 1)
Do
Loop While intCommFlag > 1
intCommFlag = 4
strSend = txtSend.Text '用于发送的文本信息
intlenth = Len(strSend)
bytFlag(2) = intlenth \ 100
bytFlag(3) = intlenth - bytFlag(2) * 100
frmMain.ctrMSComm.Output = bytFlag
frmMain.ctrMSComm.Output = strSend
txtSend.Text = ""
intCommFlag = 1
Else
MsgBox ("先打开串行口!")
End If
End Sub
'************************************************
'显示
'切换程序主窗体的完整与简化模式
'************************************************
Private Sub cmdShow_Click()
blnShowFlag = Not (blnShowFlag)
If blnShowFlag = True Then
cmdShow.Caption = "<<隐藏"
frmMain.Width = 9300
frmMain.Height = 6400
Else
cmdShow.Caption = ">>显示"
frmMain.Width = 5100
frmMain.Height = 6400
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -