frmmain.frm

此为交通信号机

Private Sub MnuEditSchemeTable_Click()
        If GridScheme.Enabled = True Then
            MnuEditSchemeTable.Caption = "编辑方案表"
            GridScheme.Enabled = False
        Else
            MnuEditSchemeTable.Caption = "禁止编辑方案表"
            GridScheme.Enabled = True
        End If
End Sub

Private Sub MnuMakeText_Click()
        Dim Mc As Integer
        Dim str1 As String
        Dim FirstTimes As Boolean
        Dim Return1 As Boolean
        Dim TotalStepLength As Integer
        '打开文件
        cd.Filter = "Scheme(*.Hhx)|*.Hhx|所有文件(*.*)|*.*"
        cd.ShowSave
        If cd.FileName = "" Then
           Exit Sub
        End If
        Open cd.FileName For Output As #1
        
        '生成灯色方案
        FirstTimes = True
        For Mc = 1 To 40
            Call MdlMadeText.MadeLampColar(Mc, FirstTimes)
        Next
        FirstTimes = False
        For Mc = 1 To 40
            Call MdlMadeText.MadeLampColar(Mc, FirstTimes)
        Next
        
        '生成状态控制字
        For Mc = 1 To 40
            Return1 = MdlMadeText.MadeStateByte(Mc)
            If Return1 = False Then
                GoTo ErrEnd
            End If
        Next
        '生成保安时间
         For Mc = 1 To 40
            Return1 = MdlMadeText.MadeStepLength(Mc)
            If Return1 = False Then
                GoTo ErrEnd
            End If
         Next
         '总步伐数
         Print #1, "D2192" + "        " + Str(steps)
         '周期长度
         TotalStepLength = 0
         FrmMain.GridScheme.row = 44
         For Mc = 1 To steps
            FrmMain.GridScheme.col = Mc
            TotalStepLength = TotalStepLength + Val(FrmMain.GridScheme.Text)
         Next
         Print #1, "D2193" + "        " + Str(TotalStepLength)
         '长，中，短步时间
         Print #1, "D2194" + "         " + "1"
         Print #1, "D2195" + "         " + "35"
         Print #1, "D2196" + "         " + "1"
         Print #1, "D2197" + "         " + "100"
         Print #1, "D2198" + "         " + "6"
         Print #1, "D2199" + "         " + "100"
         
ErrEnd: Close #1
End Sub

Private Sub MnuPrint_Click()
      'cd.ShowPrinter
      FrmMain.GridScheme.GridColor = &H0&
      PrintForm
      FrmMain.GridScheme.GridColor = &HC0C0C0
End Sub



Private Sub MnuSchemeLoad_Click()
      Dim Mr, Mc As Integer
      Dim a, b As Integer
      Dim str1 As String
      cd.Filter = "信号机方案(*.Shm)|*.shm|所有文件(*.*)|*.*"
      cd.ShowOpen
      If cd.FileName = "" Then
           Exit Sub
      End If
        Open cd.FileName For Input As #1
        
        Input #1, steps
        Call Mdl1.IniScheTab(steps)
        For Mr = 1 To 40
           For Mc = 1 To steps
              Input #1, datamatrix(Mr, Mc)
           Next
        Next
        For Mr = 41 To 44
            For Mc = 1 To steps
                GridScheme.col = Mc
                GridScheme.row = Mr
                Input #1, str1
                GridScheme.Text = str1
            Next
        Next
        
        Close #1
        MousePointer = 13
        Call Mdl1.IniScheTab(steps)          '初始化方案列表
        Call Mdl1.RedrawBmp(steps)      '重画方案
        MousePointer = 0
        
        
        
End Sub

Private Sub MnuSchemeRead_Click()
        Dim CMD As String
        Dim AddreStart As String
        Dim i As Integer
        Dim String1 As String
        Dim Caption As String
        Dim StepString As String
        Dim StepString2 As String
        MousePointer = 13
        Caption = FrmMain.Caption
        FrmMain.Caption = FrmMain.Caption + "  [从PLC载入方案...]"
       
        
        CMD = "0"
          '灯色方案表起始地址    "177E"  周期终止步地址单元起始地址
        
        String1 = ReadSchemeFromPlc(CMD, "177E", "1")   '读周期终止步
        If Len(String1) = 0 Then
            GoTo end1
        End If
        steps = Mdl2.StringToVal(String1)
         
         '读方案表数据
         Call Mdl1.IniScheTab(steps)
         For i = 1 To 4
            AddreStart = Hex(Mdl2.StringToVal("15A0") + (i - 1) * 64)
            instring(i) = Mdl2.ReadSchemeFromPlc(CMD, AddreStart, "64")
            If Len(instring(i)) = 0 Then
                GoTo end1
            End If
         Next
         '读步长数据 D200
             
            StepString = Mdl2.ReadSchemeFromPlc(CMD, "1190", Str(steps))
         
         
         '处理数据
          Call Mdl2.TransferDataFromPlc
          Call Mdl1.RedrawBmp(steps)
          
          '显示步长信息
          For Mc = 1 To steps
               GridScheme.col = Mc
               GridScheme.row = 41
               StepString2 = Mid(StepString, Mc * 2 - 1, 2)
               GridScheme.Text = Str(StringToVal(StepString2))
          Next
          
          
end1:                MousePointer = 0
         FrmMain.Caption = Caption
End Sub

Private Sub MnuSchemeSave_Click()
        Dim Mr, Mc As Integer
        Dim Str As String
        cd.Filter = "信号机方案(*.Shm)|*.shm|所有文件(*.*)|*.*"
        cd.ShowSave
        If cd.FileName = "" Then
            Exit Sub
        End If
        Open cd.FileName For Output As #1
        Write #1, steps
        For Mr = 1 To 40
            For Mc = 1 To steps
               
               Write #1, datamatrix(Mr, Mc)
            Next
        Next
        For Mr = 41 To 44
            For Mc = 1 To steps
                GridScheme.col = Mc
                GridScheme.row = Mr
                Write #1, GridScheme.Text
            Next
        Next
        Close #1
End Sub

Private Sub MnuSchemeSaveAs_Click()
       cd.Action = 2
End Sub

Private Sub MnuSchemeWrite_Click()
          Dim outstring As String
          Dim FirstTimes As Boolean
          Dim HalfOfTable As Integer
          Dim MessegeReturn As Boolean
          Dim response
          Dim title
          Dim i As Integer
          Dim StepsString As String
          Dim StepLength2 As String
           Dim StepLength As String
           
           
          If steps = 0 Then
               MsgBox "没有方案"
               GoTo End2:
          End If
          StepsString = Hex(steps)
          '调整为数
          If Len(StepsString) = 1 Then
              StepsString = "0" + StepsString
          End If
              '是否继续
          response = MsgBox("此次操作将修改PLC中原有数据，继续吗？", vbYesNo, title)
          If response = vbNo Then    ' 用户按下“否”。
          GoTo End2:
          End If
          MousePointer = 13
              
                  '步长数据
            For Mc = 1 To steps
               GridScheme.col = Mc
               GridScheme.row = 41
               StepLength2 = GridScheme.Text
               If StepLength2 = "" Or Val(StepLength2) < 0 Or Val(StepLength2) > 60 Then
                    MsgBox "待发步长数据中有不合格数据！"
                    GoTo end1:
               End If
               StepLength2 = Hex(Val(StepLength2))
               '调整位数
               If Len(StepLength2) = 1 Then
               StepLength2 = "0" + StepLength2
               End If
               StepLength = StepLength + StepLength2
            Next
              
            MessegeReturn = WriteSchemeToPlc("1190", Val(steps), StepLength)
            If MessegeReturn = False Then
                GoTo end1
            End If
            
            
              '发送steps
          MessegeReturn = WriteSchemeToPlc("177E", "1", StepsString)
          If MessegeReturn = False Then
                GoTo end1
            End If
          
          
               '第一组数据
          FirstTimes = True
            outstring = OrgnizeDataToPlc(FirstTimes, 0)
            MessegeReturn = WriteSchemeToPlc("15A0", "64", outstring)
            If MessegeReturn = False Then
                GoTo end1
            End If
           
'               '第二组数据
            outstring = OrgnizeDataToPlc(FirstTimes, 1)
            MessegeReturn = WriteSchemeToPlc("15E0", "64", outstring)
            If MessegeReturn = False Then
                GoTo end1
            End If

'               '第三组数据
          FirstTimes = False
            outstring = OrgnizeDataToPlc(FirstTimes, 0)
            MessegeReturn = WriteSchemeToPlc("1620", "64", outstring)
            If MessegeReturn = False Then
                GoTo end1
            End If

               '第四组数据
            outstring = OrgnizeDataToPlc(FirstTimes, 1)
            MessegeReturn = WriteSchemeToPlc("1660", "64", outstring)
            If MessegeReturn = False Then
                GoTo end1
            End If
            
           
               

            
            MsgBox "方案传输成功！"
            GoTo End2

end1:        MsgBox "方案传输失败！请重试"
End2:        MousePointer = 0
End Sub















Private Sub TxtEdit_KeyDown(KeyCode As Integer, Shift As Integer)
       Select Case KeyCode
           Case vbKeyEscape         '当 ESC键按下时
              
              TxtEdit.Visible = False
              
           
           Case vbKeyUp             '当 UP键按下时
              If GridScheme.row > 16 Then
                 GridScheme.row = GridScheme.row - 1
              End If
              EditGrid GridScheme, TxtEdit
           
           Case vbKeyDown             '当 DOWN键按下时
              If GridScheme.row < 16 Then
                 GridScheme.row = GridScheme.row + 1
              End If
            
endcase1:      EditGrid GridScheme, TxtEdit
           
           Case vbKeyLeft               '当 LEFT键按下时
              If GridScheme.col > 1 Then
                 GridScheme.col = GridScheme.col - 1
              Else
                 If GridScheme.row > 16 Then
                   GridScheme.col = GridScheme.Cols - 1
                   GridScheme.row = GridScheme.row - 1
                 Else
                 End If
              End If
                 EditGrid GridScheme, TxtEdit
           
           Case vbKeyRight                '当 RIGHT键按下时
                 If GridScheme.col < (GridScheme.Cols - 1) Then
                       GridScheme.col = GridScheme.col + 1
                 Else
                    If GridScheme.row < GridScheme.Rows - 1 Then
                        GridScheme.col = 1
                        GridScheme.row = GridScheme.row + 1
                    
                    End If
                 End If
             
endcase2:       EditGrid GridScheme, TxtEdit
              
       End Select
       
End Sub


Private Sub MnuBitOnOff_Click()
      FrmBitOnOff.Show
End Sub

Private Sub MnuExit_Click()
      End
End Sub

Private Sub MnuPara_Click()
        FrmPara.Show
End Sub

Private Sub MnuReadWrite_Click()
             FrmDeviceReadWrite.Show
End Sub

Private Sub MnuSchemeMade_Click()
             FrmSchemeMade.Show
End Sub

Public Sub MnuTest_Click()
     Dim time1
     Dim i As Integer
     LinkOk = False
     
     Screen.MousePointer = 13
     
     
     
     MSComm1.PortOpen = True      '打开端口
     For i = 1 To 3               '三次请求
             MSComm1.Output = chr(&H5)        '发出请求
             time1 = Timer
             Do
             Label1.Caption = "第" + Str(i) + "次联机测试"
             DoEvents
             Loop Until (MSComm1.InBufferCount >= 1) Or (Timer >= time1 + 5)
             
            If MSComm1.InBufferCount >= 1 Then
                DataReceive = MSComm1.Input
                    If DataReceive = chr(&H6) Then
                        LinkOk = True
                        Label1.Caption = "联机成功！"
                            
                        Exit For
                    Else
                    End If
            Else
            End If
     Next
     
     If LinkOk = False Then
             Label1.Caption = "联机失败！"
     End If
     MSComm1.PortOpen = False
     Screen.MousePointer = 0
End Sub