?? frmmain.frm
字號:
Height = 255
Index = 0
Left = 2040
Picture = "frmMain.frx":06D6
Top = 6120
Visible = 0 'False
Width = 390
End
Begin VB.Image imgCar
Height = 255
Index = 2
Left = 2280
Picture = "frmMain.frx":0C68
Top = 3120
Visible = 0 'False
Width = 390
End
Begin VB.Image imgCar
Height = 255
Index = 3
Left = 0
Picture = "frmMain.frx":11FA
Top = 5040
Visible = 0 'False
Width = 390
End
Begin VB.Image imgCar
Height = 255
Index = 1
Left = 5640
Picture = "frmMain.frx":178C
Top = 5280
Visible = 0 'False
Width = 390
End
Begin VB.Image Image1
Height = 3585
Left = 0
Picture = "frmMain.frx":1D1E
Top = 2880
Width = 6360
End
Begin VB.Label Label15
Alignment = 2 'Center
Caption = "Power"
Height = 255
Left = 2640
TabIndex = 1
Top = 2400
Width = 615
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public Sub initialPRJ()
strRecHex = ""
TimerCommStartMark = False
timerComm.Enabled = False
End Sub
Private Sub DisplayCmd()
If GetWinSockState(tcpWinsock) <> "Connected" Or _
(nWorkMode = MODE_AUTO) Then
cmdLampOn.Enabled = False
cmdLampOff.Enabled = False
cmdRingOn.Enabled = False
cmdRingOff.Enabled = False
cmdInq.Enabled = False
Else
cmdLampOn.Enabled = True
cmdLampOff.Enabled = True
cmdRingOn.Enabled = True
cmdRingOff.Enabled = True
cmdInq.Enabled = True
End If
End Sub
Public Sub SetTcpStatus()
If tcpWinsock.State <> 7 Then
imgNotConnected.ZOrder
timerIn.Enabled = False
Else
imgConnected.ZOrder
If nWorkMode = MODE_AUTO Then timerIn.Enabled = True
End If
DisplayCmd
StatusBar1.Panels("TcpStatus").Text = "Status: " + RemoteHost + ":" + _
ts(RemotePort) + " / " + GetWinSockState(tcpWinsock)
StatusBar1.Panels("Address").Text = "ADD: " + strADDress
StatusBar1.Panels("tInterval").Text = "Interval: " + _
Trim(Str(timerIn.Interval) \ 1000) + "S"
End Sub
Private Sub cmdClose_Click()
tcpWinsock.Close
timerComm.Enabled = False
timerIn.Enabled = False
Unload Me
End Sub
Private Sub DisplayStatus(bData As Byte)
Dim I As Integer
Dim bInput As Byte
Dim bOut As Byte
Dim bSend As Boolean
Dim bControl As Byte
bInput = bData And &HF
bOut = bData And &H30
For I = 0 To 3
If (bData And (2 ^ I)) <> 0 Then
imgCar(I).Visible = True
Else
imgCar(I).Visible = False
End If
Next I
If (bData And (2 ^ 4)) <> 0 Then
optRing(0).Value = True
Else
optRing(1).Value = True
End If
If (bData And (2 ^ 5)) <> 0 Then
optLamp(0).Value = True
Else
optLamp(1).Value = True
End If
If nWorkMode = MODE_AUTO Then
Select Case bInput
Case 0
If bOut <> 0 Then
bControl = 0
bSend = True
End If
Case 1, 2, 4
If bOut <> &H20 Then
bControl = &H20
bSend = True
End If
Case 8
If bOut <> &H30 Then
bControl = &H30
bSend = True
End If
End Select
If bSend = True Then
tcpWinsock.SendData HexCharsToVariant(GetFullPackage(EOT + strADDress + WD + ByteToTwoHexChars(bControl), nBlockParity, nEndMark))
End If
End If
End Sub
Private Sub cmdInq_Click()
Dim strTmp As String
strTmp = EOT + strADDress + RD
tcpWinsock.SendData HexCharsToVariant(GetFullPackage(strTmp, nBlockParity, nEndMark))
End Sub
Private Sub cmdLampOff_Click()
Dim bTmp As Byte
bTmp = bStatus And &HDF
tcpWinsock.SendData HexCharsToVariant(GetFullPackage(EOT + strADDress + WD + ByteToTwoHexChars(bTmp), nBlockParity, nEndMark))
DelayTime 100
End Sub
Private Sub cmdLampOn_Click()
Dim bTmp As Byte
bTmp = bStatus Or &H20
tcpWinsock.SendData HexCharsToVariant(GetFullPackage(EOT + strADDress + WD + ByteToTwoHexChars(bTmp), nBlockParity, nEndMark))
DelayTime 100
End Sub
Private Sub cmdRingOff_Click()
Dim bTmp As Byte
bTmp = bStatus And &HEF
tcpWinsock.SendData HexCharsToVariant(GetFullPackage(EOT + strADDress + WD + ByteToTwoHexChars(bTmp), nBlockParity, nEndMark))
DelayTime 100
End Sub
Private Sub cmdRingOn_Click()
Dim bTmp As Byte
bTmp = bStatus Or &H10
tcpWinsock.SendData HexCharsToVariant(GetFullPackage(EOT + strADDress + WD + ByteToTwoHexChars(bTmp), nBlockParity, nEndMark))
DelayTime 100
End Sub
Private Sub cmdSetup_Click()
frmSetup.Show vbModal
End Sub
Private Sub Form_Load()
On Error Resume Next
SetWindowPos frmMain.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
Call initialPRJ
With tcpWinsock
.RemoteHost = GetSetting(App.Title, "Properties", "RemoteHost", "")
.RemotePort = GetSetting(App.Title, "Properties", "RemotePort", "")
RemoteHost = .RemoteHost
RemotePort = .RemotePort
End With
nEndMark = Val(GetSetting(App.Title, "Properties", "EndMark", ""))
nBlockParity = Val(GetSetting(App.Title, "Properties", "BlockParity", ""))
timerIn.Interval = Val(GetSetting(App.Title, "Properties", "lInterval", "")) * 1000
strADDress = GetSetting(App.Title, "Properties", "ADDress", "")
End Sub
Private Sub imgConnected_Click()
tcpWinsock.Close
bStatus = 0
DisplayStatus bStatus
End Sub
Private Sub imgNotConnected_Click()
If bSwitch = False Then
MsgBox "Please setup at first!", vbCritical + vbOKOnly
Exit Sub
End If
With tcpWinsock
.Close
.Protocol = sckTCPProtocol
.Connect
End With
If Err.Number <> 0 Then MsgBox Error$, vbCritical + vbOKOnly
bStatus = 0 'reset status
End Sub
Private Sub optMode_Click(Index As Integer)
If Index = 0 Then
nWorkMode = MODE_AUTO
Else
nWorkMode = MODE_MANUAL
timerIn.Enabled = False
End If
DisplayCmd
End Sub
Private Sub tcpWinsock_DataArrival(ByVal bytesTotal As Long)
Dim vInBuffer As Variant
On Error Resume Next
If TimerCommStartMark = False Then
Call initialPRJ 'This is the first package
TimerCommStartMark = True
End If
tcpWinsock.GetData vInBuffer
strRecHex = strRecHex + VariantToHexChars(vInBuffer)
'There is another package, so reset the commTimer.
If TimerCommStartMark = True Then
timerComm.Enabled = False
timerComm.Enabled = True
End If
End Sub
Private Sub timerComm_Timer()
Dim strTmp As String
On Error Resume Next
timerComm.Enabled = False
TimerCommStartMark = False
If CheckPackage(strRecHex, nBlockParity, nEndMark) = False Then Exit Sub
If Not (Mid(strRecHex, 1, 2) = STX And Mid(strRecHex, 3, 2) = _
strADDress) Then Exit Sub
If Len(strRecHex) / 2 <> nReplyLen Then Exit Sub
strTmp = Mid(strRecHex, 5, 2)
bStatus = TwoHexCharsToByte(strTmp)
DisplayStatus bStatus
End Sub
Private Sub timerIn_Timer()
Dim strTmp As String
If tcpWinsock.State <> 7 Then Exit Sub
strTmp = EOT + strADDress + RD
tcpWinsock.SendData HexCharsToVariant(GetFullPackage(strTmp, nBlockParity, nEndMark))
End Sub
Private Sub timerStatus_Timer()
SetTcpStatus
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -