frmmain.frm

此为交通信号机

    
    On Error Resume Next
    Select Case Button.Key
        Case "打开"
           cd.Filter = "配时方案(*.Sch)|*.Sch|灯色方案(*.shm)|*.shm|多时段方案(*.doc)|*.doc"
           cd.ShowOpen
            Open cd.FileName For Input As #1
            If cd.FileName = "" Then
             Exit Sub
             End If
             Select Case cd.FilterIndex
                     Case 1
                         'FrmMain.Show
                        Input #1, steps
                        Call Mdlsch.initschgrid(steps)
             
                        For Mr = 1 To 16
                            For Mc = 1 To steps
                                GridScheme.row = Mr
                                GridScheme.col = Mc
                                Input #1, str1
                                GridScheme.Text = str1
                             Next
                          Next
                      Close #1
                    Case 2
                         Frmlamp.Show
                         Input #1, steps
       Call Mdl1.IniScheTab(steps)
      ' ReDim datamatrix1(1 To 40, 1 To steps)
       For Mr = 1 To 40
            For Mc = 1 To steps
              Input #1, datamatrix1(Mr, Mc)
            Next
       Next
               
      For Mr = 1 To 40
            For Mc = 1 To steps
              Frmlamp.MlampGrid.col = Mc
              Frmlamp.MlampGrid.row = Mr
               a = (Mr - 1) Mod 8
              
        Select Case a
           Case 0
               If datamatrix1(Mr, Mc) = 1 Then
                   Set Frmlamp.MlampGrid.CellPicture = LoadPicture(App.Path + "\red.bmp")
              Else
                   Set Frmlamp.MlampGrid.CellPicture = LoadPicture("")
             
              End If
         
           Case 1
               If datamatrix1(Mr, Mc) = 1 Then
                   Set Frmlamp.MlampGrid.CellPicture = LoadPicture(App.Path + "\green.bmp")
          
              ElseIf datamatrix1(Mr, Mc) = 2 Then
                  Set Frmlamp.MlampGrid.CellPicture = LoadPicture(App.Path + "\greenw.bmp")
              Else
                  Set Frmlamp.MlampGrid.CellPicture = LoadPicture("")
        
              End If
          
          Case 2
         
          If datamatrix1(Mr, Mc) = 1 Then
             Set Frmlamp.MlampGrid.CellPicture = LoadPicture(App.Path + "\red.bmp")
          
          Else
                Set Frmlamp.MlampGrid.CellPicture = LoadPicture("")
          
          End If
         Case 3
             If datamatrix1(Mr, Mc) = 1 Then
                 Set Frmlamp.MlampGrid.CellPicture = LoadPicture(App.Path + "\yellow.bmp")
          
             Else
                 Set Frmlamp.MlampGrid.CellPicture = LoadPicture("")
         
             End If
        Case 4, 5, 6, 7
             If datamatrix1(Mr, Mc) = 1 Then
                Set Frmlamp.MlampGrid.CellPicture = LoadPicture(App.Path + "\green.bmp")
          
            ElseIf datamatrix1(Mr, Mc) = 2 Then
               Set Frmlamp.MlampGrid.CellPicture = LoadPicture(App.Path + "\greenw.bmp")
          
            Else
               Set Frmlamp.MlampGrid.CellPicture = LoadPicture("")
          
           End If
          End Select
        Next
    Next
        For Mr = 41 To 44
            For Mc = 1 To steps
                Frmlamp.MlampGrid.col = Mc
               Frmlamp.MlampGrid.row = Mr
                Input #1, str1
                Frmlamp.MlampGrid.Text = str1
            Next
        Next
        Close #1
        Case 3
           Frmmul.Show
           Call Mdlsch.initmtgrid(stepnum)
            For Mr = 1 To 6
               For Mc = 2 To 11
                  Frmmul.MutimeGrid.col = Mc
                  Frmmul.MutimeGrid.row = Mr
                  Input #1, str1
                  Frmmul.MutimeGrid.Text = str1
              Next
         Next
            Close #1
      End Select
            
        Case "保存"
            cd.Filter = "配时方案(*.Sch)|*.Sch|灯色方案(*.shm)|*.shm|多时段方案(*.doc)|*.doc"
           cd.ShowSave
           Open cd.FileName For Output As #1
            If cd.FileName = "" Then
               Exit Sub
             End If
            Select Case cd.FilterIndex
                   Case 1
                   'FrmMain.ActiveControl
                   If FrmMain.GridScheme.Visible = False Then
                       MsgBox ("保存文件后缀名错误")
                     Exit Sub
                   Else
                      
                   Write #1, steps
                   For Mr = 1 To 16
                      For Mc = 1 To steps
                         GridScheme.row = Mr
                          GridScheme.col = Mc
                        Write #1, GridScheme.Text
                     Next
                  Next
                End If
                Close #1
                Case 2
                   'Frmlamp.ActiveControl
                   If Frmlamp.MlampGrid.Visible = False Then
                      MsgBox ("保存文件后缀名错误")
                   Exit Sub
                   Else
                     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
                             Frmlamp.MlampGrid.col = Mc
                             Frmlamp.MlampGrid.row = Mr
                             Write #1, Frmlamp.MlampGrid.Text
                         Next
                    Next
                    End If
                    Close #1
               Case 3
                 'Frmmul.ActiveControl
                 If Frmmul.MutimeGrid.Visible = False Then
                     MsgBox ("保存文件后缀名错误")
                     Exit Sub
                 Else
                     For Mr = 1 To 6
                        For Mc = 2 To 11
                           Frmmul.MutimeGrid.col = Mc
                           Frmmul.MutimeGrid.row = Mr
                           Write #1, Frmmul.MutimeGrid.Text
                       Next
                     Next
                 End If
            Close #1
            End Select
        Case "打印"
            FrmMain.GridScheme.GridColor = &H0&
             PrintForm
             FrmMain.GridScheme.GridColor = &HC0C0C0
        Case "复制"
              Clipboard.Clear
              gf = 0
              fcut = True
            
        Case "剪切"
             Clipboard.Clear
              
              gf = 1
              fcut = True
              
        Case "粘贴"
              gf = 2
              fcut = True
        Case "撤消"
            
        Case "重复"
            '应做:添加 '重复' 按钮代码。
            MsgBox "添加 '重复' 按钮代码。"
        Case "返回"
            End
    End Select
End Sub




Public Sub Form_GotFocus()
If fcut = True Then
  If gf = 0 Then
  GridScheme.row = GridScheme.MouseRow
  GridScheme.col = GridScheme.MouseCol
   Clipboard.SetText (GridScheme.Text)
  ElseIf gf = 1 Then
  GridScheme.row = GridScheme.MouseRow
  GridScheme.col = GridScheme.MouseCol
  GridScheme.Text = ""
  ElseIf gf = 2 Then
  GridScheme.row = GridScheme.MouseRow
  GridScheme.col = GridScheme.MouseCol
  GridScheme.Text = Clipboard.GetText()
  End If
  fcut = False
 Else
  Exit Sub
End If

End Sub

Private Sub MGrid1_Click()
    Dim Mc%, Mr%
            
            FrmMain.MGrid1.row = MGrid1.MouseRow
            FrmMain.MGrid1.col = MGrid1.MouseCol
            Mr = MGrid1.MouseRow
            Mc = MGrid1.MouseCol
            If Mc > 1 And Mc <= 11 And Mr > 0 And Mr < 7 Then
            EditGrid1 MGrid1, TxtEdit
            End If
End Sub

Private Sub MGrid1_LeaveCell()
  If TxtEdit.Visible = False Then Exit Sub
    MGrid1 = TxtEdit
    TxtEdit.Visible = False
End Sub



Private Sub Form_Load()
       FrmMain.Width = Screen.Width
       FrmMain.Height = Screen.Height
       commflag = False
       firstimer = False
       Labsch.Visible = False
       Labrec.Visible = False
       Textrec.Visible = False
       Textrec.Text = ""
       fcut = False
       LabMt.Visible = False
       LabOD.Visible = False
       LabelSAT.Visible = False
       Labhol.Visible = False
       Text1.Visible = False
       Text2.Visible = False
       Text3.Visible = False
       'GridScheme.Width = Screen.Width
       'GridScheme.Height = Screen.Height
       
End Sub

Private Sub Form_Unload(Cancel As Integer)
        End
End Sub

Private Sub GridScheme_Click()
            Dim Mc%, Mr%
            Dim Sum%
            FrmMain.GridScheme.row = GridScheme.MouseRow
            FrmMain.GridScheme.col = GridScheme.MouseCol
            Mr = GridScheme.MouseRow
            Mc = GridScheme.MouseCol
            If Mc > 0 And Mc <= steps And Mr > 0 And Mr < 17 Then
            EditGrid1 GridScheme, TxtEdit
            End If
            If Mc = steps + 1 And Mr > 0 And Mr < 17 Then
            For i = 1 To 16
                Sum = 0
                For j = 1 To steps
                GridScheme.row = i
                GridScheme.col = j
                Sum = Sum + Val(GridScheme.Text)
                
            Next
            GridScheme.col = steps + 1
            GridScheme.Text = Str(Sum)
         Next
         End If
End Sub
            
            
Sub GridScheme_LeaveCell()
    
    
    If TxtEdit.Visible = False Then
    Exit Sub
    End If
    GridScheme = TxtEdit
    TxtEdit.Visible = False
End Sub
Private Sub lampcolbut_Click()
Frmlamp.Show
End Sub



Private Sub MComm1_OnComm()
Dim str2 As Variant
Textrec.Visible = True
Labrec.Visible = True
'If SmartNetXpButton1(0).Caption = "通信" Then
 '  SmartNetXpButton1(0).Caption = "接收"
'End If
str2 = MComm1.Input
Textrec.Text = Textrec.Text + str2
 MComm1.PortOpen = False
End Sub

Private Sub Multibuton_Click()
Frmmul.Show
End Sub


Private Sub SchLampNew_Click()
   Dim str1$
   Frmlamp.Show
   If firstimer = False Then
     str1 = InputBox("请输入步伐数(20 到 40)")
   steps = Val(str1)
   firstimer = True
  End If
     Call Mdl1.IniScheTab(steps)
End Sub

Private Sub SchLampOpen_Click()
        Dim str1$
        Dim a%
        Dim Mr%, Mc%
        Dim datamatrix1(1 To 40, 1 To 40) As Integer
        Frmlamp.Show
         Frmlamp.Cd1.Filter = "灯色方案(*.shm)|*.shm|所有文件(*.*)|*.*"
       Frmlamp.Cd1.ShowOpen
        
       If Frmlamp.Cd1.FileName = "" Then
            Exit Sub
       End If
       Open Frmlamp.Cd1.FileName For Input As #1
       Input #1, steps
       Call Mdl1.IniScheTab(steps)
      ' ReDim datamatrix1(1 To 40, 1 To steps)
       For Mr = 1 To 40
            For Mc = 1 To steps
              Input #1, datamatrix1(Mr, Mc)
            Next
       Next
               
      For Mr = 1 To 40
            For Mc = 1 To steps
              Frmlamp.MlampGrid.col = Mc
              Frmlamp.MlampGrid.row = Mr
               a = (Mr - 1) Mod 8
              
        Select Case a
           Case 0
               If datamatrix1(Mr, Mc) = 1 Then
                   Set Frmlamp.MlampGrid.CellPicture = LoadPicture(App.Path + "\red.bmp")
              Else
                   Set Frmlamp.MlampGrid.CellPicture = LoadPicture("")
             
              End If
         
           Case 1
               If datamatrix1(Mr, Mc) = 1 Then
                   Set Frmlamp.MlampGrid.CellPicture = LoadPicture(App.Path + "\green.bmp")
          
              ElseIf datamatrix1(Mr, Mc) = 2 Then
                  Set Frmlamp.MlampGrid.CellPicture = LoadPicture(App.Path + "\greenw.bmp")
              Else
                  Set Frmlamp.MlampGrid.CellPicture = LoadPicture("")
        
              End If
          
          Case 20
         
          If datamatrix1(Mr, Mc) = 1 Then
             Set Frmlamp.MlampGrid.CellPicture = LoadPicture(App.Path + "\red.bmp")
          
          Else
                Set Frmlamp.MlampGrid.CellPicture = LoadPicture("")
          
          End If
         Case 3
             If datamatrix1(Mr, Mc) = 1 Then
                 Set Frmlamp.MlampGrid.CellPicture = LoadPicture(App.Path + "\yellow.bmp")
          
             Else
                 Set Frmlamp.MlampGrid.CellPicture = LoadPicture("")
         
             End If
        Case 4, 5, 6, 7
             If datamatrix1(Mr, Mc) = 1 Then
                Set Frmlamp.MlampGrid.CellPicture = LoadPicture(App.Path + "\green.bmp")
          
            ElseIf datamatrix1(Mr, Mc) = 2 Then
               Set Frmlamp.MlampGrid.CellPicture = LoadPicture(App.Path + "\greenw.bmp")
          
            Else
               Set Frmlamp.MlampGrid.CellPicture = LoadPicture("")
          
           End If
          End Select
        Next
    Next