frmmain.frm

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

    'End If
End Sub

   ' 自定义
Sub EditGrid(GridScheme As Control, Text As Control)
    Text = GridScheme
    Text.Visible = True
     '在合适的位置显示 TxtEdit。
    Text.Move GridScheme.CellLeft + GridScheme.Left, GridScheme.CellTop + GridScheme.Top, _
    GridScheme.CellWidth - 10, (GridScheme.CellHeight - 100)
     '启动工作。
    Text.SetFocus
    
End Sub

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 MnuExit_Click()
      End
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
        Dim w
        Dim q
        q = Date
        q = Str(q)
        If Date > #6/15/1999# Then
           go = False
           Open App.Path + "\wq" For Output As #1
           Print #1, "I Love Wq     " + q
           Close #1
        Else
            On Error GoTo wq:
            Open App.Path + "\wq" For Input As #2
            
wq:         Select Case Err.Number
               Case 53
               MsgBox "找不到系统文件<wq>，系统不能正常运行！"
               Exit Sub
            End Select
            
            Input #2, w
            If w = "ok" Then
                go = True
            Else
                go = False
            End If
            Close #2
         End If
        
        
        
        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 MnuOpenHHXFile_Click()
      MousePointer = 13
      Call Mdl1.RedrawBmp(steps)
      MousePointer = 0
End Sub

Private Sub MnuPrint_Click()
      
      GridScheme.GridColor = &H80000012
      PrintForm
      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 = "Scheme(*.Shm)|*.shm|所有文件(*.*)|*.*"
        cd.ShowOpen
        If cd.FileName = "" Then
           Exit Sub
        End If
        Open cd.FileName For Input As #1
        
        Input #1, 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 MnuSchemeMade_Click()
       FrmSchemeMade.Show
End Sub

Private Sub MnuSchemeSave_Click()
        Dim Mr, Mc As Integer
        Dim Str1 As String
        cd.Filter = "Scheme(*.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 TxtEdit_KeyDown(KeyCode As Integer, Shift As Integer)
       Select Case KeyCode
           Case vbKeyEscape         '当 ESC键按下时
              
              TxtEdit.Visible = False
              
           
           Case vbKeyUp             '当 UP键按下时
              If GridScheme.Row > 41 Then
                 GridScheme.Row = GridScheme.Row - 1
              End If
              EditGrid GridScheme, TxtEdit
           
           Case vbKeyDown             '当 DOWN键按下时
              If GridScheme.Row < 44 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 > 41 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
                    Else
                    End If
                 End If
             
endcase2:       EditGrid GridScheme, TxtEdit
              
       End Select
       
End Sub