prjbas.bas

来自「电梯检测系统是对电梯性能进行检测的系统。是一个用来学习的程序。」· BAS 代码 · 共 1,871 行 · 第 1/5 页

BAS
1,871 行
字号
12345
Attribute VB_Name = "PrjBas"
Option Explicit
Public Function AutoLightFan() As Boolean
  Dim cTime
  Dim CurSendSucc As Boolean
  
  'FrmFuncTest.ButtonImg(1).Visible = False
  'FrmFuncTest.TitleLabel(13).Visible = False
  'FrmFuncTest.ButtonImg(2).Visible = False
  'FrmFuncTest.TitleLabel(12).Visible = False
  'FrmFuncTest.ButtonImg(3).Visible = False
  'FrmFuncTest.TitleLabel(14).Visible = False
  'FrmFuncTest.ButtonImg(4).Visible = False
  'FrmFuncTest.TitleLabel(11).Visible = False
  'FrmFuncTest.ButtonImg(9).Visible = False
  'FrmFuncTest.TitleLabel(18).Visible = False
  'FrmFuncTest.ButtonImg(10).Visible = False
  'FrmFuncTest.TitleLabel(15).Visible = False
 ' FrmFuncTest.ButtonImg(11).Visible = False
 ' FrmFuncTest.TitleLabel(17).Visible = False
 ' FrmFuncTest.ButtonImg(12).Visible = False
 ' FrmFuncTest.TitleLabel(16).Visible = False
  FrmFuncTest.Frame2(0).Visible = False
  FrmFuncTest.Frame2(2).Visible = False
  FrmFuncTest.BackLabel(0).Visible = False
  FrmFuncTest.BackLabel(5).Visible = False
  
  AutoLightFan = True
  FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Now begin the Automatic car light and fan." & Chr(10) & Chr(13)
  FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Sending a car call." & Chr(10) & Chr(13)
  'make the car move and send a landing call
    If NowMoveFx = "S" Then
      If Not (SignalBitRight(LngVRetAryB, 2, 1)) Then
       'set DT-S to 1
        CurSendSucc = False
        cTime = Timer
        Do Until Timer - cTime > 2
          If bolWritePlcB_05(iDeviceID, DT_S, &HFF) Then
            CurSendSucc = True
            Exit Do
          End If
        Loop
        If Not CurSendSucc Then
          FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Handshake failed! Exit test!"
          AutoLightFan = False
          Exit Function
        End If
        'set DT-O to 0
        CurSendSucc = False
        cTime = Timer
        Do Until Timer - cTime > 2
          If bolWritePlcB_05(iDeviceID, DT_S, &H0) Then
            CurSendSucc = True
            Exit Do
          End If
        Loop
        If Not CurSendSucc Then
          FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Handshake failed! Exit test!"
          AutoLightFan = False
          Exit Function
        End If
      End If
      'detect KET-S
      CurRecSucc = False
      cTime = Timer
      Do Until Timer - cTime > 10
        If SignalBitRight(LngVRetAryB, 2, 1) Then  'KET-S
           CurRecSucc = True
           Exit Do
        End If
      Loop
      If CountNum >= MaxCount - 100 Then
        'set DC-1 to 1
        CurSendSucc = False
        cTime = Timer
        Do Until Timer - cTime > 2
          If bolWritePlcB_05(iDeviceID, DC_1Addr, &HFF) Then
            CurSendSucc = True
            Exit Do
          End If
        Loop
        If Not CurSendSucc Then
          FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Handshake failed! Exit test!"
          AutoLightFan = False
          Exit Function
        End If
        'set DC-1 to 0
        CurSendSucc = False
        cTime = Timer
        Do Until Timer - cTime > 2
          If bolWritePlcB_05(iDeviceID, DC_1Addr, &HFF) Then
            CurSendSucc = True
            Exit Do
          End If
        Loop
        If Not CurSendSucc Then
          FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Handshake failed! Exit test!"
          AutoLightFan = False
          Exit Function
        End If
      Else
        'set DC-3 to 1
        CurSendSucc = False
        cTime = Timer
        Do Until Timer - cTime > 2
          If bolWritePlcB_05(iDeviceID, DC_3Addr, &HFF) Then
            CurSendSucc = True
            Exit Do
          End If
        Loop
        If Not CurSendSucc Then
          FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Handshake failed! Exit test!"
          AutoLightFan = False
          Exit Function
        End If
        'set DC-3 to 0
        CurSendSucc = False
        cTime = Timer
        Do Until Timer - cTime > 2
          If bolWritePlcB_05(iDeviceID, DC_3Addr, &HFF) Then
            CurSendSucc = True
            Exit Do
          End If
        Loop
        If Not CurSendSucc Then
          FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Handshake failed! Exit test!"
          AutoLightFan = False
          Exit Function
        End If
      End If
  Else
   If NowMoveFx = "U" Then
     'set DC-3 to 1
     CurSendSucc = False
     cTime = Timer
     Do Until Timer - cTime > 2
       If bolWritePlcB_05(iDeviceID, DC_3Addr, &HFF) Then
         CurSendSucc = True
         Exit Do
       End If
     Loop
        If Not CurSendSucc Then
          FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Handshake failed! Exit test!"
          AutoLightFan = False
          Exit Function
        End If
     'set DC-3 to 0
     CurSendSucc = False
     cTime = Timer
     Do Until Timer - cTime > 2
       If bolWritePlcB_05(iDeviceID, DC_3Addr, &HFF) Then
         CurSendSucc = True
         Exit Do
       End If
     Loop
        If Not CurSendSucc Then
          FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Handshake failed! Exit test!"
          AutoLightFan = False
          Exit Function
        End If
   Else
      'set DC-1 to 1
      CurSendSucc = False
      cTime = Timer
      Do Until Timer - cTime > 2
        If bolWritePlcB_05(iDeviceID, DC_1Addr, &HFF) Then
          CurSendSucc = True
          Exit Do
        End If
      Loop
        If Not CurSendSucc Then
          FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Handshake failed! Exit test!"
          AutoLightFan = False
          Exit Function
        End If
      'set DC-1 to 0
      CurSendSucc = False
      cTime = Timer
      Do Until Timer - cTime > 2
        If bolWritePlcB_05(iDeviceID, DC_1Addr, &HFF) Then
          CurSendSucc = True
          Exit Do
        End If
      Loop
        If Not CurSendSucc Then
          FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Handshake failed! Exit test!"
          AutoLightFan = False
          Exit Function
        End If
   End If
 End If

  FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Switching light on" & Chr(10) & Chr(13)
  CurSendSucc = False
  cTime = Timer
  Do Until Timer - cTime > 2
    If bolWritePlcB_05(iDeviceID, LIGHTAddr, &HFF) Then
      FrmFuncTest.Image4.Picture = LoadPicture(App.Path & "\button\light.gif")
      FrmFuncTest.Image6.Picture = LoadPicture(App.Path & "\button\light.gif")
      CurSendSucc = True
      FrmFuncTest.toggle(5).Picture = LoadPicture(App.Path & "\button\switchon.gif")
      Exit Do
    End If
  Loop
  If Not CurSendSucc Then
    FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Handshake failed! Exit test!"
    AutoLightFan = False
    Exit Function
  End If
  FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Switching fan on" & Chr(10) & Chr(13)
  CurSendSucc = False
  cTime = Timer
  Do Until Timer - cTime > 2
    If bolWritePlcB_05(iDeviceID, FANAddr, &HFF) Then
      FrmFuncTest.PlayAni "FAN", True
      CurSendSucc = True
      FrmFuncTest.toggle(2).Picture = LoadPicture(App.Path & "\button\switchon.gif")
      Exit Do
    End If
  Loop
  If Not CurSendSucc Then
    FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Handshake failed! Exit test!"
    AutoLightFan = False
    Exit Function
  End If
  'waiting for the car stop
  Do Until NowMoveFx = "S"
    DoEvents
  Loop
  'one minute later
  cTime = Timer
  Do Until Timer - cTime > 60
    DoEvents
  Loop
  'check whether the light or fan be switched off
  If SignalBitRight(LngVRetAryB, 81, 0) Then 'LC
    FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Light switched off." & Chr(10) & Chr(13)
    FrmFuncTest.Image4.Picture = LoadPicture(App.Path & "\button\lightoff.gif")
    FrmFuncTest.Image6.Picture = LoadPicture(App.Path & "\button\lightoff.gif")
    FrmFuncTest.toggle(5).Picture = LoadPicture(App.Path & "\button\SwitchOff.gif")
  Else
    FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Light did not switch off.Automatic light and fan test failed.Exit test." & Chr(10) & Chr(13)
    AutoLightFan = False
    Exit Sub
  End If
  If SignalBitRight(LngVRetAryB, 82, 0) Then 'MVEC
    FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Fan switched off." & Chr(10) & Chr(13)
    FrmFuncTest.PlayAni "FAN", False
    FrmFuncTest.toggle(2).Picture = LoadPicture(App.Path & "\button\switchoff.gif")
  Else
    FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Fan did not switch off.Automatic light and fan test failed.Exit test." & Chr(10) & Chr(13)
    AutoLightFan = False
    Exit Sub
  End If
  
  FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "If all are right, click Yes commandbutton,Or click No commandbutton." & Chr(10) & Chr(13)
  Do Until YesCmdClick
    DoEvents
  Loop
  If FuncTestPass Then
    FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Automatic car light and fan Complished!" & Chr(10) + Chr(13)
    AutoLightFan = True
  Else
    FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Automatic car light and fan failed" & Chr(10) + Chr(13)
    AutoLightFan = False
  End If
End Function
Public Function DoorTestbak() As Boolean
  
   Dim cTime
   Dim CurSendSucc As Boolean, CurRecSucc As Boolean
  
  'ButtonImg(1).Visible = False
  'TitleLabel(13).Visible = False
 ' ButtonImg(2).Visible = False
'  TitleLabel(12).Visible = False
 ' ButtonImg(3).Visible = False
'  TitleLabel(14).Visible = False
'  ButtonImg(4).Visible = False
'  TitleLabel(11).Visible = False
'  ButtonImg(9).Visible = False
'  TitleLabel(18).Visible = False
'  ButtonImg(10).Visible = False
'  TitleLabel(15).Visible = False
  'ButtonImg(11).Visible = False
  'TitleLabel(17).Visible = False
 ' ButtonImg(12).Visible = False
  'TitleLabel(16).Visible = False
  FrmFuncTest.Frame2(0).Visible = False
  FrmFuncTest.Frame2(2).Visible = False
'  Frame2(1).Visible = False
  FrmFuncTest.BackLabel(0).Visible = False
  FrmFuncTest.BackLabel(5).Visible = False
'  BackLabel(4).Visible = False

  FrmFuncTest.TestText.Text = "Now begin the Door Test." & Chr(10)
  FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Sending a DT-O signal,make sure the door opened." & Chr(10) & Chr(13)
  'set DT-O to 1
  CurSendSucc = False
    If bolWritePlcB_05(iDeviceID, DT_O, &HFF) Then
      CurSendSucc = True
    End If
  If Not CurSendSucc Then
    FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "  Handshake failed! Exit test!"
    DoorTest = False
    Exit Function
  End If
  'set DT-O to 0
  cTime = Timer
  Do Until Timer - cTime > 1
    CurSendSucc = False
      If bolWritePlcB_05(iDeviceID, DT_O, &H0) Then
        CurSendSucc = True
        Exit Do
      End If
  Loop
  If Not CurSendSucc Then
    FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "  Handshake failed! Exit test!"
    DoorTest = False
    Exit Function
  End If
  'detect KET-O
  CurRecSucc = False
  cTime = Timer
  Do Until Timer - cTime > 10
    DoEvents
    'FrmFuncTest.CommTimer_Timer
    If SignalBitRight(LngVRetAryB, 1, 0) Then  'KET-O
       CurRecSucc = True
       Exit Do
    End If
  Loop
  
  If Not CurRecSucc Then
    FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Error in detect KET-O signal, the door can not be open.Exit test." & Chr(10) & Chr(13)
    DoorTest = False
    
    Exit Function
  End If
  
  FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Sending a DT-S signal,make sure the door opened." & Chr(10) & Chr(13)
  'set DT-S to 1
  CurSendSucc = False
    If bolWritePlcB_05(iDeviceID, DT_S, &HFF) Then
      CurSendSucc = True
    End If
  If Not CurSendSucc Then
    FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Handshake failed! Exit test!"
    DoorTest = False
    Exit Function
  End If
  'set DT-O to 0
  CurSendSucc = False
    If bolWritePlcB_05(iDeviceID, DT_S, &H0) Then
      CurSendSucc = True
    End If
  If Not CurSendSucc Then
    FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Handshake failed! Exit test!"
    DoorTest = False
    Exit Function
  End If
  'detect KET-S
  CurRecSucc = False
  cTime = Timer
  Do Until Timer - cTime > 10
    DoEvents
    FrmFuncTest.CommTimer_Timer
    If SignalBitRight(LngVRetAryB, 2, 1) Then  'KET-S
       CurRecSucc = True
       Exit Do
    End If
  Loop
  If Not CurRecSucc Then
    FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Error in detect KET-S signal, the door can not be closed.Exit test." & Chr(10) & Chr(13)
    DoorTest = False
12345

prjbas.bas - 源码说明

本页面展示了「电梯检测系统是对电梯性能进行检测的系统。是一个用来学习的程序。」中的 prjbas.bas 源码文件，采用 BAS 编程语言编写，共 1,871 行代码。您可以在线阅读完整代码内容，也可以返回资源详情页下载完整源码包进行本地学习和开发。

虫虫下载站收录了大量与电梯相关的技术资源，包括源代码、技术文档、电路图等，是电子工程师和嵌入式开发者的专业学习平台。

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?