ddc设置.frm

酒店管理系统

        指令.启动分 = MSFlexGrid1.Text
        MSFlexGrid1.Col = 5
        指令.关闭时 = MSFlexGrid1.Text 't2
        MSFlexGrid1.Col = 6
        指令.关闭分 = MSFlexGrid1.Text
          Put #3, Ci + Adr_File, 指令
       Next
     Close #3                      ' 关闭文件
End Sub

Private Sub Form_Load()
'--------------------------
MSFlexGrid1.BackColorBkg = RGB(228, 228, 255)
'MSFlexGrid1.BackColorFixed = RGB(228, 228, 255)
Picture1.BackColor = RGB(228, 228, 255)
Me.BackColor = RGB(228, 228, 255)
Frame1.BackColor = RGB(228, 228, 255)
Frame2.BackColor = RGB(228, 228, 255)
Frame3.BackColor = RGB(228, 228, 255)
Frame4.BackColor = RGB(228, 228, 255)
MSFlexGrid1.GridColorFixed = RGB(228, 228, 255)
Frame6.BackColor = RGB(228, 228, 255)
Frame7.BackColor = RGB(228, 228, 255)
Frame8.BackColor = RGB(228, 228, 255)
Check1.BackColor = RGB(228, 228, 255)
Check2.BackColor = RGB(228, 228, 255)
Check3.BackColor = RGB(228, 228, 255)
Check4.BackColor = RGB(228, 228, 255)
Check5.BackColor = RGB(228, 228, 255)
Check6.BackColor = RGB(228, 228, 255)
Check7.BackColor = RGB(228, 228, 255)
Check8.BackColor = RGB(228, 228, 255)
Check9.BackColor = RGB(228, 228, 255)
Check10.BackColor = RGB(228, 228, 255)
Check11.BackColor = RGB(228, 228, 255)
Check12.BackColor = RGB(228, 228, 255)
Check13.BackColor = RGB(228, 228, 255)
Check14.BackColor = RGB(228, 228, 255)
Check15.BackColor = RGB(228, 228, 255)
Check16.BackColor = RGB(228, 228, 255)
Picture2.BackColor = RGB(228, 228, 255)
Picture3.BackColor = RGB(228, 228, 255)
Picture4.BackColor = RGB(228, 228, 255)
Picture5.BackColor = RGB(228, 228, 255)
Picture6.BackColor = RGB(228, 228, 255)
Picture7.BackColor = RGB(228, 228, 255)
'---------------------------
Me.Height = 9075
Me.Width = 12000
Picture7.Width = 6050
 Move Screen.Width / 2 - Width / 2, Screen.Height / 2 - Height / 2 - 900
'================================================================
If Dir("d:\data\DDC.dat", 0) = "" Then
    '----------- 新建密码文件 ------------------
       指令.模式 = ""
       指令.输出口 = ""
      指令.启动时 = ""
      指令.启动分 = ""
     指令.关闭时 = ""
     指令.关闭分 = ""
     Open "d:\data\abc_DDC.dat" For Random As #2 Len = Len(指令)
       For Ci = 1 To 12500
          Put #2, Ci, 指令
       Next
     Close #2                       ' 关闭文件
 End If
 '==================================================================
i = 0
本机地址 = &HFC
目的地址 = 1
 '*************************************************************************
    MSFlexGrid1.Width = 6000
    Shape2.Width = 6030
    MSFlexGrid1.Cols = 7                  ' 置表最大列数
    MSFlexGrid1.Rows = 51                ' 置表最大行数
'**************************************************
  '  MSFlexGrid1.ColWidth(0) = 610  ' 置列宽
  '  MSFlexGrid1.ColAlignment(0) = 4   '指定列居中显示
    For i = 0 To 6
      MSFlexGrid1.ColWidth(i) = 810  '置列宽
      MSFlexGrid1.ColAlignment(i) = 4   '指定列居中显示
    Next
 '***************************************************
    For i = 0 To 50
      MSFlexGrid1.RowHeight(i) = 300   '置行高
    Next
  '***************************************************
   MSFlexGrid1.Row = 0      ' 置当前行
   '--------------------------------------
   MSFlexGrid1.Col = 0
   MSFlexGrid1.Text = "指令号"
   '--------------------------------------
   MSFlexGrid1.Col = 1
   MSFlexGrid1.Text = "模式 "
    '-------------------------------------
   MSFlexGrid1.Col = 2
   MSFlexGrid1.Text = "输出口"
    '-------------------------------------
   MSFlexGrid1.Col = 3
   MSFlexGrid1.Text = "启动时"
    '-------------------------------------
   MSFlexGrid1.Col = 4
   MSFlexGrid1.Text = "启动分"
  '-------------------------------------
   MSFlexGrid1.Col = 5
   MSFlexGrid1.Text = "关闭时"
  '-------------------------------------
   MSFlexGrid1.Col = 6
   MSFlexGrid1.Text = "关闭分"
 '***************************************************
    MSFlexGrid1.Col = 0      ' 置当前列
     For i = 1 To 50
        MSFlexGrid1.Row = i        ' 置当前行
        MSFlexGrid1.Text = i
     Next
  '*************************************************
End Sub
'Private Sub 收到本机帧()
 Sub 收到本机帧()
Select Case RxDDC(4)
Case &H40
   MsgBox "通讯测试正常", vbOKOnly, "消息"
Case &H41
   MsgBox "写时钟成功", vbOKOnly, "消息"
Case &H42
    Text19 = Str(2000 + RxDDC(6)) + "-" + Str(RxDDC(7)) + "-" + Str(RxDDC(8))
    Text20 = Str(RxDDC(9)) + ":" + Str(RxDDC(10)) + ":" + Str(RxDDC(11))
    Text22 = Str(RxDDC(12))
 Case &H44
    If (RxDDC(7) + RxDDC(8) + RxDDC(9) + RxDDC(10) + RxDDC(11) + RxDDC(12)) <> 0 Then
        MSFlexGrid1.Row = RxDDC(6)   'com_n  置当前行
        MSFlexGrid1.Col = 1     ' 置当前列
        MSFlexGrid1.Text = Str(RxDDC(7)) 'MOD
        MSFlexGrid1.Col = 2
        MSFlexGrid1.Text = Str(RxDDC(8))   'JQ_n
        MSFlexGrid1.Col = 3
        MSFlexGrid1.Text = Str(RxDDC(9)) 'T1
        MSFlexGrid1.Col = 4
        MSFlexGrid1.Text = Str(RxDDC(10))
        MSFlexGrid1.Col = 5
        MSFlexGrid1.Text = Str(RxDDC(11)) 't2
        MSFlexGrid1.Col = 6
        MSFlexGrid1.Text = Str(RxDDC(12))
     End If
Case &H45
  MsgBox "强制输出成功", vbOKOnly, "消息"
Case &H46
  Call 显示输出状态
  MsgBox "读输出状态成功", vbOKOnly, "消息"
Case &H47
  MsgBox "写DDC模块地址成功", vbOKOnly, "消息"
Case Else
     
End Select
End Sub
Sub 显示输出状态()
     Check1.Value = 0
     Check2.Value = 0
     Check3.Value = 0
     Check4.Value = 0
     Check5.Value = 0
     Check6.Value = 0
     Check7.Value = 0
     Check8.Value = 0
     Check9.Value = 0
     Check10.Value = 0
     Check11.Value = 0
     Check12.Value = 0
     Check13.Value = 0
     Check14.Value = 0
     Check15.Value = 0
     Check16.Value = 0
    
    If (RxDDC(6) And &H1) <> 0 Then Check1.Value = 1
    If (RxDDC(6) And &H2) <> 0 Then Check2.Value = 1
    If (RxDDC(6) And &H4) <> 0 Then Check3.Value = 1
    If (RxDDC(6) And &H8) <> 0 Then Check4.Value = 1
    If (RxDDC(7) And &H1) <> 0 Then Check5.Value = 1
    If (RxDDC(7) And &H2) <> 0 Then Check6.Value = 1
    If (RxDDC(7) And &H4) <> 0 Then Check7.Value = 1
    If (RxDDC(7) And &H8) <> 0 Then Check8.Value = 1
    If (RxDDC(8) And &H1) <> 0 Then Check9.Value = 1
    If (RxDDC(8) And &H2) <> 0 Then Check10.Value = 1
    If (RxDDC(8) And &H4) <> 0 Then Check11.Value = 1
    If (RxDDC(8) And &H8) <> 0 Then Check12.Value = 1
    If (RxDDC(9) And &H1) <> 0 Then Check13.Value = 1
    If (RxDDC(9) And &H2) <> 0 Then Check14.Value = 1
    If (RxDDC(9) And &H4) <> 0 Then Check15.Value = 1
    If (RxDDC(9) And &H8) <> 0 Then Check16.Value = 1
End Sub

Private Sub MSFlexGrid1_DblClick()   ' 该条命令发送给模块
Dim d0 As Byte, d1 As Byte, d2 As Byte, d3 As Byte, d4 As Byte, d5 As Byte, d6 As Byte
  If MsgBox("您确认将该条命令发送给模块吗？", vbOKCancel + vbQuestion, "重要提醒") = vbOK Then
      d0 = MSFlexGrid1.Row  ' 当前行
     MSFlexGrid1.Col = 1     ' 置当前列
      d1 = Val(MSFlexGrid1.Text) 'MOD
     MSFlexGrid1.Col = 2
     d2 = Val(MSFlexGrid1.Text) 'JQ_n
     MSFlexGrid1.Col = 3
     d3 = Val(MSFlexGrid1.Text) 'T1
     MSFlexGrid1.Col = 4
      d4 = Val(MSFlexGrid1.Text)
     MSFlexGrid1.Col = 5
      d5 = Val(MSFlexGrid1.Text) 't2
     MSFlexGrid1.Col = 6
      d6 = Val(MSFlexGrid1.Text)
  Call 发送给DDC(11, &H43, d0, d1, d2, d3, d4, d5, d6)
  End If
End Sub

Sub MSFLexGrid1_KeyPress(KeyAscii As Integer)  ' EDIT  MSFLexGrid1
If MSFlexGrid1.Col <> 0 Then
    If KeyAscii >= &H30 And KeyAscii <= &H39 Then
       MSFlexGrid1.Text = MSFlexGrid1.Text + Chr(KeyAscii)
    ElseIf KeyAscii = 8 Then
       If MSFlexGrid1.Text <> "" Then
           MSFlexGrid1.Text = Left(MSFlexGrid1.Text, Len(MSFlexGrid1.Text) - 1)
       End If
    End If
  End If
 End Sub


Private Sub Text1_Change()  ' EDIT 目的地址
  目的地址 = Val(Text1.Text)
   Call 清表格
End Sub

Private Sub Timer1_Timer()  ' 刷新时钟
  Text17.Text = Format(Now, "yyyy/mm/dd")
  Text18.Text = Format(Now, "hh:mm:ss")
  Text21 = Weekday(Now) - 1         ' 星期=0
End Sub

Private Sub Timer2_Timer() '读1条命令
If Ti < 51 Then
    Label4 = "进度：" + Str(2 * Ti) + "%"
    ProgressBar1.Value = Ti
    Call 发送给DDC(5, &H44, Ti, 0, 0, 0, 0, 0, 0)
 Ti = Ti + 1
 Else
 Timer2.Enabled = False
 End If
End Sub

Private Sub Timer3_Timer()   '写1条命令
Dim d0 As Byte, d1 As Byte, d2 As Byte, d3 As Byte, d4 As Byte, d5 As Byte, d6 As Byte
If Ti < 51 Then
     MSFlexGrid1.Row = Ti   '置当前行
       d0 = Ti
     MSFlexGrid1.Col = 1     ' 置当前列
      d1 = Val(MSFlexGrid1.Text) 'MOD
     MSFlexGrid1.Col = 2
      d2 = Val(MSFlexGrid1.Text) 'JQ_n
     MSFlexGrid1.Col = 3
      d3 = Val(MSFlexGrid1.Text) 'T1
     MSFlexGrid1.Col = 4
      d4 = Val(MSFlexGrid1.Text)
     MSFlexGrid1.Col = 5
      d5 = Val(MSFlexGrid1.Text) 't2
     MSFlexGrid1.Col = 6
      d6 = Val(MSFlexGrid1.Text)
    '------------------------------------------------------------------
      Label4 = Str(2 * Ti) + "%"
      ProgressBar1.Value = Ti
    Call 发送给DDC(11, &H43, d0, d1, d2, d3, d4, d5, d6)
    '------------------------------------------------------------------
     Ti = Ti + 1
 Else
    Timer3.Enabled = False
 End If
End Sub

Private Sub Command1_Click()   ' 电脑时钟写入当前模块
   '============= 定义变量 ========================
   Dim A As Integer, b As Integer, c As Integer, d As Integer
   Dim h As Byte, m As Byte, S As Byte, i As Byte, BUF As Byte
    A = Year(Now) - 2000         ' 年
    b = Month(Now)                 ' 月
    c = Val(Format(Now, "d"))  ' 日
    h = Hour(Now)            '时
    m = Minute(Now)         '分
    S = Second(Now)          '秒
    d = Weekday(Now) - 1        ' 星期=0
  Call 发送给DDC(11, &H41, A, b, c, h, m, S, d)
End Sub

Private Sub Command2_Click()  '读出模块时钟
Call 发送给DDC(4, &H42, 0, 0, 0, 0, 0, 0, 0)
End Sub

Private Sub Command3_Click()  '缓冲区>>模块
  If MsgBox("您确认重写模块全部命令吗？", vbOKCancel + vbExclamation, "重要提醒") = vbOK Then
     Ti = 1
     Timer3.Enabled = True
  End If
End Sub

Private Sub Command4_Click()  '缓冲区<<模块
   Call 清表格
  Ti = 1
  Timer2.Enabled = True
End Sub
Private Sub Command5_Click()  '写临时JQ动作
Dim Out1 As Byte, Out2 As Byte, Out3 As Byte, Out4 As Byte
 If MsgBox("您确以要强行改变输出口状态吗？", vbOKCancel + vbExclamation, "重要提醒") = vbOK Then
 '-------------------------------------------------------
   If Check1.Value = 1 Then Out1 = 1
   If Check2.Value = 1 Then Out1 = Out1 + 2
   If Check3.Value = 1 Then Out1 = Out1 + 4
   If Check4.Value = 1 Then Out1 = Out1 + 8
  '-------------------------------------------------------
   If Check5.Value = 1 Then Out2 = 1
   If Check6.Value = 1 Then Out2 = Out2 + 2
   If Check7.Value = 1 Then Out2 = Out2 + 4
   If Check8.Value = 1 Then Out2 = Out2 + 8
  '-------------------------------------------------------
   If Check9.Value = 1 Then Out3 = 1
   If Check10.Value = 1 Then Out3 = Out3 + 2
   If Check11.Value = 1 Then Out3 = Out3 + 4
   If Check12.Value = 1 Then Out3 = Out3 + 8
  '-------------------------------------------------------
   If Check13.Value = 1 Then Out4 = 1
   If Check14.Value = 1 Then Out4 = Out4 + 2
   If Check15.Value = 1 Then Out4 = Out4 + 4
   If Check16.Value = 1 Then Out4 = Out4 + 8
  '-------------------------------------------------------
  Call 发送给DDC(8, &H45, Out1, Out2, Out3, Out4, 0, 0, 0)
  '-----------------------------------------------------------------------
  End If
End Sub
Private Sub Command6_Click() '通讯测试
Call 发送给DDC(4, &H40, 0, 0, 0, 0, 0, 0, 0)
End Sub
Private Sub Command7_Click()  '读当前JQ
 Call 发送给DDC(4, &H46, 0, 0, 0, 0, 0, 0, 0)
End Sub

Private Sub 清表格()
 MSFlexGrid1.Visible = False
     For i = 1 To 50
        MSFlexGrid1.Row = i        ' 置当前行
        MSFlexGrid1.Col = 1         ' 置当前列
        MSFlexGrid1.Text = ""
        MSFlexGrid1.Col = 2
        MSFlexGrid1.Text = ""
        MSFlexGrid1.Col = 3
        MSFlexGrid1.Text = ""
        MSFlexGrid1.Col = 4
        MSFlexGrid1.Text = ""
        MSFlexGrid1.Col = 5
        MSFlexGrid1.Text = ""
        MSFlexGrid1.Col = 6
        MSFlexGrid1.Text = ""
     Next
  MSFlexGrid1.Visible = True
End Sub
Private Sub 发送给DDC(ByVal L As Byte, ByVal Com As Byte, _
      ByVal d0 As Byte, ByVal d1 As Byte, ByVal d2 As Byte, _
      ByVal d3 As Byte, ByVal d4 As Byte, ByVal d5 As Byte, ByVal d6 As Byte)
'************  计算并添加xor，并发送 *********************************
 ReDim TxDDC(0 To L + 1) As Byte
  Dim BUF As Byte
    TxDDC(0) = &HFF
    TxDDC(1) = L       'len
    TxDDC(2) = 本机地址
    TxDDC(3) = 目的地址
    TxDDC(4) = Com
    If L > 4 Then TxDDC(5) = d0
    If L > 5 Then TxDDC(6) = d1
    If L > 6 Then TxDDC(7) = d2
    If L > 7 Then TxDDC(8) = d3
    If L > 8 Then TxDDC(9) = d4
    If L > 9 Then TxDDC(10) = d5
    If L > 10 Then TxDDC(11) = d6
 '--------- xor ------------------------------
      BUF = TxDDC(2)
       For i = 3 To L
           BUF = BUF Xor TxDDC(i)
       Next
       TxDDC(L + 1) = BUF
  '-------------------------------------------
     If FrmWIK.Winsock1(15).State = sckConnected Then
        FrmWIK.Winsock1(15).SendData TxDDC()   '如已连拨则发送
    End If
 End Sub