public.bas

VISUAL BASIC 6 实现的自动化控制系统程序. 里面包含了好几个OCX源代码.我5年前的作品.现在看起来有点垃圾了.

Attribute VB_Name = "ModSubFun"
Option Explicit
'*****************************************************************************
'主程序
'快速显示，用户登陆，密码（打开用户登陆窗体）
'****************************************************************************
Public Sub Main()
frmSplash.Show                 '快速显示
frmSplash.Refresh
Load FrmMain
frm1.Show vbModal              '登录对话框 有模式
'调入主窗体，其实在登陆对话框输入密码时就已调入了
If frm1.LoginSucceeded = False Then
    Unload FrmMain       '用户登陆许可信息
    End
End If
Unload frmSplash
End Sub

'从链表中删除
Public Sub OneQuitCyc(Index As Integer)
FrmMain.MyValve(Index).InCyc = False
    Select Case Index
    Case 0 To 5
        Accont1 = Accont1 - 1
        If Accont1 = 0 Then
            StarID1 = -1
            FrmMain.MyValve(Index).CycNextID = 0
        Else
                CycReOrder (True) '从新排列
        End If
    Case 6 To 9
        Accont2 = Accont2 - 1
        If Accont2 = 0 Then
            StarID2 = -1
            FrmMain.MyValve(Index).CycNextID = 0
        Else
               CycReOrder (False) '从新排列
        End If
   End Select
End Sub

'添加到循环链表
Public Sub OneInToCyc(Index As Integer)
FrmMain.MyValve(Index).InCyc = True
'从新排列
Select Case Index
     Case 0 To 5         '一号灌区
        CycReOrder (True)
     Case 6 To 9         '二号灌区
        CycReOrder (False)
   End Select
End Sub

Public Sub CycReOrder(IsFirstCyc As Boolean)     '从新排列循环链表
Dim I As Integer
Dim CycLastID As Integer                '链表最后一个
Dim MyCycNextID As Integer
CycLastID = 0
If IsFirstCyc = True Then       '一号灌区
        Accont1 = 0
        For I = 5 To 0 Step -1
           If FrmMain.MyValve(I).InCyc = True Then      '添加到链表
                Accont1 = Accont1 + 1
                If CycLastID = 0 Then           '若最后一个
                    CycLastID = I
                Else
                    FrmMain.MyValve(I).CycNextID = MyCycNextID
                End If
                MyCycNextID = I
            End If
        Next
        FrmMain.MyValve(CycLastID).CycNextID = MyCycNextID
Else       '二号灌区
        Accont2 = 0
        For I = 9 To 6 Step -1
            If FrmMain.MyValve(I).InCyc = True Then
                Accont2 = Accont2 + 1
                If CycLastID = 0 Then
                    CycLastID = I
                Else
                    FrmMain.MyValve(I).CycNextID = MyCycNextID
                End If
                MyCycNextID = I
            End If
        Next
        FrmMain.MyValve(CycLastID).CycNextID = MyCycNextID
End If
End Sub


'使阀、泵的BackColor和地图底色一样
Public Sub Mapshow()
    FrmMain.BackColor = FrmMain.MainMap.BackColor
End Sub

'道路
Public Sub MapLineShow(VisAble As Boolean, MyWidth As Integer)
Dim I As Integer
For I = 0 To 2
    If VisAble Then
        FrmMain.LineRoadH(I).Visible = True
        FrmMain.LineRoadV(I).Visible = True
        FrmMain.LineRoadV(4).Visible = True
        FrmMain.LineRoadV(5).Visible = True
    Else
        FrmMain.LineRoadH(I).Visible = False
        FrmMain.LineRoadV(I).Visible = False
        FrmMain.LineRoadV(4).Visible = False
        FrmMain.LineRoadV(5).Visible = False
    End If
    FrmMain.LineRoadH(I).BorderWidth = MyWidth
    FrmMain.LineRoadV(I).BorderWidth = MyWidth
Next
FrmMain.LineRoadV(3).BorderWidth = MyWidth
FrmMain.LineRoadV(4).BorderWidth = MyWidth
FrmMain.LineRoadV(5).BorderWidth = MyWidth

End Sub
Public Sub MapLineColor(MyColor As ColorConstants) 'ColorConstants)
Dim I As Integer
For I = 0 To 2
    FrmMain.LineRoadH(I).BorderColor = MyColor
    FrmMain.LineRoadV(I).BorderColor = MyColor
Next
    FrmMain.LineRoadV(4).BorderColor = MyColor
    FrmMain.LineRoadV(5).BorderColor = MyColor
End Sub

'管道
Public Sub PipeLineShow(VisAble As Boolean, MyWidth As Integer)
Dim I As Integer
For I = 0 To 11
    If VisAble Then
        FrmMain.PipeLine(I).Visible = True
    Else
        FrmMain.PipeLine(I).Visible = False
    End If
    FrmMain.PipeLine(I).BorderWidth = MyWidth
Next
End Sub
Public Sub PipeLineColor(MyColor As ColorConstants) 'ColorConstants)
Dim I As Integer
For I = 0 To 11
    FrmMain.PipeLine(I).BorderColor = MyColor
Next

End Sub

'河道
Public Sub RiveLineShow(VisAble As Boolean, MyWidth As Integer)
Dim I As Integer
If VisAble Then
    FrmMain.LineRive1.Visible = True
Else
    FrmMain.LineRive1.Visible = False
End If
FrmMain.LineRive1.BorderWidth = MyWidth
'For I = 0 To 10
'    If VisAble Then
'        FrmMain.LineRive2(I).Visible = True
'    Else
'        FrmMain.LineRive2(I).Visible = False
'    End If
'    FrmMain.LineRive2(I).BorderWidth = MyWidth
'Next
End Sub
Public Sub RiveLineColor(MyColor As ColorConstants) 'ColorConstants)
Dim I As Integer
FrmMain.LineRive1.BorderColor = MyColor
'For I = 0 To 10
'    FrmMain.LineRive2(I).BorderColor = MyColor
'Next
End Sub
Public Sub ShowFlux(FluxIsShow As Boolean)
Dim I As Integer
For I = 0 To 9
    FrmMain.TxtFluxV(I).Visible = FluxIsShow
    FrmMain.LabMHtitl(I).Visible = FluxIsShow
    FrmMain.Lab3Title(I).Visible = FluxIsShow
Next
FrmMain.LabMHtitl(10).Visible = FluxIsShow
FrmMain.Lab3Title(10).Visible = FluxIsShow
FrmMain.LabMHtitl(11).Visible = FluxIsShow
FrmMain.Lab3Title(11).Visible = FluxIsShow
FrmMain.TxtFlow(0).Visible = FluxIsShow
FrmMain.TxtFlow(1).Visible = FluxIsShow
End Sub

Public Sub ShowMovieSpeed(MoveInterval As Integer)
Dim I As Integer
For I = 0 To 9
    FrmMain.MyValve(I).Interval = MoveInterval
Next
For I = 0 To 4
    FrmMain.FFOTitl(I).Interval = MoveInterval
Next

FrmMain.MyPump(0).Interval = MoveInterval
FrmMain.MyPump(1).Interval = MoveInterval
FrmMain.ElecTitl1.Interval = MoveInterval
'FrmMain.水标签1.Interval = MoveInterval
FrmMain.CCComputer1.Interval = MoveInterval

End Sub

Sub CreateFile(Name As String)
Dim fs
Dim a
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set a = fs.CreateTextFile(Name, True)
    a.Close
End Sub