?? 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 + -