📄 form1.frm
字号:
VERSION 5.00
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 TEST
Caption = "LOG"
ClientHeight = 8835
ClientLeft = 60
ClientTop = 345
ClientWidth = 11490
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form1"
ScaleHeight = 8835
ScaleWidth = 11490
StartUpPosition = 2 'CenterScreen
Begin VB.CommandButton Command3
Caption = "Command3"
Height = 255
Left = 7800
TabIndex = 15
Top = 600
Visible = 0 'False
Width = 1215
End
Begin VB.CommandButton Command2
Caption = "About"
BeginProperty Font
Name = "MS Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 8640
TabIndex = 14
Top = 120
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 255
Left = 6360
TabIndex = 13
Top = 600
Visible = 0 'False
Width = 855
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 4560
Top = 480
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin MSCommLib.MSComm MSComm1
Left = 5400
Top = 480
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
InBufferSize = 30000
RThreshold = 1
End
Begin VB.Timer timshp
Interval = 100
Left = 4080
Top = 120
End
Begin VB.CommandButton cmdRTS
Caption = "RTS ON"
BeginProperty Font
Name = "MS Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6000
TabIndex = 8
Top = 120
Width = 1215
End
Begin VB.CommandButton cmdDTR
Caption = "DTR ON"
BeginProperty Font
Name = "MS Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 4680
TabIndex = 7
Top = 120
Width = 1215
End
Begin VB.ComboBox cmbcom
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 9960
TabIndex = 2
Text = "Combo1"
Top = 120
Width = 1455
End
Begin VB.CommandButton cmdFont
Appearance = 0 'Flat
Caption = "Font"
BeginProperty Font
Name = "MS Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 7320
TabIndex = 1
Top = 120
Width = 1215
End
Begin VB.TextBox txtrec
Appearance = 0 'Flat
BeginProperty Font
Name = "Roman"
Size = 14.25
Charset = 255
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 7935
Left = 120
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 0
Top = 840
Width = 11295
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 250
Left = 4560
Top = 120
End
Begin VB.Label Label5
Caption = "Fre:"
Height = 255
Left = 240
TabIndex = 12
Top = 1200
Visible = 0 'False
Width = 975
End
Begin VB.Label lblCom
Height = 375
Left = 120
TabIndex = 11
Top = 480
Width = 615
End
Begin VB.Shape shp
FillStyle = 0 'Solid
Height = 375
Index = 4
Left = 840
Shape = 3 'Circle
Top = 480
Width = 255
End
Begin VB.Label Label3
Caption = "Sate"
Height = 255
Left = 720
TabIndex = 10
Top = 120
Width = 615
End
Begin VB.Label Label2
Caption = "Port "
Height = 255
Left = 120
TabIndex = 9
Top = 120
Width = 495
End
Begin VB.Shape shp
FillStyle = 0 'Solid
Height = 375
Index = 3
Left = 3315
Shape = 3 'Circle
Top = 480
Width = 255
End
Begin VB.Shape shp
FillStyle = 0 'Solid
Height = 375
Index = 2
Left = 2685
Shape = 3 'Circle
Top = 480
Width = 255
End
Begin VB.Shape shp
FillStyle = 0 'Solid
Height = 375
Index = 1
Left = 2070
Shape = 3 'Circle
Top = 480
Width = 255
End
Begin VB.Shape shp
FillStyle = 0 'Solid
Height = 375
Index = 0
Left = 1440
Shape = 3 'Circle
Top = 480
Width = 255
End
Begin VB.Label Label1
Caption = "RI"
Height = 375
Index = 3
Left = 3315
TabIndex = 6
Top = 120
Width = 495
End
Begin VB.Label Label1
Caption = "DSR"
Height = 375
Index = 2
Left = 2685
TabIndex = 5
Top = 120
Width = 495
End
Begin VB.Label Label1
Caption = "CTS"
Height = 375
Index = 1
Left = 2070
TabIndex = 4
Top = 120
Width = 495
End
Begin VB.Label Label1
Caption = "DCD"
Height = 375
Index = 0
Left = 1440
TabIndex = 3
Top = 120
Width = 495
End
End
Attribute VB_Name = "TEST"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim ComInUse As Boolean
Dim frame() As Byte
Dim prn() As Byte
Dim bytraw() As Byte
Dim inframe As Boolean
Dim strframe As String
Dim framei As Integer
Dim prni As Integer
Dim strprn As String
Dim j As Integer
Dim k As Integer
Dim LOG As Boolean
Dim msgid As Long
Dim msgtime As Long
Dim odutime As Long
Dim l As Integer
Dim bytinput As Byte 'temp)
Dim nowid As Long
Dim logstr As String
Dim temp() As Byte
Dim numfile As Integer
Dim msgidgroup() As Long
Dim grouptime As String
Dim sep As Byte
Dim counCT As Currency
Dim counN As Integer
Dim coun As Integer
Dim ct1, ct2, fre As Currency
Dim ma As Currency
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long
Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
Private Sub cmbcom_Click()
On Error GoTo Errhander
If ComInUse = True Then
MSComm1.PortOpen = False
End If
Select Case cmbcom.Text
Case "COM1"
MSComm1.CommPort = 1
Case "COM2"
MSComm1.CommPort = 2
Case "COM3"
MSComm1.CommPort = 3
End Select
If MSComm1.PortOpen Then
'MsgBox "Com Port you select is already inuse!"
Exit Sub
Else
MSComm1.PortOpen = True
End If
MSComm1.InBufferCount = 0
MSComm1.OutBufferCount = 0
ComInUse = True
If ComInUse = False Then Exit Sub
txtrec.SetFocus
Exit Sub
Errhander:
If Err.Number = 8005 Then
'MsgBox "Com Port you select is already inuse!"
ComInUse = False
cmbcom.Text = ""
ElseIf Err.Number = 8002 Then
'MsgBox "COM NOT EXIST!"
ComInUse = False
cmbcom.Text = ""
End If
End Sub
Private Sub cmdDTR_Click()
On Error Resume Next
If MSComm1.PortOpen = False Then Exit Sub
If MSComm1.DTREnable = True Then
MSComm1.DTREnable = False
cmdDTR.Caption = "DTR ON"
Else
MSComm1.DTREnable = True
cmdDTR.Caption = "DTR OFF"
End If
txtrec.SetFocus
End Sub
Private Sub cmdFont_Click()
On Error Resume Next
CommonDialog1.Flags = 1
CommonDialog1.Action = 4
With txtrec
.FontName = CommonDialog1.FontName
.FontSize = CommonDialog1.FontSize
.FontBold = CommonDialog1.FontBold
.FontItalic = CommonDialog1.FontItalic
.FontUnderline = CommonDialog1.FontUnderline
.FontStrikethru = CommonDialog1.FontStrikethru
End With
txtrec.SetFocus
End Sub
Private Sub cmdRTS_Click()
On Error Resume Next
If MSComm1.PortOpen = False Then Exit Sub
If MSComm1.RTSEnable = True Then
MSComm1.RTSEnable = False
cmdRTS.Caption = "RTS ON"
Else
MSComm1.RTSEnable = True
cmdRTS.Caption = "RTS OFF"
End If
txtrec.SetFocus
End Sub
Private Sub Command1_Click()
On Error Resume Next
Open "c:\" + "Screen" + ".txt" For Output As #2
Dim ferr As Integer
ferr = FileErrors
If ferr = 2 Or ferr = 3 Then
Form_Terminate
End
End If
End Sub
Private Sub Command2_Click()
frmAbout.Show
End Sub
Private Sub Command3_Click()
txtrec.Text = txtrec.Text + "A"
strprn = "S"
processPrn
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
On Error Resume Next
txtrec.SelStart = Len(txtrec.Text)
MSComm1.Output = Chr(KeyAscii)
KeyAscii = 0
End Sub
Private Sub Form_Load()
'skn.LoadSkin App.Path + "\winaqua.skn" ' Loads another skin into Skin component
'skn.ApplySkin Me.hWnd ' Applies the skin to this window and its child controls
'MSComm1.InputLen = 1000
'MSComm1.SThreshold = 1
On Error GoTo Errhander:
Open App.Path + "\" + fmt(CStr(Year(Date))) + fmt(CStr(Month(Date))) + fmt(CStr(Day(Date))) + Space(1) + fmt(CStr(Hour(Time))) + fmt(CStr(Minute(Time))) + fmt(CStr(Second(Time))) + "_" + "Screen" + ".txt" For Output As #2
Open App.Path + "\" + fmt(CStr(Year(Date))) + fmt(CStr(Month(Date))) + fmt(CStr(Day(Date))) + Space(1) + fmt(CStr(Hour(Time))) + fmt(CStr(Minute(Time))) + fmt(CStr(Second(Time))) + "_" + "Bin" For Binary As #1
Open App.Path + "\" + fmt(CStr(Year(Date))) + fmt(CStr(Month(Date))) + fmt(CStr(Day(Date))) + Space(1) + fmt(CStr(Hour(Time))) + fmt(CStr(Minute(Time))) + fmt(CStr(Second(Time))) + "_" + "COMErr" + ".txt" For Output As #500
counCT = 0
counN = 0
ma = 0
sep = &H7E
inframe = False
framei = -1
prni = -1
LOG = False
msgid = 0
strframe = ""
numfile = 2
odutime = 0
'Timer2.Enabled = True
Timer1.Enabled = True
With cmbcom
.AddItem "COM1", 0
.AddItem "COM2", 1
.AddItem "COM3", 2
.Text = "COM1"
End With
For k = 0 To 3
shp(k).FillColor = RGB(255, 255, 255)
Next k
sendFF
ComInUse = True
MSComm1.CommPort = 1
MSComm1.Settings = "115200,n,8,1"
MSComm1.PortOpen = True
MSComm1.RThreshold = 1
MSComm1.InputMode = comInputModeBinary
MSComm1.DTREnable = False
MSComm1.RTSEnable = False
Exit Sub
Errhander:
If Err.Number = 8005 Then
'MsgBox "Com Port you select is already inuse!"
ComInUse = False
cmbcom.Text = ""
ElseIf Err.Number = 8002 Then
'MsgBox "COM NOT EXIST!"
ComInUse = False
cmbcom.Text = ""
End If
End Sub
Private Sub Form_Terminate()
On Error Resume Next
MSComm1.PortOpen = False
Close #2
Close #1
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -