⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 frmmain.frm

📁 此为交通信号机
💻 FRM
📖 第 1 页 / 共 4 页
字号:
🔍
1234 
        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
End Sub

Private Sub SchLampSave_Click()
         Dim Mr%, Mc%
        Frmlamp.Cd1.Filter = "灯色方案(*.shm)|*.shm|所有文件(*.*)|*.*"
        Frmlamp.Cd1.ShowSave
       If Frmlamp.Cd1.FileName = "" Then
            Exit Sub
        End If
        Open Frmlamp.Cd1.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
                Frmlamp.MlampGrid.col = Mc
                Frmlamp.MlampGrid.row = Mr
                Write #1, Frmlamp.MlampGrid.Text
            Next
        Next
        Close #1
End Sub

Private Sub SchMultNew_Click()
  Dim str1$
  stepnum = 10
  Frmmul.Show
  Call Mdlsch.initmtgrid(stepnum)
End Sub

Private Sub SchMultOpen_Click()
    Dim str1$
    Dim Mc%, Mr%
    Frmmul.Show
        Frmmul.Cd2.Filter = "多时段方案(*.doc)|*.doc|文本文件|*.txt|所有文件(*.*)|*.*"
         Frmmul.Cd2.ShowOpen
         Call Mdlsch.initmtgrid(10)
       If Frmmul.Cd2.FileName = "" Then
            Exit Sub
        End If
        Open Frmmul.Cd2.FileName For Input As #1
         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 Sub

Private Sub SchMultSave_Click()
     Dim Mc%, Mr%
         Frmmul.Cd2.Filter = "多时段方案(*.doc)|*.doc|文本文件|*.txt|所有文件(*.*)|*.*"
         Frmmul.Cd2.ShowSave
       If Frmmul.Cd2.FileName = "" Then
            Exit Sub
        End If
        Open Frmmul.Cd2.FileName For Output As #1
         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
            Close #1
End Sub

Private Sub SchNew_Click()
  Dim str1$
   Labsch.Visible = True
   If firstimer = False Then
   str1 = InputBox("请输入步伐数(20 到 40)")
   steps = Val(str1)
   firstimer = True
   End If
  Call Mdlsch.initschgrid(steps)
      ' LabMt.Visible = True
      ' LabOD.Visible = True
      ' LabelSAT.Visible = True
      ' Labhol.Visible = True
     '  Text1.Visible = True
      ' Text2.Visible = True
     '  Text3.Visible = True
  'Call Mdlsch.initmtgrid(10)
  
End Sub


Private Sub SchOpen_Click()
 Call Mdlsch.initschgrid(steps)
            'Call Mdlsch.initmtgrid(stepnum)
            cd.Filter = "配时方案(*.Sch)|*.Sch|文本文件|*.txt|所有文件(*.*)|*.*"
           cd.ShowOpen
           Open cd.FileName For Input As #1
            If cd.FileName = "" Then
             Exit Sub
             End If
             Input #1, 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
End Sub
Private Sub FileSaveAs_Click()
cd.Action = 2
End Sub


Private Sub SchSave_Click()
  cd.Filter = "配时方案(*.Sch)|*.Sch|文本文件|*.txt|所有文件(*.*)|*.*"
           cd.ShowSave
           Open cd.FileName For Output As #1
            If cd.FileName = "" Then
             Exit Sub
             End If
             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
          Close #1
  End Sub
Private Sub SendState_Click()
'commflag = True
MComm1.CommPort = 2
MComm1.RThreshold = 1
MComm1.Settings = "4800,n,8,1"
MComm1.InputLen = 0
MComm1.InBufferCount = 0
MComm1.OutBufferCount = 0
MComm1.InBufferSize = 1024
MComm1.OutBufferSize = 512
MComm1.PortOpen = True
Frmlamp.MlampGrid.row = 44
For i = 1 To steps
Frmlamp.MlampGrid.col = i
MComm1.Output = Frmlamp.MlampGrid.Text
Next
End Sub
Private Sub SendMultime_Click()
Dim str1$
       'commflag = True
       MComm1.CommPort = 2
       MComm1.RThreshold = 1
       MComm1.Settings = "4800,n,8,1"
       MComm1.InputLen = 0
       MComm1.InBufferCount = 0
       MComm1.OutBufferCount = 0
       MComm1.InBufferSize = 1024
       MComm1.OutBufferSize = 512
       MComm1.PortOpen = True
       For j = 1 To 3
          For i = 2 To 12
          Frmmul.MutimeGrid.row = j
          Frmmul.MutimeGrid.col = i
          
          str1 = Trim(Frmmul.MutimeGrid.Text)
          MComm1.Output = Mid(str1, 1, 2)
          MComm1.Output = Mid(str1, 4, 2)
          Frmmul.MutimeGrid.row = j + 1
          MComm1.Output = Trim(Frmmul.MutimeGrid.Text)
          Next
       Next
End Sub

  Private Sub SendScheme_Click()
       'commflag = True
       MComm1.CommPort = 2
       MComm1.RThreshold = 1
       MComm1.Settings = "4800,n,8,1"
       MComm1.InputLen = 0
       MComm1.InBufferCount = 0
       MComm1.OutBufferCount = 0
       MComm1.InBufferSize = 1024
       MComm1.OutBufferSize = 512
       MComm1.PortOpen = True
       For i = 1 To 16
           For j = 1 To steps + 1
           GridScheme.row = i
           GridScheme.col = j
           MComm1.Output = GridScheme.Text
          Next
      Next
End Sub
Private Sub FileExit_Click()
   If MComm1.PortOpen = True Then
        MComm1.PortOpen = False
    End If
        
     End
End Sub
Private Sub FilePrint_Click()
FrmMain.GridScheme.GridColor = &H0&
             PrintForm
             FrmMain.GridScheme.GridColor = &HC0C0C0
End Sub
Private Sub SmartNetXpButton1_Click(Index As Integer)
  Dim day1%, month1%, wday%
  Dim str1 As String
  Dim Mc%, Mr%
  
Select Case Index
       Case 0
       commflag = True
       MComm1.CommPort = 2
       MComm1.RThreshold = 1
       MComm1.Settings = "4800,n,8,1"
       MComm1.InputLen = 0
       MComm1.InBufferCount = 0
       MComm1.OutBufferCount = 0
       MComm1.InBufferSize = 1024
       MComm1.OutBufferSize = 512
       MComm1.PortOpen = True
       For i = 1 To 16
           For j = 1 To steps + 1
           GridScheme.row = i
           GridScheme.col = j
           MComm1.Output = GridScheme.Text
          Next
      Next
      ' For j = 1 To 3
        '  For i = 2 To 12
        '  MutimeGrid.row = j
        '  MutimeGrid.col = i
          
        '  str1 = Trim(MutimeGrid.Text)
         ' MComm1.Output = Mid(str1, 1, 2)
         ' MComm1.Output = Mid(str1, 4, 2)
         ' MutimeGrid.row = j + 1
         ' MComm1.Output = Trim(MutimeGrid.Text)
         ' Next
      ' Next
       Case 1
        str1 = InputBox("请输入步伐数(20 到 40)")
        steps = Val(str1)
        Call Mdlsch.initschgrid(steps)
        For i = 1 To 16
           For j = 1 To steps + 1
           GridScheme.row = i
           GridScheme.col = j
           GridScheme.Text = Str(0)
          Next
      Next
        'mydate = Date$
        'wday = Weekday(mydate, vbMonday)
        'day1 = Day(mydate)
        'month1 = Month(mydate)
       ' If wday = 7 Or ((month1 = 1 Or month1 = 5 Or month1 = 6 Or month1 = 10) And day1 = 1) Then
        '   stepnum = 10    'Val(Txtsp)
        'Call Mdlsch.initmtgrid(stepnum)
        'ElseIf wday = 6 Then
           ' stepnum = Val(Txtsat)
        'Call Mdlsch.initmtgrid(stepnum)
       ' Else
       '  stepnum = Val(Txto)
        'Call Mdlsch.initmtgrid(stepnum)
       ' End If
        Case 2
            Call Mdlsch.initschgrid(steps)
            'Call Mdlsch.initmtgrid(stepnum)
            cd.Filter = "多时段方案(*.doc)|*.doc|文本文件|*.txt|所有文件(*.*)|*.*"
           cd.ShowOpen
           Open cd.FileName For Input As #1
            If cd.FileName = "" Then
             Exit Sub
             End If
             Input #1, 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
           ' Input #1, stepnum
            ' For Mr = 1 To 6
            '   For Mc = 2 To stepnum + 1
             '  MutimeGrid.row = Mr
             '  MutimeGrid.col = Mc
              ' Input #1, str1
             '  MutimeGrid.Text = str1
             '  Next
            'Next
            Close #1
           
        Case 3
             FrmMain.GridScheme.GridColor = &H0&
             PrintForm
             FrmMain.GridScheme.GridColor = &HC0C0C0
             'FrmMain.MutimeGrid.GridColor = &H0&
            ' PrintForm
            ' FrmMain.MutimeGrid.GridColor = &HC0C0C0
        Case 4
        If SmartNetXpButton1(4).Caption = "保存" Then
           SmartNetXpButton1(4).Caption = "另存为"
           cd.Filter = "多时段方案(*.doc)|*.doc|文本文件|*.txt|所有文件(*.*)|*.*"
           cd.ShowSave
           Open cd.FileName For Output As #1
            If cd.FileName = "" Then
             Exit Sub
             End If
             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
           ' Write #1, stepnum
            ' For Mr = 1 To 6
            '   For Mc = 2 To stepnum + 1
             '  MutimeGrid.row = Mr
             '  MutimeGrid.col = Mc
             '  Write #1, MutimeGrid.Text
             '  Next
           ' Next
            Close #1
      Else
           cd.Action = 2
           SmartNetXpButton1(4).Caption = "保存"
      End If
        Case 5
        If SmartNetXpButton1(0).Caption = "接收" Then
          SmartNetXpButton1(0).Caption = "通信"
        End If
        If commflag = True Then
        MComm1.PortOpen = False
        End If
        
        End
        
       
  End Select
  
End Sub

Private Sub MutimeGrid_Click()
    Dim Mc%, Mr%
            FrmMain.MutimeGrid.row = MutimeGrid.MouseRow
            FrmMain.MutimeGrid.col = MutimeGrid.MouseCol
            Mr = MutimeGrid.MouseRow
            Mc = MutimeGrid.MouseCol
            If Mc > 1 And Mc <= (stepnum + 1) And Mr > 0 And Mr < 7 Then
            EditGrid1 MutimeGrid, TxtEdit1
            
            End If
   

End Sub




Private Sub MutimeGrid_LeaveCell()
If TxtEdit1.Visible = False Then Exit Sub
    MutimeGrid = TxtEdit1
    TxtEdit1.Visible = False
    'TxtEdit.SetFocus
End Sub


  
  '添加编辑功能。。。

Sub GridScheme_GotFocus()
     'If GridScheme.col > 0 And GridScheme.row > 24 Then
     'EditGrid GridScheme, TxtEdit
    'Else
    'End If
End Sub

Private Sub EditGrid1(MutimeGrid As Control, Text1 As Control)
Text1 = MutimeGrid
    Text1.Visible = True
     '在合适的位置显示 TxtEdit1。
    Text1.Move MutimeGrid.CellLeft + MutimeGrid.Left, MutimeGrid.CellTop + MutimeGrid.Top, _
    MutimeGrid.CellWidth - 10, (MutimeGrid.CellHeight - 100)
     '启动工作。
    Text1.SetFocus
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 MnuClose_Click()
     GridScheme.Visible = False
     FrmMain.GridScheme.Clear
     TxtEdit.Visible = False
End Sub
1234

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -