nihongdeng.bas

霓虹灯花样编辑软件源代码

            
            Pa1 = NowLs / 4 * 3
            Pa2 = NowLs / 4 * 2
            Pa3 = NowLs / 4
            
            Call RGBBegin1(Pa1, NowLs - 1, 1)
            For i = 0 To 2
              RunPengPeng1(i) = ColorBposition1(i)
            Next i
            
            Call RGBBegin1(Pa2, Pa1, 1)
            For i = 0 To 2
              RunPengPeng2(i) = ColorBposition1(i)
            Next i
            
            Call RGBBegin1(Pa3, Pa2, 1)
            For i = 0 To 2
              RunPengPeng3(i) = ColorBposition1(i)
            Next i
            
            Call RGBBegin1(NowLs - 1, 0, -1)
            Call RGBEnd1(0, NowLs - 1, 1)
            LineCount = ColorBposition1(0)
            LineCount1 = 0
            LineCount3 = 1
            LineCount4 = ColorEposition1(0)
       
       Case HuaYangZuoYouName1, HuaYangZuoYouName3
            RunZuoYou = HuaYangCs(NUMBER, 6) * (NowColor + 1)
            LineCount2 = 0
            Call RGBBegin1(0, NowLs - 1, 1)
            Call RGBEnd1(NowLs - 1, 0, -1)
            LineCount = ColorBposition1(0)
       
       Case HuaYangZuoYouName2, HuaYangZuoYouName4
            RunZuoYou = HuaYangCs(NUMBER, 6) * (NowColor + 1)
            LineCount2 = 0
            Call RGBBegin1(NowLs - 1, 0, -1)
            Call RGBEnd1(0, NowLs - 1, 1)
            LineCount = ColorBposition1(0)
            
       Case HuaYangDuiDuiName1, HuaYangDuiDuiName3
            RunDuiDui = HuaYangCs(NUMBER, 7)
            RunZuoYou = HuaYangCs(NUMBER, 6) * (NowColor + 1)
            LineCount2 = 0
            Call RGBBegin1(0, RunDuiDui - 1, 1)
            Call RGBEnd1(RunDuiDui - 1, 0, -1)
            LineCount = ColorBposition1(0)
            
            Call RGBBegin2(NowLs - 1, RunDuiDui, -1)
            Call RGBEnd2(RunDuiDui, NowLs - 1, 1)
            LineCount1 = ColorBposition2(0)
       
       Case HuaYangDuiDuiName2, HuaYangDuiDuiName4
            RunDuiDui = HuaYangCs(NUMBER, 7)
            RunZuoYou = HuaYangCs(NUMBER, 6) * (NowColor + 1)
            LineCount2 = 0
            Call RGBBegin1(RunDuiDui, NowLs - 1, 1)
            Call RGBEnd1(NowLs - 1, RunDuiDui, -1)
            LineCount = ColorBposition1(0)
            
            Call RGBBegin2(RunDuiDui - 1, 0, -1)
            Call RGBEnd2(0, RunDuiDui - 1, 1)
            LineCount1 = ColorBposition2(0)
       
     End Select
    
     If Mode = 0 Then
        Call DgInitialize(RunHyName, 0)
     End If
    
        LightStyle = 0
        LightStyle1 = 0
        LightStyle2 = 0
            
        NowRunTimes = 0
        
        If (OutEnableFlag = True) And (OutOverFlag = False) Then
            Form1.Timer1.Interval = 1
            Form1.Timer2.Interval = 1

        Else
            Form1.Timer1.Interval = RunSpeed
            Form1.Timer2.Interval = RunStopTime

        End If
        
        Form1.Timer2.Enabled = False

        Form1.Timer1.Enabled = True
        
    End If

End Sub
Public Sub DgPauseQuanMie()
    Form1.Timer1.Enabled = False
    If (OutEnableFlag = True) And (OutOverFlag = False) Then
       For i = 1 To RunStopTime / 100
           Call WriteFile(0)
       Next i
    End If
    Form1.Timer2.Enabled = True
End Sub

Public Sub HzPauseQuanMie()
    Form1.Timer3.Enabled = False
    If (OutEnableFlag = True) And (OutOverFlag = False) Then
       For i = 1 To RunHzStopTime / 100
           Call WriteFile(0)
       Next i
    End If
    Form1.Timer5.Enabled = True
End Sub

Public Sub HzPauseQuanLiang()
    Form1.Timer3.Enabled = False
    If (OutEnableFlag = True) And (OutOverFlag = False) Then
       For i = 1 To RunHzStopTime / 100
           Call WriteFile(0)
       Next i
    End If
    Form1.Timer4.Enabled = True
End Sub

Public Function PengPengLtoR(ByVal Eposition As Integer, ByVal Pwidth As Integer)
        PengPengLtoR = 0
        If LineCount < LineCount4 Then
            If LineCount <= NowLs - 1 Then
               Form1.Shape1(LineCount).Visible = True
               OutputData(LineCount) = 1
               WriteFlag1 = True
            End If
            
            j = LineCount - Pwidth
            If j >= 0 Then
               Form1.Shape1(j).Visible = False
               OutputData(j) = 0
               WriteFlag2 = True
            End If
               
            BeginWrite
        End If
            
        LineCount = LineCount + 1 + NowColor
        If LineCount >= LineCount4 Then
           PengPengLtoR = 2
        ElseIf LineCount >= Eposition Then
           PengPengLtoR = 1
        End If
        
End Function

Public Function PengPengRtoL(ByVal Eposition As Integer, ByVal Pwidth As Integer)
        PengPengRtoL = 0
        If LineCount >= LineCount4 Then
            If LineCount >= 0 Then
               Form1.Shape1(LineCount).Visible = True
               OutputData(LineCount) = 1
               WriteFlag1 = True
            End If
            
            If LineCount + Pwidth <= NowLs - 1 Then
               Form1.Shape1(LineCount + Pwidth).Visible = False
               OutputData(LineCount + Pwidth) = 0
               WriteFlag2 = True
            End If
            
            BeginWrite
        End If
            
        LineCount = LineCount - 1 - NowColor
        If LineCount < LineCount4 Then
           PengPengRtoL = 2
        ElseIf LineCount < Eposition - (NowColor + 1) Then
           PengPengRtoL = 1
        End If
        
End Function
Public Sub RGBBegin1(ByVal Bp As Integer, ByVal Ep As Integer, ByVal RGBWidth As Integer)
    For i = 0 To 2
        For j = Bp To Ep Step RGBWidth
            If DgColor(i) = Form1.Shape1(j).BackColor Then
                 ColorBposition1(i) = j
               Exit For
            End If
        Next j
    Next i
End Sub

Public Sub RGBBegin2(ByVal Bp As Integer, ByVal Ep As Integer, ByVal RGBWidth As Integer)
    For i = 0 To 2
        For j = Bp To Ep Step RGBWidth
            If DgColor(i) = Form1.Shape1(j).BackColor Then
                 ColorBposition2(i) = j
               Exit For
            End If
        Next j
    Next i
End Sub

Public Sub RGBEnd1(ByVal Bp As Integer, ByVal Ep As Integer, ByVal RGBWidth As Integer)
    For i = 0 To 2
        For j = Bp To Ep Step RGBWidth
            If DgColor(i) = Form1.Shape1(j).BackColor Then
                 ColorEposition1(i) = j
               Exit For
            End If
        Next j
    Next i
End Sub

Public Sub RGBEnd2(Bp As Integer, Ep As Integer, RGBWidth As Integer)
    For i = 0 To 2
        For j = Bp To Ep Step RGBWidth
            If DgColor(i) = Form1.Shape1(j).BackColor Then
                 ColorEposition2(i) = j
               Exit For
            End If
        Next j
    Next i
End Sub

Public Sub BeginWrite()
    If (OutEnableFlag = True) And (OutOverFlag = False) Then
        If (WriteFlag1 = True) Or (WriteFlag2 = True) Then
           Call WriteFile(0)
           WriteFlag1 = False
           WriteFlag2 = False
        End If
    End If
End Sub

Public Function CompleteWrite()
    CompleteWrite = 0
    TotalRec = AddressData
    If CheckPosition = True Then
       AddressData = EpromSize - (EpromSize Mod TotalRec)
       Exit Function
    End If
    
    OutOverFlag = True
    ReDim FileData(0 To TotalFile - 1, 0 To TotalRec - 1)
    For i = 1 To TotalFile
       Close #i
       FileName = "OUTPUT\" & OutResponse & i & ".HEX"
       Open FileName For Input As #i
    Next i
    
    For i = 1 To TotalFile
       For j = 0 To TotalRec - 1
          Line Input #i, FileData(i - 1, j)
          FileData(i - 1, j) = Mid(FileData(i - 1, j), 10, 2)
       Next j
    Next i
    
    For i = 1 To TotalFile
        Close #i
        FileName = "OUTPUT\" & OutResponse & i & ".HEX"
        Open FileName For Append As #i
    Next i
    
    NowRec = 0
    Do Until AddressData >= EpromSize
       Call WriteFile(1)
    Loop
    
    For i = 1 To TotalFile
       Print #i, ":00000001FF"
       Close #i
    Next i
    
    Erase FileData
    
    Form1.Label4.Visible = False
    StopNow (0)
    CompleteWrite = 1
    MsgBox "数据输出完毕！", 64, "输出"
End Function

Public Sub StopNow(ByVal Mode As Byte)
    Form1.Timer3.Enabled = False
    Form1.Timer4.Enabled = False
    Form1.Timer5.Enabled = False
    
    Form1.Timer1.Enabled = False
    Form1.Timer2.Enabled = False
    
    If Mode = 0 Then
        For i = 0 To NowLs - 1
           Form1.Shape1(i).Visible = True
        Next i
        
        For i = 0 To TotalHz - 1
           If HzXuHao(i) <> TotalHz Then
              Form1.Label1(HzXuHao(i)).Visible = True
           End If
        Next i
        Form1.FILE.Enabled = True
        Form1.Edit.Enabled = True
        Form1.SHUAXIN.Enabled = True
        Form1.STOPPLAY.Enabled = True
        Form1.BEGINPLAY.Enabled = True
    End If
End Sub

Public Sub DgInitialize(ByVal Name As String, ByVal Mode As Integer)
      Select Case Name
      Case HuaYangShaoMiaoName1, HuaYangShaoMiaoName3, HuaYangShaoMiaoName5, HuaYangBaiYeName1, HuaYangBaiYeName3, HuaYangZhongKaiName1, HuaYangZhongKaiName3, HuaYangLiuShuiName1, HuaYangLiuShuiName2, HuaYangYaLuoName1, HuaYangYaLuoName3, HuaYangPengPengName1, HuaYangPengPengName2, HuaYangZuoYouName1, HuaYangZuoYouName2, HuaYangDuiLiuName1, HuaYangDuiLiuName2, HuaYangDuiDuiName1, HuaYangDuiDuiName2, HuaYangDuiLuoName1, HuaYangDuiLuoName2
           For i = 0 To NowLs - 1
               If Mode = 0 Then
                  Form1.Shape1(i).Visible = False
               Else
                  OutputData(i) = 0
               End If
           Next i
      
      Case HuaYangShaoMiaoName2, HuaYangShaoMiaoName4, HuaYangBaiYeName2, HuaYangBaiYeName4, HuaYangZhongKaiName2, HuaYangZhongKaiName4, HuaYangYaLuoName2, HuaYangYaLuoName4, HuaYangZuoYouName3, HuaYangZuoYouName4, HuaYangDuiDuiName3, HuaYangDuiDuiName4
           For i = 0 To NowLs - 1
               If Mode = 0 Then
                  Form1.Shape1(i).Visible = True
               Else
                  OutputData(i) = 1
               End If
           Next i
    End Select
End Sub

Public Sub DgHyShuoMing(ByVal Name As String)
  Select Case Name
    Case HuaYangShaoMiaoName1
         Form5.Text1.Text = "从左到右亮"
    Case HuaYangShaoMiaoName2
         Form5.Text1.Text = "从右到左灭"
    Case HuaYangShaoMiaoName3
         Form5.Text1.Text = "从右到左亮"
    Case HuaYangShaoMiaoName4
         Form5.Text1.Text = "从左到右灭"
    Case HuaYangShaoMiaoName5
         Form5.Text1.Text = "第一种颜色的灯管从左到右亮，然后从右到左灭。第二种颜色的灯管从右到左亮，然后从左到右灭。然后第一种颜色的灯管从左到右亮，同时第二种颜色的灯管从右到左亮"
         
         
    Case HuaYangBaiYeName1
         Form5.Text1.Text = "从左到右按设定宽度亮"
    Case HuaYangBaiYeName2
         Form5.Text1.Text = "从右到左按设定宽度灭"
    Case HuaYangBaiYeName3
         Form5.Text1.Text = "从右到左按设定宽度亮"
    Case HuaYangBaiYeName4
         Form5.Text1.Text = "从左到右按设定宽度灭"
         
    
    
    Case HuaYangZhongKaiName1
         Form5.Text1.Text = "从中间向两边亮"
    Case HuaYangZhongKaiName2
         Form5.Text1.Text = "从两边向中间灭"
    Case HuaYangZhongKaiName3
         Form5.Text1.Text = "从两边向中间亮"
    Case HuaYangZhongKaiName4
         Form5.Text1.Text = "从中间向两边灭"
  
    Case HuaYangLiuShuiName1
         Form5.Text1.Text = "从左向右按明暗比例几根亮,几根灭,向右推进循环,最后全灭"
    Case HuaYangLiuShuiName2
         Form5.Text1.Text = "从右向左按明暗比例几根亮,几根灭,向左推进循环,最后全灭"
  
    Case HuaYangDuiLiuName1
         Form5.Text1.Text = "从两边向中间按明暗比例几根亮,几根灭,推进循环,最后全灭"
    Case HuaYangDuiLiuName2
         Form5.Text1.Text = "从中间向两边按明暗比例几根亮,几根灭,推进循环,最后全灭"
  
    Case HuaYangYaLuoName1
         Form5.Text1.Text = "按设定根数从左亮到右,停住,连续占满全亮"
    Case HuaYangYaLuoName2
         Form5.Text1.Text = "按设定根数从右灭到左,停住,连续占满全灭"
    Case HuaYangYaLuoName3
         Form5.Text1.Text = "按设定根数从右亮到左,停住,连续占满全亮"
    Case HuaYangYaLuoName4
         Form5.Text1.Text = "按设定根数从左灭到右,停住,连续占满全灭"
  
    Case HuaYangPengPengName1
         Form5.Text1.Text = "按设定根数从左向右亮到1/4处,停住,然后,按设定根数再从左向右亮到1/4处,停住,原1/4处的继续到1/2处,停住,以此类推,连续占满全亮"
    Case HuaYangPengPengName2
         Form5.Text1.Text = "按设定根数从右向左亮到1/4处,停住,然后,按设定根数再从右向左亮到1/4处,停住,原1/4处的继续到1/2处,停住,以此类推,连续占满全亮"
  
    Case HuaYangZuoYouName1
         Form5.Text1.Text = "按设定根数从左到右亮"
    Case HuaYangZuoYouName2
         Form5.Text1.Text = "按设定根数从右到左亮"
    Case HuaYangZuoYouName3
         Form5.Text1.Text = "按设定根数从左到右灭"
    Case HuaYangZuoYouName4
         Form5.Text1.Text = "按设定根数从右到左灭"
  
    Case HuaYangDuiDuiName1
         Form5.Text1.Text = "按设定根数从两边向中间亮"
    Case HuaYangDuiDuiName2
         Form5.Text1.Text = "按设定根数从中间向两边亮"
    Case HuaYangDuiDuiName3
         Form5.Text1.Text = "按设定根数从两边向中间灭"
    Case HuaYangDuiDuiName4
         Form5.Text1.Text = "按设定根数从中间向两边灭"
  
    Case HuaYangDuiLuoName1
         Form5.Text1.Text = "按设定根数从中间向两边亮,停住,连续占满全亮"
    Case HuaYangDuiLuoName2
         Form5.Text1.Text = "按设定根数从两边向中间亮,停住,连续占满全亮"
  
  
    Case Else
         Form5.Text1.Text = Empty
  End Select

End Sub

Public Sub HzHyShuoMing(ByVal Name As String)
  Select Case Name
    Case HuaYangShaoMiaoName1
         Form6.Text1.Text = "全灭,然后从左到右亮"
    Case HuaYangShaoMiaoName2
         Form6.Text1.Text = "全灭,然后从右到左亮"
    
    Case HuaYangQuanLiangName1
         Form6.Text1.Text = "全部灭掉,过一会儿全亮"
         
    Case Else
         Form6.Text1.Text = Empty
  End Select
End Sub

Public Sub ZkPosition()
Dim NowZkP As Integer
    Form5.Combo2(7).Enabled = True
    NowZkP = NowLs / 2
    If NowZkP <= 0 Then
       NowZkP = 1
    End If
    Form5.Text3(7).Text = NowZkP
    HuaYangCs(Form5.List1.ListIndex, 7) = Form5.Text3(7).Text
End Sub