📄 frmrealtimecomm.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "Mscomctl.ocx"
Begin VB.Form FrmRealTimeComm
BorderStyle = 1 'Fixed Single
Caption = "实时通讯系统"
ClientHeight = 6270
ClientLeft = 45
ClientTop = 330
ClientWidth = 8760
Icon = "FrmRealTimeComm.frx":0000
LinkTopic = "FrmDoorRealTime"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6270
ScaleMode = 0 'User
ScaleWidth = 624
StartUpPosition = 2 '屏幕中心
Begin VB.PictureBox PicMsg
BorderStyle = 0 'None
Height = 765
Left = 45
ScaleHeight = 765
ScaleWidth = 8670
TabIndex = 8
Top = 5490
Width = 8670
Begin VB.TextBox Msg
Appearance = 0 'Flat
BackColor = &H8000000F&
ForeColor = &H000000FF&
Height = 720
Left = 720
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 9
Top = 0
Width = 7890
End
Begin VB.Label Label2
Caption = "消息栏:"
Height = 375
Left = 0
TabIndex = 10
Top = 0
Width = 645
End
End
Begin VB.Frame FramGotData
Caption = "接收数据"
Height = 2940
Left = 90
TabIndex = 3
Top = 2430
Width = 8565
Begin VB.CommandButton btnOpen
Appearance = 0 'Flat
Caption = "打开文件(&O)"
Height = 285
Left = 7200
TabIndex = 12
ToolTipText = "打开接收数据的文件夹"
Top = 2475
Width = 1140
End
Begin VB.CommandButton btnStartRead
Caption = "开始接收"
Height = 285
Left = 7200
TabIndex = 6
Top = 1260
Width = 1140
End
Begin VB.CommandButton btnStopRead
Caption = "停止接收"
Height = 285
Left = 7200
TabIndex = 5
Top = 1867
Width = 1140
End
Begin VB.TextBox TxtGotData
Height = 2580
Left = 225
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 4
Top = 270
Width = 6765
End
Begin MSComDlg.CommonDialog ComDlg
Left = 6120
Top = -90
_ExtentX = 847
_ExtentY = 847
_Version = 393216
Color = -2147483629
End
End
Begin VB.Frame FramListMac
Caption = "设置实时通讯机器"
Height = 2175
Left = 90
TabIndex = 0
Top = 90
Width = 8565
Begin VB.CommandButton btnRealTimeStop
Caption = "停止通讯"
Height = 285
Left = 7200
TabIndex = 11
Top = 1320
Width = 1140
End
Begin MSComctlLib.ListView ListMac
Height = 1680
Left = 225
TabIndex = 1
Top = 405
Width = 6765
_ExtentX = 11933
_ExtentY = 2963
View = 3
LabelEdit = 1
LabelWrap = 0 'False
HideSelection = 0 'False
Checkboxes = -1 'True
FullRowSelect = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 4
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "机器编号"
Object.Width = 1587
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "通信端口"
Object.Width = 1764
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 2
Text = "通信速率"
Object.Width = 1764
EndProperty
BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 3
Text = "设备类型"
Object.Width = 1764
EndProperty
End
Begin VB.CommandButton btnRealTimeStart
Caption = "开始通讯"
Height = 285
Left = 7200
TabIndex = 7
Top = 720
Width = 1140
End
Begin VB.Label Label1
Caption = "机器列表"
ForeColor = &H8000000D&
Height = 255
Left = 360
TabIndex = 2
Top = 180
Width = 1215
End
End
Begin VB.Menu mnuPop
Caption = "ICCODE"
Visible = 0 'False
Begin VB.Menu mnuSelectAll
Caption = "选择全部"
End
Begin VB.Menu mnuSelectNone
Caption = "取消全部"
End
End
End
Attribute VB_Name = "FrmRealTimeComm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim RealTimeSearchState As Boolean
Dim RealTimeState As Boolean
Dim RecordCount As Long
Dim RsFood As New ADODB.Recordset
Private Sub btnOpen_Click()
On Error GoTo ErrorHandler
ComDlg.FileName = ""
ComDlg.Filter = "*.txt|*.txt"
ComDlg.InitDir = frmMacMain.txtRecFilePath.Text
ComDlg.ShowOpen
'ComDlg.CancelError = True
If ComDlg.FileName <> "" Then
ExecuteLink ComDlg.FileName
End If
Exit Sub
ErrorHandler:
MsgBox Err.Number & ":" & Err.Description, vbOKOnly + vbCritical
End Sub
Private Sub Form_Unload(Cancel As Integer)
frmMacMain.TimerGetRec.Enabled = True
End Sub
Private Sub mnuSelectAll_Click()
Dim nLstcount As Integer
For nLstcount = 1 To ListMac.ListItems.Count
ListMac.ListItems(nLstcount).Checked = True
Next
End Sub
Private Sub mnuSelectNone_Click()
Dim nLstcount As Integer
For nLstcount = 1 To ListMac.ListItems.Count
ListMac.ListItems(nLstcount).Checked = False
Next
End Sub
Private Sub ListMac_KeyDown(KeyCode As Integer, Shift As Integer)
If Shift = 2 And KeyCode = 65 Then mnuSelectAll_Click
If Shift = 2 And KeyCode = 78 Then mnuSelectNone_Click
End Sub
Private Sub ListMac_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbRightButton Then
PopupMenu mnuPop, 0, ListMac.Left - 100, ListMac.Top + 400, mnuSelectNone
End If
End Sub
Private Sub ListMac_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
ListMac.SortKey = ColumnHeader.Index - 1
ListMac.Sorted = True
ListMac.SortOrder = 1 - ListMac.SortOrder
End Sub
Private Sub btnRealTimeStart_Click()
On Error GoTo ErrorHandler
Dim zif As Integer
Dim i As Integer
Dim IfSelect As Boolean
IfSelect = False
If ListMac.ListItems.Count = 0 Then
MsgBox "没有卡钟，请从新搜索。", vbOKOnly + vbExclamation
Exit Sub
End If
If btnStartRead.Enabled = False Then
MsgBox "请先停止接收数据！", vbOKOnly + vbExclamation
Exit Sub
End If
Dim SetRealTimeModel As New Nanben.SetMachine
IfSelect = False
For i = 1 To ListMac.ListItems.Count
If ListMac.ListItems(i).Checked = True Then
IfSelect = True
End If
Next
If IfSelect = False Then
MsgBox "请先选择卡钟", vbOKOnly + vbExclamation
Exit Sub
End If
Me.Enabled = False
Me.MousePointer = 11
btnRealTimeStart.Enabled = False
RealTimeState = False
With ListMac
For i = 1 To .ListItems.Count
If .ListItems(i).Checked Then
Msg.Text = Msg.Text & .ListItems(i).SubItems(1) & "-" & .ListItems(i).Text & " 实时通讯模式设置中" & Chr(13) & Chr(10)
Msg.SelStart = Len(Msg.Text)
zif = SetRealTimeModel.RealTimeCommStart(.ListItems(i).SubItems(1), .ListItems(i).SubItems(2), .ListItems(i), True)
'****设置为非实时状态****
' Else
' zif = SetRealTimeModel.RealTimeCommStart(.ListItems(i).SubItems(1), .ListItems(i).SubItems(2), .ListItems(i), True)
' IfSelect = True
If zif = 8 Then
Msg.Text = Msg.Text & " 设置实时通讯成功！" & Chr(13) & Chr(10)
ElseIf zif = 4 Then
Msg.Text = Msg.Text & " 找不到卡钟！" & Chr(13) & Chr(10)
Else
Msg.Text = Msg.Text & " 操作超时！" & Chr(13) & Chr(10)
End If
Msg.SelStart = Len(Msg.Text)
End If
Next
End With
Set SetRealTimeModel = Nothing
Me.Enabled = True
Me.MousePointer = 0
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -