📄 frmmain.frm
字号:
Width = 3375
End
Begin VB.Label LabTongDao
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
ForeColor = &H80000008&
Height = 255
Index = 5
Left = 1800
TabIndex = 26
Top = 1560
Width = 3375
End
Begin VB.Label LabTongDao
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
ForeColor = &H80000008&
Height = 255
Index = 4
Left = 1800
TabIndex = 25
Top = 1320
Width = 3375
End
Begin VB.Label LabTongDao
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
ForeColor = &H80000008&
Height = 255
Index = 3
Left = 1800
TabIndex = 24
Top = 1080
Width = 3375
End
Begin VB.Label LabTongDao
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
ForeColor = &H80000008&
Height = 255
Index = 2
Left = 1800
TabIndex = 23
Top = 840
Width = 3375
End
Begin VB.Label LabTongDao
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
ForeColor = &H80000008&
Height = 255
Index = 1
Left = 1800
TabIndex = 22
Top = 600
Width = 3375
End
Begin VB.Label LabTongDao
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
ForeColor = &H80000008&
Height = 255
Index = 0
Left = 1800
TabIndex = 21
Top = 360
Width = 3375
End
Begin VB.Label Label1
Caption = "7通道"
Height = 255
Index = 7
Left = 1200
TabIndex = 20
Top = 2080
Width = 615
End
Begin VB.Label Label1
Caption = "6通道"
Height = 255
Index = 6
Left = 1200
TabIndex = 19
Top = 1820
Width = 615
End
Begin VB.Label Label1
Caption = "5通道"
Height = 255
Index = 5
Left = 1200
TabIndex = 18
Top = 1580
Width = 615
End
Begin VB.Label Label1
Caption = "4通道"
Height = 255
Index = 4
Left = 1200
TabIndex = 17
Top = 1340
Width = 615
End
Begin VB.Label Label1
Caption = "3通道"
Height = 255
Index = 3
Left = 1200
TabIndex = 16
Top = 1100
Width = 615
End
Begin VB.Label Label1
Caption = "2通道"
Height = 255
Index = 2
Left = 1200
TabIndex = 15
Top = 860
Width = 615
End
Begin VB.Label Label1
Caption = "1通道"
Height = 255
Index = 1
Left = 1200
TabIndex = 14
Top = 620
Width = 615
End
Begin VB.Label Label1
Caption = "0通道"
Height = 255
Index = 0
Left = 1200
TabIndex = 13
Top = 380
Width = 615
End
End
Begin VB.OptionButton OptDian
Height = 735
Index = 5
Left = 4440
Style = 1 'Graphical
TabIndex = 3
Tag = "五号测点"
Top = 120
Width = 1095
End
Begin VB.OptionButton OptDian
Height = 735
Index = 4
Left = 3360
Style = 1 'Graphical
TabIndex = 2
Tag = "四号测点"
Top = 120
Width = 1095
End
Begin VB.OptionButton OptDian
Height = 735
Index = 3
Left = 2280
Style = 1 'Graphical
TabIndex = 1
Tag = "三号测点"
Top = 120
Width = 1095
End
Begin VB.OptionButton OptDian
Height = 735
Index = 1
Left = 120
Style = 1 'Graphical
TabIndex = 0
Tag = "一号测点"
Top = 120
Value = -1 'True
Width = 1095
End
Begin VB.Label LabDian
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "等待连接中未取得相关信息 "
ForeColor = &H80000008&
Height = 255
Left = 120
TabIndex = 4
Top = 960
Width = 5415
End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'========================================================
'Copyright (c) 2008
'
'文件名称：FrmMain.Frm
'摘 要：实时从下接DTU处获取数,并通过DDE传送给 组态软件
'
'当前版本：1.0
'作 者：畅彦峰
'完成日期：2008年3月4日
'========================================================
Dim iDtu(1 To 5) As Byte '1-5号Dtu所对应的动态winsock控件编号
Dim iWinsock(1 To 5) As Byte '1-5号winsock控件所对应的动态DTU编号
Dim LastTime(1 To 5) As Date '最后一次收到消息的时间
Dim LastTimeValue(1 To 5) As Date '第一次相同数据收到的时间
Dim sReport(1 To 5, 0 To 6, 0 To 9) As String '定义1-5号DTU返回的详细数据,分模块与通道
Dim isReturn(1 To 5) As Boolean '定义发送命令后是否接收到数据
Dim haoma(1 To 5, 1 To 2) As Integer '定义当前 模块 以及 通道编号
Dim dTimeClose As Integer '延时断线所用
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
On Error GoTo ERR
Dim ShiftDown, AltDown, CtrlDown
ShiftDown = (Shift And vbShiftMask) > 0
AltDown = (Shift And vbAltMask) > 0
CtrlDown = (Shift And vbCtrlMask) > 0
If CtrlDown Then
If KeyCode = vbKeyS Then
FrmSetup.Show
End If
If KeyCode = vbKeyC Then
TimerTest.Enabled = Not TimerTest.Enabled
End If
End If
Exit Sub
ERR:
Call ShowError(Me.Name, "Form_KeyDown", ERR.Number, ERR.Description)
End Sub
Private Sub Form_Load()
On Error Resume Next
Dim sCommand As String
sCommand = Command
Me.LinkTopic = ""
If Dir("c:\Hide.Dtu") <> "" Then Kill ("c:\Hide.Dtu")
If Dir("c:\Close.Dtu") <> "" Then Kill ("c:\Hide.Dtu")
Select Case LCase(sCommand)
Case "hide"
Open "c:\Hide.Dtu" For Output As #1
Print "Hide"
Close #1
Case "show"
Open "c:\Show.Dtu" For Output As #1
Print "Show"
Close #1
Case "close"
Open "c:\Close.Dtu" For Output As #1
Print "Close"
Close #1
Case Else
'
End Select
If App.PrevInstance Then End
'DDE
'Me.LinkMode = 1
Me.LinkTopic = "DDE"
'
'初始化相关控件 变量
Load FrmMessage
'临时=====================
For x = 1 To 7
Load T11(x): Load T12(x): Load T13(x): Load T14(x): Load T15(x): Load T16(x)
Load T21(x): Load T22(x): Load T23(x): Load T24(x): Load T25(x): Load T26(x)
Load T31(x): Load T32(x): Load T33(x): Load T34(x): Load T35(x): Load T36(x)
Load T41(x): Load T42(x): Load T43(x): Load T44(x): Load T45(x): Load T46(x)
Load T51(x): Load T52(x): Load T53(x): Load T54(x): Load T55(x): Load T56(x)
Next
TimerDDE.Interval = 500
TimerDDE = True '定时向DDE数据控件 写信息
'==========================
Call LoadSetup '读取配置文件
W(0).LocalPort = "2008"
W(0).Listen
WTest.RemoteHost = RemoteUrl
WTest.RemotePort = "8002"
TimerTestRemote.Interval = RemoteTime * 1000
TimerTestRemote = isUseRemote
TimerClose = isUseClose '是否启用延时断线
For x = 1 To 5
Load W(x)
OptDian(x).Caption = CStr(x) & "号测点" & vbNewLine & "等待连接"
OptDian(x).Enabled = False
iDtu(x) = 0
Next
For x = 1 To 6
OptMod(x).Caption = OptMod(x).Tag & x
Next
TimerDTU1.Interval = iTimer * 100: TimerDTU1 = True
TimerDTU2.Interval = iTimer * 100: TimerDTU2 = True
TimerDTU3.Interval = iTimer * 100: TimerDTU3 = True
TimerDTU4.Interval = iTimer * 100: TimerDTU4 = True
TimerDTU5.Interval = iTimer * 100: TimerDTU5 = True
TimerLost = True
TimerCommand = isReCommand
Call ResizeInit(Me)
End Sub
Sub load_DtuSim()
Dim sTemp As String
Dim x As Integer
Open App.Path & "\" & "SimId.Dtu" For Input As #1
Do While Not EOF(1)
x = x + 1
Line Input #1, sTemp
Dim sSim() As String
sSim() = Split(sTemp, "=", -1)
sDianId(x, 1) = sSim(0) '序号
sDianId(x, 2) = sSim(1) 'Sim卡号码
Loop
Close #1
End Sub
Function ReDtuId(ByVal s As String) As Integer
On Error GoTo ERR
Dim x As Integer
Dim ss As String
ss = s
For x = 1 To 5
If s = sDianId(x, 2) Then ReDtuId = CInt(sDianId(x, 1))
Next
Exit Function
ERR:
Call ShowError(Me.Name, "ReDtuId", ERR.Number, ERR.Description)
End Function
Private Sub Form_Resize()
On Error Resume Next
Call ResizeForm(Me)
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
Private Sub OptDian_Click(Index As Integer)
On Error GoTo ERR
LabDian.Caption = sReport(Index, 0, 8) & "--" & sReport(Index, 0, 9)
Call OptMod_Click(1)
Exit Sub
ERR:
Call ShowError(Me.Name, "OptDian_Click", ERR.Number, ERR.Description)
End Sub
Private Sub OptMod_Click(Index As Integer)
On Error GoTo ERR
For x = 1 To 5
If OptDian(x).Value = True Then
For y = 0 To 7
LabTongDao(y).Caption = sReport(x, Index, y)
Next
End If
Next
Exit Sub
ERR:
Call ShowError(Me.Name, "OptMod_Click", ERR.Number, ERR.Description)
End Sub
Private Sub TimerClose_Timer()
On Error Resume Next
Dim x As Integer
dTimeClose = dTimeClose + 1
If iCloseTime = dTimeClose Then
dTimeClose = 0
For x = 1 To 5
iDtu(x) = 0
W(x).Close
Unload W(x)
Load W(x)
OptDian(x).Enabled = False
OptDian(x).Caption = CStr(5) & "号测点" & vbNewLine & "等待连接"
Next
End If
End Sub
Private Sub TimerCommand_Timer()
On Error GoTo ERR
If Dir("c:\Show.Dtu") <> "" Then
Kill ("c:\Show.Dtu")
Me.Show
End If
If Dir("c:\Hide.Dtu") <> "" Then
Kill ("c:\Hide.Dtu")
Me.Hide
End If
If Dir("c:\Close.Dtu") <> "" Then
Kill ("c:\Close.Dtu")
End
End If
Exit Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -