nihongdeng.bas

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

Attribute VB_Name = "Module1"
Global Const TotalHz = 20
Global Const TotalLs = 600

Global Const TotalOutLs = 624   '78*8=624 > TotalHz+TotalLs=620
Global Const TotalOut = TotalOutLs / 8  'TotalOutLs/8=624/8=78


Global Const LsDefault = 0
Global Const QdDefault = 0
Global Const KdDefault = 15
Global Const JgDefault = 15

Global Const HzTopDefault_1 = 5000
Global Const HzTopDefault_2 = 6000
Global Const HzLeftDefault = 1000
Global Const HzSizeDefault = 36
Global Const HzFontDefault = "宋体"
Global Const HzNumberDefault = 0
Global Const HzColorDefault = &H80FFFF

Global Const ColorDefault = 0
Global Const ColorRed = 12
Global Const ColorGreen = 10
Global Const ColorBlue = 9

Global Const LiuShuiDefault = "2：2"
Global Const YaLuoDefault = "1"
Global Const PengPengDefault = "1"
Global Const ZuoYouDefault = "1"
Global Const TingZhiDefault = "1"
Global Const XunHuanDefault = "1"
Global Const SaoMiaoDefault = "0.001"
Global Const ZhongKaiDefault = "1"
Global Const BaiYeDefault = "1"

Global Const TingZhiHzDefault = "1"
Global Const XunHuanHzDefault = "1"
Global Const SaoMiaoHzDefault = "1"
Global Const DgHyHzDefault = "-1"


Global Const MaxHuaYangNumber = 200
Global Const HuaYangNoUseName = "未用"

Global Const HuaYangShaoMiaoName1 = "扫描1"
Global Const HuaYangShaoMiaoName2 = "扫描2"
Global Const HuaYangShaoMiaoName3 = "扫描3"
Global Const HuaYangShaoMiaoName4 = "扫描4"
Global Const HuaYangShaoMiaoName5 = "扫描5"

Global Const HuaYangBaiYeName1 = "百叶1"
Global Const HuaYangBaiYeName2 = "百叶2"
Global Const HuaYangBaiYeName3 = "百叶3"
Global Const HuaYangBaiYeName4 = "百叶4"
 
Global Const HuaYangZhongKaiName1 = "中开1"
Global Const HuaYangZhongKaiName2 = "中开2"
Global Const HuaYangZhongKaiName3 = "中开3"
Global Const HuaYangZhongKaiName4 = "中开4"
 
Global Const HuaYangLiuShuiName1 = "流水1"
Global Const HuaYangLiuShuiName2 = "流水2"

Global Const HuaYangDuiLiuName1 = "对流1"
Global Const HuaYangDuiLiuName2 = "对流2"
 
Global Const HuaYangYaLuoName1 = "压罗1"
Global Const HuaYangYaLuoName2 = "压罗2"
Global Const HuaYangYaLuoName3 = "压罗3"
Global Const HuaYangYaLuoName4 = "压罗4"
 
Global Const HuaYangDuiLuoName1 = "对罗1"
Global Const HuaYangDuiLuoName2 = "对罗2"
 
Global Const HuaYangPengPengName1 = "碰碰1"
Global Const HuaYangPengPengName2 = "碰碰2"

Global Const HuaYangZuoYouName1 = "左右1"
Global Const HuaYangZuoYouName2 = "左右2"
Global Const HuaYangZuoYouName3 = "左右3"
Global Const HuaYangZuoYouName4 = "左右4"
 
Global Const HuaYangDuiDuiName1 = "对对1"
Global Const HuaYangDuiDuiName2 = "对对2"
Global Const HuaYangDuiDuiName3 = "对对3"
Global Const HuaYangDuiDuiName4 = "对对4"
 
Global Const HuaYangQuanLiangName1 = "全亮"

Global Const BackgroundLeftDefault = 0
Global Const BackgroundWidthDefault = 11895

Global Const HzWidthDefault = 200

Global Const DemoTimes = 5

Global TotalDgHuaYang As Integer
Global TotalHzHuaYang As Integer

Global HzXuHao(0 To TotalHz - 1) As Integer
Global LineCount As Integer
Global LineCount1 As Integer
Global LineCount2 As Integer
Global LineCount3 As Integer
Global LineCount4 As Integer
Global LightStyle As Integer
Global LightStyle1 As Integer
Global LightStyle2 As Integer
Global SelectMe As Integer
Global ChangeMe As Boolean
Global EditHzFlag As Boolean
Global NowHz As Integer
Global NowLs As Integer
Global NowQd As Integer
Global NowKd As Integer
Global NowJg As Integer
Global NowX  As Integer
Global NowColor As Integer
Global NowHyName(0 To MaxHuaYangNumber - 1) As String
Global NowHzHyName(0 To MaxHuaYangNumber - 1) As String
Global HuaYangCs(0 To MaxHuaYangNumber - 1, 0 To 8) As String
Global HuaYangHzCs(0 To MaxHuaYangNumber - 1, 0 To 3) As String
Global HzLeft(0 To TotalHz - 1) As Single
Global HzTop(0 To TotalHz - 1) As Single


Global RunSpeed As Integer
Global RunTimes As Integer
Global RunStopTime As Integer
Global RunHyName As String
Global RunZhongKai As Integer
Global RunBaiYe As Integer
Global RunDuiLiu As Integer
Global RunDuiDui As Integer
Global RunDuiLuo As Integer
Global RunLiuShui1 As Integer
Global RunLiuShui2 As Integer
Global RunLiuShui3 As Integer

Global RunYaLuo As Integer

Global RunPengPeng As Integer
Global RunPengPeng1(0 To 2) As Integer
Global RunPengPeng2(0 To 2) As Integer
Global RunPengPeng3(0 To 2) As Integer

Global RunZuoYou As Integer

Global NowRunTimes As Integer


Global RunHzSpeed As Integer
Global RunHzTimes As Integer
Global RunHzStopTime As Integer
Global RunHzHyName As String

Global NowRunHzTimes As Integer

Global LineCountHz As Integer
Global LightStyleHz As Integer
Global NowFileName As String
Global StopPlayFlag As Boolean
Global PlayStyle As Boolean
Global OutOverFlag As Boolean
Global OutputData(0 To TotalOutLs - 1) As Byte '数组为624个元素，624/8=78是个整数
Global TotalFile As Integer
Global NowData(0 To TotalOut - 1) As String
Global EveryData(0 To TotalOut - 1) As String
Global AddressData As Long
Global OutEnableFlag As Boolean
Global NowDgHuaYang As Integer
Global NowHzHuaYang As Integer
Global PengPengLsFlag As Integer
Global DgColor(0 To 2) As Long
Global WriteFlag1 As Boolean
Global WriteFlag2 As Boolean
Global ColorBposition1(0 To 2) As Integer
Global ColorBposition2(0 To 2) As Integer
Global ColorEposition1(0 To 2) As Integer
Global ColorEposition2(0 To 2) As Integer
Global NowLine(0 To 2) As Integer
Global TotalLine(0 To 2) As Integer
Global LeftLine(0 To 2) As Integer
Global NowLine1(0 To 2) As Integer
Global TotalLine1(0 To 2) As Integer
Global LeftLine1(0 To 2) As Integer
Global BLine As Integer
Global ELine As Integer
Global BLine1 As Integer
Global ELine1 As Integer
Global HzOutAdd As Integer
Global FileData() As String
Global TotalRec As Long
Global NowRec As Long
Global OutResponse As String
Global CheckPosition As Boolean
Global EpromSize As Long
Global KeyNumber As String
Global HzColor As Long
Global DengGuanColor1 As Long
Global DengGuanColor2 As Long
Global DengGuanColor3 As Long
Public Sub main()
On Error Resume Next
MkDir "output"

'-------------------这一段为记录使用次数------------------
'RemainDay = GetSetting("MyApp", "set", "times", 0)
'If RemainDay >= DemoTimes Then
'    MsgBox "您使用的是测试版，试用次数已满，请购买正式版软件，或者在A驱动器中插入钥匙盘清零试用次数！", 64, "系统"

'    Open "A:\NHDKEY.TXT" For Input As #1
'    Line Input #1, KeyNumber
'    Close #1
'    If KeyNumber <> "nhdkeypasswordok" Then
'       MsgBox "找不到钥匙盘，程序即将关闭", 48, "钥匙盘检测"
'       End
'    Else
       '-------------------此语句为删除注册表的次数记录，一般不要使用----------
'        DeleteSetting "MyApp", "set", "times"
       '-----------------------------------------------------------------------
'       RemainDay = GetSetting("MyApp", "set", "times", 0)
'       MsgBox "钥匙盘检测成功，试用次数已经清零，欢迎继续使用本软件", 48, "钥匙盘检测"
'    End If
'End If

'MsgBox "您使用的是测试版，现在剩下的试用次数为：" & DemoTimes - RemainDay & "次！", 64, "系统"
'RemainDay = RemainDay + 1
'SaveSetting "MyApp", "set", "times", RemainDay
'---------------------------------------------------------


NewOne
Form1.Show
End Sub

Public Sub NewOne()
Form1.Timer1.Enabled = False
Form1.Timer1.Interval = 0
Form1.Timer2.Enabled = False
Form1.Timer2.Interval = 0
Form1.Timer3.Enabled = False
Form1.Timer3.Interval = 0
Form1.Timer4.Enabled = False
Form1.Timer4.Interval = 0
Form1.Timer5.Enabled = False
Form1.Timer5.Interval = 0
Form1.Label4.Visible = False
Form1.Label5.Visible = False
Form1.Label6.Visible = False
Form1.Label7.Visible = False

If Form1.Data5.Recordset.RecordCount <> 0 Then
   If Not IsNull(Form1.Data5.Recordset.Fields("灯管颜色1")) Then
      DengGuanColor1 = Form1.Data5.Recordset.Fields("灯管颜色1")
   Else
      DengGuanColor1 = QBColor(ColorRed)
   End If

   If Not IsNull(Form1.Data5.Recordset.Fields("灯管颜色2")) Then
      DengGuanColor2 = Form1.Data5.Recordset.Fields("灯管颜色2")
   Else
      DengGuanColor2 = QBColor(ColorGreen)
   End If

   If Not IsNull(Form1.Data5.Recordset.Fields("灯管颜色3")) Then
      DengGuanColor3 = Form1.Data5.Recordset.Fields("灯管颜色3")
   Else
      DengGuanColor3 = QBColor(ColorBlue)
   End If
Else
   DengGuanColor1 = QBColor(ColorRed)
   DengGuanColor2 = QBColor(ColorGreen)
   DengGuanColor3 = QBColor(ColorBlue)
End If

NowLs = LsDefault
NowQd = QdDefault
NowKd = KdDefault
NowJg = JgDefault
For i = 0 To TotalLs - 1
  Form1.Shape1(i).Visible = False
  Form1.Shape1(i).BackColor = DengGuanColor1
  Form1.Shape1(i).BorderColor = DengGuanColor1
Next i

HzColor = HzColorDefault
Form2.Text4.ForeColor = HzColor
Form1.CommonDialog1.Color = HzColor

NowHz = HzNumberDefault
For i = 0 To TotalHz - 1
    Form1.Label3(i).Visible = False
    Form1.Label3(i).FontBold = False
    Form1.Label3(i).FontItalic = False
    Form1.Label3(i).FontUnderline = False
    Form1.Label3(i).Font = HzFontDefault
    Form1.Label3(i).FontSize = HzSizeDefault
    Form1.Label3(i).ForeColor = HzColor


    Form1.Label1(i).Visible = False
    Form1.Label1(i).FontBold = Form1.Label3(i).FontBold
    Form1.Label1(i).FontItalic = Form1.Label3(i).FontItalic
    Form1.Label1(i).FontUnderline = Form1.Label3(i).FontUnderline
    Form1.Label1(i).Font = Form1.Label3(i).Font
    Form1.Label1(i).FontSize = Form1.Label3(i).FontSize
    Form1.Label1(i).ForeColor = Form1.Label3(i).ForeColor
    HzXuHao(i) = TotalHz
Next i

For i = 0 To 9
    Form1.Label3(i).Left = 0 + i * HzLeftDefault
    Form1.Label3(i).Top = HzTopDefault_1
    
    Form1.Label1(i).Left = Form1.Label3(i).Left
    Form1.Label1(i).Top = Form1.Label3(i).Top
    Form1.Label1(i).Height = Form1.Label3(i).Height
    Form1.Label1(i).Width = Form1.Label3(i).Width + HzWidthDefault
    
    HzLeft(i) = Form1.Label1(i).Left
    HzTop(i) = Form1.Label1(i).Top
Next i

For i = 10 To TotalHz - 1
    Form1.Label3(i).Left = 0 + (i - 10) * HzLeftDefault
    Form1.Label3(i).Top = HzTopDefault_2
    
    Form1.Label1(i).Left = Form1.Label3(i).Left
    Form1.Label1(i).Top = Form1.Label3(i).Top
    Form1.Label1(i).Height = Form1.Label3(i).Height
    Form1.Label1(i).Width = Form1.Label3(i).Width + HzWidthDefault
    
    HzLeft(i) = Form1.Label1(i).Left
    HzTop(i) = Form1.Label1(i).Top
Next i

NowColor = ColorDefault
For i = 0 To MaxHuaYangNumber - 1
    NowHyName(i) = HuaYangNoUseName
    NowHzHyName(i) = HuaYangNoUseName
    For j = 0 To 8
      HuaYangCs(i, j) = Empty
    Next j
    
    For j = 0 To 3
      HuaYangHzCs(i, j) = Empty
    Next j
Next i

TotalDgHuaYang = 0
TotalHzHuaYang = 0
EpromSize = 4096

Form1.Shape2.Left = BackgroundLeftDefault
Form1.Shape2.Width = BackgroundWidthDefault
NowFileName = Empty
Form1.Delete.Enabled = False
Form1.HScroll1.Visible = False

End Sub

Public Function SaveFile(ByVal Mode As Byte) As Boolean
If Mode = 1 Then
    Prompt$ = "请输入要保存的文件名"
    Title$ = "保存"
    Response$ = InputBox$(Prompt$, Title$)
    If Response$ = Empty Then
       SaveFile = False
       GoTo SaveEnd
    Else
       NowFileName = Response$
    End If
End If
   
   comp1$ = "名称='" & NowFileName & "'"
   Form1.Data1.Recordset.FindFirst comp1$
   If Not Form1.Data1.Recordset.NoMatch Then
        If Mode = 1 Then
           i = MsgBox("此文件名已存在,是否覆盖？", vbYesNo, "保存")
           If i = vbNo Then
              SaveFile = False
              GoTo SaveEnd
           End If
        End If
      
        Form1.Data1.Recordset.Delete
        
        Form1.Data2.Recordset.FindFirst comp1$
        If Not Form1.Data2.Recordset.NoMatch Then
           Form1.Data2.Recordset.Delete
           Do Until Form1.Data2.Recordset.NoMatch
              Form1.Data2.Recordset.FindNext comp1$
              If Not Form1.Data2.Recordset.NoMatch Then
                 Form1.Data2.Recordset.Delete
              End If
           Loop
        End If
        
        Form1.Data3.Recordset.FindFirst comp1$
        If Not Form1.Data3.Recordset.NoMatch Then
           Form1.Data3.Recordset.Delete
           Do Until Form1.Data3.Recordset.NoMatch
              Form1.Data3.Recordset.FindNext comp1$
              If Not Form1.Data3.Recordset.NoMatch Then
                 Form1.Data3.Recordset.Delete
              End If
           Loop
        End If
        
        Form1.Data4.Recordset.FindFirst comp1$
        If Not Form1.Data4.Recordset.NoMatch Then
           Form1.Data4.Recordset.Delete
           Do Until Form1.Data4.Recordset.NoMatch
              Form1.Data4.Recordset.FindNext comp1$
              If Not Form1.Data4.Recordset.NoMatch Then
                 Form1.Data4.Recordset.Delete
              End If
           Loop
        End If
   End If
   
   Form1.Data1.Recordset.AddNew
   Form1.Data1.Recordset.Fields("名称") = NowFileName
   Form1.Data1.Recordset.Fields("灯管数量") = NowLs
   Form1.Data1.Recordset.Fields("灯管颜色") = NowColor
   Form1.Data1.Recordset.Fields("灯管起点") = NowQd
   Form1.Data1.Recordset.Fields("灯管宽度") = NowKd
   Form1.Data1.Recordset.Fields("灯管间隔") = NowJg
   Form1.Data1.Recordset.Fields("汉字数量") = NowHz
   Form1.Data1.Recordset.Fields("灯管花样数量") = TotalDgHuaYang
   Form1.Data1.Recordset.Fields("汉字花样数量") = TotalHzHuaYang
   Form1.Data1.Recordset.Fields("EPROM空间") = EpromSize
   
   For i = 7 To 26
       Form1.Data1.Recordset(i) = HzXuHao(i - 7)
   Next i
   Form1.Data1.Recordset.Update

   For i = 0 To TotalHz - 1