module1.bas

此为交通信号机

Attribute VB_Name = "Mdl1"
    

   
    Public Sub IniScheTab(stepnum As Integer)
      Frmlamp.MlampGrid.Width = Screen.Width - 400
      Frmlamp.MlampGrid.Height = Screen.Height - 1500
      Frmlamp.MlampGrid.Cols = stepnum + 1
      Frmlamp.MlampGrid.row = 0
     
         '设置表格参数
     For i = 0 To stepnum
        ' If i < 10 Then
         
          'Frmlamp.MlampGrid.ColWidth(i) = (Frmlamp.MlampGrid.Width - Frmlamp.MlampGrid.ColWidth(0)) / stepnum
         'Else
        If i > 0 Then
        Frmlamp.MlampGrid.ColWidth(i) = 2 * (Frmlamp.MlampGrid.Width - Frmlamp.MlampGrid.ColWidth(0)) / stepnum
        End If
        If i = 0 Then
        
        Frmlamp.MlampGrid.col = i
        Frmlamp.MlampGrid.Text = "步伐号"
        Frmlamp.MlampGrid.ColAlignment(i) = flexAlignleft
        Else
        Frmlamp.MlampGrid.col = i
        Frmlamp.MlampGrid.Text = Str(i)
        Frmlamp.MlampGrid.ColAlignment(i) = flexAlignleft
        End If
        
     Next
    
   Frmlamp.MlampGrid.col = 0
     
      For i = 0 To 31
       a = Int(i / 8)
       b = i Mod 8
     Frmlamp.MlampGrid.ColAlignment(0) = flexAlignleft '2
     Frmlamp.MlampGrid.row = (i + 1)
       Select Case b
         Case 0
         Frmlamp.MlampGrid.Text = Str(a + 1) + "PR"
         Case 1
         Frmlamp.MlampGrid.Text = Str(a + 1) + "PG"
         Case 2
         Frmlamp.MlampGrid.Text = Str(a + 1) + "R"
         Case 3
         Frmlamp.MlampGrid.Text = Str(a + 1) + "Y"
         Case 4
         Frmlamp.MlampGrid.Text = Str(a + 1) + "G"
         Case 5
         Frmlamp.MlampGrid.Text = Str(a + 1) + "AL"
         Case 6
         Frmlamp.MlampGrid.Text = Str(a + 1) + "AS"
        Case 7
         Frmlamp.MlampGrid.Text = Str(a + 1) + "AR"
        End Select
      Next
      For i = 33 To 40
         Frmlamp.MlampGrid.row = i
         Frmlamp.MlampGrid.Text = Str(Int((i - 33) / 2) + 1) + "A" + IIf(i Mod 2 = 1, "1", "2")
      Next
           
    Frmlamp.MlampGrid.row = 41
         Frmlamp.MlampGrid.Text = "步伐监测"
     Frmlamp.MlampGrid.row = 42
         Frmlamp.MlampGrid.Text = "跟踪"
     Frmlamp.MlampGrid.row = 43
         Frmlamp.MlampGrid.Text = "可变步"
    Frmlamp.MlampGrid.row = 44
         Frmlamp.MlampGrid.Text = "状态字"
    
       'Frmlamp.MlampGrid.Redraw = True
            
        
     
     
     
   Frmlamp.MlampGrid.Visible = True
     

    End Sub
    
Public Sub RedrawBmp(step As Integer, datamatrix1() As Integer)           '根据数组决定方案表位图
                Dim Mr, Mc, b As Integer
                MousePointer = 13
              Frmlamp.MlampGrid.Enabled = True
                For Mr = 1 To 32
                     For Mc = 1 To step
                            b = (Mr - 1) Mod 8
                          Frmlamp.MlampGrid.col = Mc
                          Frmlamp.MlampGrid.row = Mr
                            
                            '设置灯色
                            Select Case b
                              Case 0
                                  'If DataMatrix(Mr, Mc) = 1 Then
                                  If datamatrix1(Mr, Mc) = 1 Then
                                     Set Frmlamp.MlampGrid.CellPicture = LoadPicture(App.Path + "\red.bmp")
                                    
                                  ElseIf datamatrix1(Mr, Mc) = 0 Then
                                     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")
                                     
                                  ElseIf datamatrix1(Mr, Mc) = 0 Then
                                     Set Frmlamp.MlampGrid.CellPicture = LoadPicture("")
                                  End If
                              
                              Case 2
                                  If datamatrix1(Mr, Mc) = 1 Then
                                     Set Frmlamp.MlampGrid.CellPicture = LoadPicture(App.Path + "\red.bmp")
                                    
                                  
                                  ElseIf datamatrix1(Mr, Mc) = 0 Then
                                     Set Frmlamp.MlampGrid.CellPicture = LoadPicture("")
                                    
                                  End If
                                  
                              Case 3
                                  If datamatrix(Mr, Mc) = 1 Then
                                     Set Frmlamp.MlampGrid.CellPicture = LoadPicture(App.Path + "\yellow.bmp")
                                    
                                  'ElseIf DataMatrix(Mr, Mc) = 2 Then
                                     'Set Frmlamp.MlampGrid.CellPicture = LoadPicture(App.Path + "\greenw.bmp")
                                    
                                  ElseIf datamatrix(Mr, Mc) = 0 Then
                                     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")
                                    
                                  ElseIf datamatrix1(Mr, Mc) = 0 Then
                                     Set Frmlamp.MlampGrid.CellPicture = LoadPicture("")
                                   
                                  End If
                               'Case 5, 6, 7
                                  'If DataMatrix(Mr, Mc) = 1 Then
                                    ' Set Frmlamp.MlampGrid.CellPicture = LoadPicture(App.Path + "\red.bmp")
                                   
                                  
                                  'ElseIf DataMatrix(Mr, Mc) = 0 Then
                                     'Set Frmlamp.MlampGrid.CellPicture = LoadPicture("")
                                   
                                  'End If
                               End Select
                          Next
                    Next
                   For Mr = 33 To 40
                     For Mc = 1 To step
                          Frmlamp.MlampGrid.col = Mc
                          Frmlamp.MlampGrid.row = Mr
                          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")
                                    
                                  ElseIf datamatrix1(Mr, Mc) = 0 Then
                                     Set Frmlamp.MlampGrid.CellPicture = LoadPicture("")
                                   
                          End If
                    Next
                  Next
                    
      MousePointer = 0
     Frmlamp.MlampGrid.Enabled = False
End Sub