prjbas.bas

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

BAS
1,871 行
字号
12345
    Exit Function
  End If
  
  FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "If all are right, click Yes commandbutton,Or click No commandbutton."
  Do Until YesCmdClick
    DoEvents
  Loop
  If FuncTestPass Then
    FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "DoorTest Trip Complished!" & Chr(10) + Chr(13)
    DoorTest = True
  Else
    FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "DoorTest Trip failed" & Chr(10) + Chr(13)
    DoorTest = False
  End If
  
End Function

Public Function EachStop() As Boolean

  Dim cTime
  Dim CurSendSucc As Boolean
  Dim TempFloor As Integer
  '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
  Frame2(0).Visible = False
  Frame2(2).Visible = False
'  Frame2(1).Visible = False
  BackLabel(0).Visible = False
  BackLabel(5).Visible = False
'  BackLabel(4).Visible = False

  EachStop = True
  
  FrmFuncTest.TestText.Text = "Now begin the Each Floor Stop Test." & Chr(10) & Chr(13)
  FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Move the car to the first floor." & Chr(10) & Chr(13)
  If NowMoveFx = "S" Then
    If CountNum > 100 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!"
          EachStop = False
          Exit Function
        End If
        'set DT-S 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!"
          EachStop = 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 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)
        EachStop = False
        Exit Sub
      End If
      
        'set DC-1 to 1
        CurSendSucc = False
        cTime = Timer
        Do Until Timer - cTime > 2
          If bolWritePlcB_05(iDeviceID, DC_2Addr, &HFF) Then
            CurSendSucc = True
            Exit Do
          End If
        Loop
        If Not CurSendSucc Then
          FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Handshake failed! Exit test!"
          EachStop = False
          Exit Function
        End If
        'set DC-1 to 0
        CurSendSucc = False
        cTime = Timer
        Do Until Timer - cTime > 2
          If bolWritePlcB_05(iDeviceID, DC_2Addr, &HFF) Then
            CurSendSucc = True
            Exit Do
          End If
        Loop
        If Not CurSendSucc Then
          FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Handshake failed! Exit test!"
          EachStop = False
          Exit Function
        End If
        Do Until NowMoveFx = "S"
          DoEvents
        Loop
        If Not (CountNum > -100 Or CountNum < 100) Then
           FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Error in landing call,exit test." & Chr(10) & Chr(13)
           EachStop = False
           Exit Sub
        End If
    End If
     
  Else
   
      'set DC-1 to 1
      CurSendSucc = False
      cTime = Timer
      Do Until Timer - cTime > 2
        If bolWritePlcB_05(iDeviceID, DC_2Addr, &HFF) Then
          CurSendSucc = True
          Exit Do
        End If
      Loop
        If Not CurSendSucc Then
          FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Handshake failed! Exit test!"
          EachStop = False
          Exit Function
        End If
      'set DC-1 to 0
      CurSendSucc = False
      cTime = Timer
      Do Until Timer - cTime > 2
        If bolWritePlcB_05(iDeviceID, DC_2Addr, &HFF) Then
          CurSendSucc = True
          Exit Do
        End If
      Loop
        If Not CurSendSucc Then
          FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Handshake failed! Exit test!"
          EachStop = False
          Exit Function
        End If
      Do Until NowMoveFx = "S"
        DoEvents
      Loop
      If Not (CountNum > -100 Or CountNum < 100) Then
         FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Error in landing call,exit test." & Chr(10) & Chr(13)
         EachStop = False
         Exit Sub
      End If
   
  End If
  
  FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Send out a car call to 3rd floor and active simulated Alarm button." & Chr(10) & Chr(13)
If NowMoveFx = "S" Then
    If CountNum > 100 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!"
          EachStop = False
          Exit Function
        End If
        'set DT-S 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!"
          EachStop = 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 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)
        EachStop = False
        Exit Sub
      End If
      
        '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!"
          EachStop = 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!"
          EachStop = False
          Exit Function
        End If
        Do Until NowMoveFx = "S"
          DoEvents
        Loop
        If Not (CountNum > -100 Or CountNum < 100) Then
           FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Error in landing call,exit test." & Chr(10) & Chr(13)
           EachStop = False
           Exit Sub
        End If
    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!"
          EachStop = 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!"
          EachStop = False
          Exit Function
        End If
      Do Until NowMoveFx = "S"
        DoEvents
      Loop
      If Not (CountNum > -100 Or CountNum < 100) Then
         FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Error in landing call,exit test." & Chr(10) & Chr(13)
         EachStop = False
         Exit Sub
      End If
   
  End If
  FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Active Alarm  Button." & Chr(10) & Chr(13)
  'send alarm
  'set Alarm to 1
  CurSendSucc = False
  cTime = Timer
  Do Until Timer - cTime > 2
    If bolWritePlcB_05(iDeviceID, AlarmAddr, &HFF) Then
      CurSendSucc = True
      FrmFuncTest.toggle(1).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!"
      EachStop = False
      Exit Function
    End If
  FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Check the car stop at 2nd floor and 3rd floor before the car had been served correctly." & Chr(10) & Chr(13)
  
  If CountNum < MaxCount \ 4 Then
    TempFloor = 1
  Else
    If CountNum < MaxCount * 3 \ 4 Then
      TempFloor = 2
    Else
        TempFloor = 3
    End If
  End If
  Do Until NowMoveFx = "S"
    DoEvents
  Loop
  
  If Not ((TempFloor = 1 And CurFloor = 1) Or (TempFloor = 2 And CurFloor = 2) Or (TempFloor = 3 And CurFloor = 3)) Then
     FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Error in stop at correct floor ,Each floor stop test failed." & Chr(10) & Chr(13)
     EachStop = False
     Exit Sub
  End If
  'set Alarm to 0
  CurSendSucc = False
  cTime = Timer
  Do Until Timer - cTime > 2
    If bolWritePlcB_05(iDeviceID, AlarmAddr, &H0) Then
      CurSendSucc = True
      FrmFuncTest.toggle(1).Picture = LoadPicture(App.Path & "\button\switchoff.gif")
      Exit Do
    End If
  Loop
    If Not CurSendSucc Then
      FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Handshake failed! Exit test!"
      EachStop = False
      Exit Function
    End If
  FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "If all are right, click Yes commandbutton,Or click No commandbutton."
  Do Until YesCmdClick
    DoEvents
  Loop
  If FuncTestPass Then
    FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Each Floor Stop Test Complished!" & Chr(10) + Chr(13)
    EachStop = True
  Else
    FrmFuncTest.TestText.Text = FrmFuncTest.TestText.Text + "Each Floor Stop Test failed" & Chr(10) + Chr(13)
    EachStop = False
  End If
End Function

Public Function EarthquakeControl() 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
12345

prjbas.bas - 源码说明

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

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

⌨️ 快捷键说明

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