📄 frmwik.frm
字号:
Stretch = -1 'True
Top = 6840
Visible = 0 'False
Width = 450
End
Begin VB.Image Image3
Height = 450
Index = 1
Left = 14280
Picture = "FrmWIK.frx":275CE0
Stretch = -1 'True
Top = 6360
Visible = 0 'False
Width = 450
End
Begin VB.Image Image3
Height = 450
Index = 0
Left = 14400
Picture = "FrmWIK.frx":281BA4
Stretch = -1 'True
Top = 5880
Visible = 0 'False
Width = 450
End
Begin VB.Image Image2
Height = 450
Index = 5
Left = 14400
Picture = "FrmWIK.frx":28DBE8
Stretch = -1 'True
Top = 4800
Visible = 0 'False
Width = 450
End
Begin VB.Image Image2
Height = 450
Index = 4
Left = 14400
Picture = "FrmWIK.frx":299C2C
Stretch = -1 'True
Top = 4320
Visible = 0 'False
Width = 450
End
Begin VB.Image Image2
Height = 450
Index = 3
Left = 14400
Picture = "FrmWIK.frx":2A5AF0
Stretch = -1 'True
Top = 3840
Visible = 0 'False
Width = 450
End
Begin VB.Image Image2
Height = 450
Index = 2
Left = 14280
Picture = "FrmWIK.frx":2B1B34
Stretch = -1 'True
Top = 3480
Visible = 0 'False
Width = 450
End
Begin VB.Image Image2
Height = 450
Index = 1
Left = 14400
Picture = "FrmWIK.frx":2C1B78
Stretch = -1 'True
Top = 3000
Visible = 0 'False
Width = 450
End
Begin VB.Image Image2
Height = 450
Index = 0
Left = 14280
Picture = "FrmWIK.frx":2CDA3C
Stretch = -1 'True
Top = 2520
Visible = 0 'False
Width = 450
End
Begin VB.Image Image1
Height = 1695
Index = 5
Left = 10080
MouseIcon = "FrmWIK.frx":2D9A80
MousePointer = 99 'Custom
Picture = "FrmWIK.frx":2DA74A
Stretch = -1 'True
Top = 4200
Width = 1695
End
Begin VB.Label Label27
Alignment = 2 'Center
BackStyle = 0 'Transparent
BeginProperty Font
Name = "宋体"
Size = 24
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800080&
Height = 855
Left = 4080
TabIndex = 71
Top = 6840
Width = 7335
End
Begin VB.Image Image1
Height = 1695
Index = 4
Left = 8160
MouseIcon = "FrmWIK.frx":2E678E
MousePointer = 99 'Custom
Picture = "FrmWIK.frx":2E7458
Stretch = -1 'True
Top = 2400
Width = 1695
End
Begin VB.Image Image1
Height = 1695
Index = 3
Left = 11280
MouseIcon = "FrmWIK.frx":2F331C
MousePointer = 99 'Custom
Picture = "FrmWIK.frx":2F3FE6
Stretch = -1 'True
Top = 6360
Width = 1695
End
Begin VB.Image Image1
Height = 1695
Index = 2
Left = 5520
MouseIcon = "FrmWIK.frx":30002A
MousePointer = 99 'Custom
Picture = "FrmWIK.frx":300CF4
Stretch = -1 'True
Top = 2400
Width = 1695
End
Begin VB.Image Image1
Height = 1695
Index = 1
Left = 2400
MouseIcon = "FrmWIK.frx":310D38
MousePointer = 99 'Custom
Picture = "FrmWIK.frx":311A02
Stretch = -1 'True
Top = 6360
Width = 1695
End
Begin VB.Image Image1
Height = 1695
Index = 0
Left = 3600
MouseIcon = "FrmWIK.frx":31D8C6
MousePointer = 99 'Custom
Picture = "FrmWIK.frx":31E590
Stretch = -1 'True
Top = 4200
Width = 1695
End
End
Attribute VB_Name = "FrmWIK"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'***************************************************************************
http://www.codesky.net 源码天空
'***************************************************************************
'-------------------------------------------------------------
Const HH_DISPLAY_TOPIC = &H0
Const HH_DISPLAY_INDEX = &H2
Const HH_HELP_CONTEXT = &HF
Const HH_DISPLAY_SEARCH = &H3
Const HH_DISPLAY_TEXT_POPUP = &HE
Private Declare Function Htmlhelp Lib "hhctrl.ocx" Alias "HtmlHelpA" _
(ByVal hwndCaller As Long, _
ByVal pszFile As String, _
ByVal uCommand As Long, _
ByVal dwData As Any) As Long
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
'-------------------------------------------------------------------
Dim RxData() As Byte
Dim RxData_Temp(14, 17) As Integer ' COM=23H临时帧，拼接用(HUB索引,DATA)
Dim 拼帧接址(14) As Integer ' (HUB索引)
Dim nn As Integer
Dim b() As String
'------------------------------------------------
Dim rgbs As Long
'-----------------------------------------------
Private Sub Form_Initialize()
InitCommonControls
End Sub
'-----------------------------------------------
Private Sub Form_Load()
On Error GoTo errs '添加部分，防止没有找到串口
'-------------------------------------
Picture2.BackColor = RGB(228, 228, 255)
Picture3.BackColor = RGB(228, 228, 255)
Picture4.BackColor = RGB(228, 228, 255)
Picture5.BackColor = RGB(228, 228, 255)
'-----------------------------------------
Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
' Me.Width = 10530
' Me.Height = 9165
'sckListen是侦听控件
sckListen.LocalPort = 6006
sckListen.Listen '开始侦听
Call 清除
Text9 = "2"
Text27 = "0"
'================================================
'-------- 初始化串口并打开 -------------
MSComm2.CommPort = 1
MSComm2.Settings = "9600,N,8,1"
MSComm2.RThreshold = 70 '满70字节产生 OnComm 事件
'MSComm2.InputLen = 9 '每次从输入缓存中读取9字节
MSComm2.InputLen = 0 '每次从输入缓存中读取全部字节
MSComm2.InBufferCount = 0 '清0接收缓区
MSComm2.PortOpen = True
'----------------------------------------------------------
Exit Sub
errs:
MsgBox "没有发现可用的串口", vbCritical, "消息"
End Sub
'------------------------------------------------------------------------
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Label27.Caption = ""
For i = 0 To 5
Image1(i).Picture = Image2(i)
Next
End Sub
'--------------------------------------------------------
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
If Shift = 2 And KeyCode = vbKeyD Then Image1_Click (0)
If Shift = 2 And KeyCode = vbKeyH Then Image1_Click (1)
If Shift = 2 And KeyCode = vbKeyS Then Image1_Click (2)
If Shift = 2 And KeyCode = vbKeyX Then Image1_Click (3)
If Shift = 2 And KeyCode = vbKeyA Then Image1_Click (4)
If Shift = 2 And KeyCode = vbKeyI Then Image1_Click (5)
End Sub
'---------------------------------------------------------------------
Private Sub Image1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
Select Case Index
Case 0
Image1(0).ToolTipText = "设置DDC控制器"
Label27.Caption = "设置DDC控制器(&D)"
Image1(0).Picture = Image3(0)
Case 1
Image1(1).ToolTipText = "帮助"
Label27.Caption = "帮助(&H)"
Image1(1).Picture = Image3(1)
Case 2
Image1(2).ToolTipText = "初始化客房控制器"
Label27.Caption = "初始化客房控制器(&S)"
Image1(2).Picture = Image3(2)
Case 3
Image1(3).ToolTipText = "退出系统"
Label27.Caption = "退出系统(&X)"
Image1(3).Picture = Image3(3)
Case 4
Image1(4).ToolTipText = "全局设置客房状态"
Label27.Caption = "全局设置客房状态(&A)"
Image1(4).Picture = Image3(4)
Case 5
Image1(5).ToolTipText = "显示及设置客房参数"
Label27.Caption = "显示及设置客房参数(&I)"
Image1(5).Picture = Image3(5)
End Select
End Sub
'--------------------------------------------------------------------------------------
Private Sub Image1_Click(Index As Integer)
Dim fLogin As New frmLogin
Select Case Index
Case 0
fLogin.Show vbModal
If fLogin.OK Then
Unload fLogin
Load DDC设置
DDC设置.Show 1
End If
Case 1
App.HelpFile = App.Path & "\HELP.CHM"
Call Htmlhelp(hWnd, App.HelpFile, HH_DISPLAY_TOPIC, ByVal "Login.htm")
Case 2
fLogin.Show vbModal
If fLogin.OK Then
Unload fLogin
Load FrmSETRCU
FrmSETRCU.Show 1
End If
Case 3
Form_Unload (0)
Case 4
fLogin.Show vbModal
If fLogin.OK Then
Unload fLogin
Load FrmSET
FrmSET.Show
End If
Case 5
fLogin.Show vbModal
If fLogin.OK Then
Unload fLogin
显示房态标志 = True
Load OSD_LISK
OSD_LISK.Show 1
End If
End Select
'Picture2.ZOrder
End Sub
'---------------------------------------------------------------------------------------
'串口2接收事件
Private Sub MSComm2_OnComm()
If MSComm2.CommEvent = 2 Then '满70字节 CommEvent = 2
Timer1.Enabled = True
End If
End Sub
Private Sub Timer1_Timer()
Timer1.Enabled = False
Dim 串口接收串 As String, J As Byte, 房 As String
' Text28 = MSComm2.InBufferCount ' 显示串长
串口接收串 = MSComm2.Input
' Text26 = 串口接收串 ' 显示串
'------------------------------------------------------------------------
If InStr(30, 串口接收串, "KD") <> 0 Then 'checkout
J = InStr(串口接收串, "RN")
If J <> 0 Then
房 = Mid(串口接收串, J + 2, 4) 'j=RN的位置
Call checkout(房)
End If
End If
'------------------------------------------------------------------------
If InStr(30, 串口接收串, "KR") <> 0 Then 'checkin
J = InStr(串口接收串, "RN")
If J <> 0 Then
房 = Mid(串口接收串, J + 2, 4) 'j=RN的位置
Call checkin(房)
End If
End If
'-----------------------------------------------------------------------
End Sub
Private Sub checkout(房 As String) '待租
' Text28 = "out" + 房
If 根据房号SS求SData地址(房) = True Then
ReDim TxData(6) '重定义维数
TxData(0) = &HFF
TxData(1) = 5 'len
TxData(2) = T_Rcu_Adr
TxData(3) = &H22 'com
TxData(4) = 1 'lisk
TxData(5) = 0
TxData(6) = 0
If Winsock1(T_Hub_Adr).State = sckConnected Then
Winsock1(T_Hub_Adr).SendData TxData() '如已连拨则发送
End If
End If
End Sub
Private Sub checkin(房 As String) '出租
' Text28 = "in" + 房
If 根据房号SS求SData地址(房) = True Then
ReDim TxData(6) '重定义维数
TxData(0) = &HFF
TxData(1) = 5 'len
TxData(2) = T_Rcu_Adr
TxData(3) = &H22 'com
TxData(4) = 2 'lisk
TxData(5) = 0
TxData(6) = 0
If Winsock1(T_Hub_Adr).State = sckConnected Then
Winsock1(T_Hub_Adr).SendData TxData() '如已连拨则发送
End If
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
sckListen.Close
For i = 0 To 15
Winsock1(i).Close
Next
Unload Me
End Sub
Private Sub sckListen_ConnectionRequest(ByVal requestID As Long)
Dim IP_adr As String, S As String, i As Byte
IP_adr = sckListen.RemoteHostIP '=192.168.0.7 >>
Text24 = Text24 + IP_adr + Chr(10) + Chr(13)
i = 255
If IP_adr = "192.168.0.7" Then i = 0
If IP_adr = "192.168.0.8" Then i = 1
If IP_adr = "192.168.0.9" Then i = 2
If IP_adr = "192.168.0.10" Then i = 3
If IP_adr = "192.168.0.11" Then i = 4
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -