module1.bas

此为交通信号机的方案生成软件

Attribute VB_Name = "Mdl1"
    

   
    Public Sub IniScheTab(stepnum As Integer)
        FrmMain.GridScheme.Width = Screen.Width - 50
        FrmMain.GridScheme.Height = 5000
        FrmMain.GridScheme.Cols = stepnum + 1
     
     FrmMain.GridScheme.Row = 0
     
         '设置表格参数
     For i = 1 To stepnum
        
          FrmMain.GridScheme.ColWidth(i) = 2 * (FrmMain.GridScheme.Width - FrmMain.GridScheme.ColWidth(0)) / stepnum
          FrmMain.GridScheme.Col = i
          FrmMain.GridScheme.Text = Str(i)
          FrmMain.GridScheme.ColAlignment(i) = flexAlignCenter
          
     Next
     
     FrmMain.GridScheme.Col = 0
     
      For i = 0 To 31
       a = Int(i / 8)
       b = i Mod 8
       FrmMain.GridScheme.ColAlignment(0) = 2
       FrmMain.GridScheme.Row = (i + 1)
       Select Case b
         Case 0
           FrmMain.GridScheme.Text = Str(a + 1) + "PR"
         Case 1
           FrmMain.GridScheme.Text = Str(a + 1) + "PG"
         Case 2
           FrmMain.GridScheme.Text = Str(a + 1) + "R"
         Case 3
           FrmMain.GridScheme.Text = Str(a + 1) + "Y"
         Case 4
           FrmMain.GridScheme.Text = Str(a + 1) + "G"
         Case 5
           FrmMain.GridScheme.Text = Str(a + 1) + "AL"
        Case 6
           FrmMain.GridScheme.Text = Str(a + 1) + "AS"
        Case 7
           FrmMain.GridScheme.Text = Str(a + 1) + "AR"
        End Select
      Next
      For i = 33 To 40
              FrmMain.GridScheme.Row = i
              FrmMain.GridScheme.Text = Str(Int((i - 33) / 2) + 1) + "A" + IIf(i Mod 2 = 1, "1", "2")
      Next
           
      FrmMain.GridScheme.Row = 41
           FrmMain.GridScheme.Text = "可变步"
      FrmMain.GridScheme.Row = 42
           FrmMain.GridScheme.Text = "跟踪步"
      FrmMain.GridScheme.Row = 43
           FrmMain.GridScheme.Text = "步伐监控"
      FrmMain.GridScheme.Row = 44
           FrmMain.GridScheme.Text = "基本时间"
      
       'FrmMain.gridscheme.Redraw = True
            
        
     
     
     
     FrmMain.GridScheme.Visible = True

    End Sub
Public Sub RedrawBmp(step As Integer)          '根据数组决定方案表位图
                Dim Mr, Mc, b As Integer
                MousePointer = 13
                FrmMain.GridScheme.Enabled = True
                For Mr = 1 To 40
                     For Mc = 1 To step
                            b = (Mr - 1) Mod 8
                            FrmMain.GridScheme.Col = Mc
                            FrmMain.GridScheme.Row = Mr
                            
                            '设置灯色
                            Select Case b
                              Case 0
                                  If DataMatrix(Mr, Mc) = 1 Then
                                     Set FrmMain.GridScheme.CellPicture = LoadPicture(App.Path + "\green.bmp")
                                     
                                  ElseIf DataMatrix(Mr, Mc) = 2 Then
                                     Set FrmMain.GridScheme.CellPicture = LoadPicture(App.Path + "\greenw.bmp")
                                     
                                  ElseIf DataMatrix(Mr, Mc) = 0 Then
                                     Set FrmMain.GridScheme.CellPicture = LoadPicture("")
                                    
                                  End If
                               Case 1
                                  If DataMatrix(Mr, Mc) = 1 Then
                                     Set FrmMain.GridScheme.CellPicture = LoadPicture(App.Path + "\yellow.bmp")
                                    
                                  ElseIf DataMatrix(Mr, Mc) = 0 Then
                                     Set FrmMain.GridScheme.CellPicture = LoadPicture("")
                                    
                                  End If
                              
                              Case 2
                                  If DataMatrix(Mr, Mc) = 1 Then
                                     Set FrmMain.GridScheme.CellPicture = LoadPicture(App.Path + "\red.bmp")
                                    
                                  
                                  ElseIf DataMatrix(Mr, Mc) = 0 Then
                                     Set FrmMain.GridScheme.CellPicture = LoadPicture("")
                                    
                                  End If
                                  
                              Case 3
                                  If DataMatrix(Mr, Mc) = 1 Then
                                     Set FrmMain.GridScheme.CellPicture = LoadPicture(App.Path + "\green.bmp")
                                    
                                  ElseIf DataMatrix(Mr, Mc) = 2 Then
                                     Set FrmMain.GridScheme.CellPicture = LoadPicture(App.Path + "\greenw.bmp")
                                    
                                  ElseIf DataMatrix(Mr, Mc) = 0 Then
                                     Set FrmMain.GridScheme.CellPicture = LoadPicture("")
                                    
                                  End If
                              Case 4
                                  If DataMatrix(Mr, Mc) = 1 Then
                                     Set FrmMain.GridScheme.CellPicture = LoadPicture(App.Path + "\green.bmp")
                                    
                                  ElseIf DataMatrix(Mr, Mc) = 2 Then
                                     Set FrmMain.GridScheme.CellPicture = LoadPicture(App.Path + "\greenw.bmp")
                                    
                                  ElseIf DataMatrix(Mr, Mc) = 0 Then
                                     Set FrmMain.GridScheme.CellPicture = LoadPicture("")
                                   
                                  End If
                               Case 5
                                  If DataMatrix(Mr, Mc) = 1 Then
                                     Set FrmMain.GridScheme.CellPicture = LoadPicture(App.Path + "\red.bmp")
                                   
                                  
                                  ElseIf DataMatrix(Mr, Mc) = 0 Then
                                     Set FrmMain.GridScheme.CellPicture = LoadPicture("")
                                   
                                  End If
                               End Select
                          Next
                    Next
       MousePointer = 0
       FrmMain.GridScheme.Enabled = False
End Sub