pumpring.ctl

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

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.UserControl MyPumpControl 
   ClientHeight    =   3810
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   3120
   ScaleHeight     =   3810
   ScaleWidth      =   3120
   ToolboxBitmap   =   "PumpRing.ctx":0000
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   200
      Left            =   3330
      Top             =   930
   End
   Begin VB.PictureBox Picture1 
      Appearance      =   0  'Flat
      BackColor       =   &H0000FF00&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   1215
      Left            =   0
      MouseIcon       =   "PumpRing.ctx":0312
      MousePointer    =   99  'Custom
      ScaleHeight     =   1215
      ScaleWidth      =   1155
      TabIndex        =   0
      Top             =   0
      Width           =   1155
   End
   Begin MSComctlLib.ImageList ImageList1 
      Left            =   2730
      Top             =   2460
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   32
      ImageHeight     =   32
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   4
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "PumpRing.ctx":0464
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "PumpRing.ctx":1038
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "PumpRing.ctx":1C0C
            Key             =   ""
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "PumpRing.ctx":27E0
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin VB.Menu MnuOpenP 
      Caption         =   "My开泵控制"
      Begin VB.Menu MnuTitl 
         Caption         =   "泵控制"
      End
      Begin VB.Menu MnuSeparate 
         Caption         =   "-"
      End
      Begin VB.Menu MnuOpen 
         Caption         =   "Open"
      End
      Begin VB.Menu MnuClose 
         Caption         =   "Close"
      End
   End
End
Attribute VB_Name = "MyPumpControl"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Public IndexID As Integer

Private mTitlName As String
Private mRuning As Boolean
Private xx As Integer

Private mSetOpenTime
Private mSetCloseTime
Private mOpenTime
Private mCloseTime
Private mSetAmount As Double  '设置流量
Private mCurAmount As Double  '当前流量
Private mAddAmount As Double  '合计流量
Private mFluxSpeed As Single  '当前流速
Private mComputAuto As Boolean
Private mInCyc As Boolean       '是否在自动循环里
Private mFFOHandOpen As Boolean        '田间操作器的手动状态
Private mIsChange As Boolean      '阀  状  态  已 改 变
Private mIsInTab As Boolean         '是否在自动链表里
Private mValveState As Integer        '阀的不同状态

Private mPopuMnuAble As Boolean       '是否显示弹出菜单
Private mIsMaster As Boolean          '是否为上游元件
Private mMasterID As Integer          '上游元件
Private mCycNextID As Integer         '循环中的下一个泵号。

Event Click()
Event DbClick()
Event KeyDown(KeyCode As Integer, Shift As Integer)
Event KeyPress(KeyAscii As Integer)
Event KeyUp(KeyCode As Integer, Shift As Integer)
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event DoOpen()
Event DoClose()
Event isOpen()
Event IsClose()

Private Sub Picture1_DblClick()
    RaiseEvent DbClick
End Sub

Private Sub Picture1_KeyDown(KeyCode As Integer, Shift As Integer)
    RaiseEvent KeyDown(KeyCode, Shift)
End Sub

Private Sub Picture1_KeyPress(KeyAscii As Integer)
    RaiseEvent KeyPress(KeyAscii)
End Sub
Private Sub Picture1_KeyUp(KeyCode As Integer, Shift As Integer)
    RaiseEvent KeyUp(KeyCode, Shift)
End Sub

Private Sub MnuOpen_Click()
    RaiseEvent DoOpen
 End Sub
 Private Sub Mnuclose_Click()
    RaiseEvent DoClose
 End Sub
Private Sub Picture1_LostFocus()
    Picture1.BorderStyle = 0
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Picture1.BorderStyle = 1
    Select Case Button
    Case 1
        If Runing Then
            RaiseEvent DoClose
        Else
            RaiseEvent DoOpen
        End If
        RaiseEvent MouseDown(Button, Shift, X, Y)
    Case 2
        If PopuMnuAble Then
            MnuTitl.Caption = "☆" & TitlName & "☆"
            PopupMenu MnuOpenP
        Else
            RaiseEvent MouseDown(Button, Shift, X, Y)
        End If
    End Select
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Picture1.BorderStyle = 0
    RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub

Private Sub UserControl_AmbientChanged(PropertyName As String)
    PropertyName = "BackColor"
    Picture1.BackColor = Ambient.BackColor
    UserControl.BackColor = Ambient.BackColor
End Sub

'SetOpenTime Property
Public Property Get SetOpenTime()
    SetOpenTime = mSetOpenTime
End Property
Public Property Let SetOpenTime(ByVal vNewValue)
    mSetOpenTime = vNewValue
    PropertyChanged "SetOpenTime"
End Property

'MasterID Property
Public Property Get MasterID() As Integer
    MasterID = mMasterID
End Property
Public Property Let MasterID(ByVal vNewValue As Integer)
    mMasterID = vNewValue
    PropertyChanged "MasterID"
End Property

'IsMaster Property
Public Property Get IsMaster() As Boolean
    IsMaster = mIsMaster
End Property
Public Property Let IsMaster(ByVal vNewValue As Boolean)
    mIsMaster = vNewValue
    PropertyChanged "IsMaster"
End Property



'PopuMnuAble Property
Public Property Get PopuMnuAble() As Boolean
    PopuMnuAble = mPopuMnuAble
End Property
Public Property Let PopuMnuAble(ByVal vNewValue As Boolean)
    mPopuMnuAble = vNewValue
    PropertyChanged "PopuMnuAble"
End Property



'ValveState Property
Public Property Get ValveState() As Integer
    ValveState = mValveState
End Property
Public Property Let ValveState(ByVal vNewValue As Integer)
    mValveState = vNewValue
    PropertyChanged "ValveState"
End Property



'IsInTab Property
Public Property Get IsInTab() As Boolean
    IsInTab = mIsInTab
End Property
Public Property Let IsInTab(ByVal vNewValue As Boolean)
    mIsInTab = vNewValue
    PropertyChanged "IsInTab"
End Property


'IsChange Property
Public Property Get IsChange() As Boolean
    IsChange = mIsChange
End Property
Public Property Let IsChange(ByVal vNewValue As Boolean)
    mIsChange = vNewValue
    PropertyChanged "IsChange"
End Property

'FFOHandOpen Property
Public Property Get FFOHandOpen() As Boolean
    FFOHandOpen = mFFOHandOpen
End Property
Public Property Let FFOHandOpen(ByVal vNewValue As Boolean)
    mFFOHandOpen = vNewValue
    PropertyChanged "FFOHandOpen"
End Property

'InCyc Property
Public Property Get InCyc() As Boolean
    InCyc = mInCyc
End Property
Public Property Let InCyc(ByVal vNewValue As Boolean)
    mInCyc = vNewValue
    PropertyChanged "InCyc"
End Property

'ComputAuto Property
Public Property Get ComputAuto() As Boolean
    ComputAuto = mComputAuto
End Property
Public Property Let ComputAuto(ByVal vNewValue As Boolean)
    mComputAuto = vNewValue
    PropertyChanged "ComputAuto"
End Property

'FluxSpeed Property
Public Property Get FluxSpeed() As Single
    FluxSpeed = mFluxSpeed
End Property
Public Property Let FluxSpeed(ByVal vNewValue As Single)
    mFluxSpeed = vNewValue
    PropertyChanged "FluxSpeed"
End Property

'AddAmount Property
Public Property Get AddAmount() As Double
    AddAmount = mAddAmount
End Property
Public Property Let AddAmount(ByVal vNewValue As Double)
    mAddAmount = vNewValue
    PropertyChanged "AddAmount"
End Property


'CurAmount Property
Public Property Get CurAmount() As Double
    CurAmount = mCurAmount
End Property
Public Property Let CurAmount(ByVal vNewValue As Double)
    mCurAmount = vNewValue
    PropertyChanged "CurAmount"
End Property

'SetAmount Property
Public Property Get SetAmount() As Double
    SetAmount = mSetAmount
End Property
Public Property Let SetAmount(ByVal vNewValue As Double)
    mSetAmount = vNewValue
    PropertyChanged "SetAmount"
End Property

'CloseTime Property
Public Property Get CloseTime()
    CloseTime = mCloseTime
End Property
Public Property Let CloseTime(ByVal vNewValue)
    mCloseTime = vNewValue
    PropertyChanged "CloseTime"
End Property

'OpenTime Property
Public Property Get OpenTime()
    OpenTime = mOpenTime
End Property
Public Property Let OpenTime(ByVal vNewValue)
    mOpenTime = vNewValue
    PropertyChanged "OpenTime"
End Property


'SetCloseTime Property
Public Property Get SetCloseTime()
    SetCloseTime = mSetCloseTime
End Property
Public Property Let SetCloseTime(ByVal vNewValue)
    mSetCloseTime = vNewValue
    PropertyChanged "SetCloseTime"
End Property

'mCycNextID Property
Public Property Get CycNextID() As Integer
    CycNextID = mCycNextID
End Property
Public Property Let CycNextID(ByVal vNewValue As Integer)
    mCycNextID = vNewValue
    PropertyChanged "CycNextID"
End Property

'Interval Property
Public Property Get Interval() As Integer
    Interval = Timer1.Interval
End Property
Public Property Let Interval(ByVal vNewValue As Integer)
    Timer1.Interval = vNewValue
    PropertyChanged "Interval"
End Property
Private Sub Timer1_Timer()
    xx = xx + 1
    Set Picture1.Picture = ImageList1.ListImages(xx).Picture
    If xx >= 4 Then xx = 0
End Sub

Public Property Get Runing() As Boolean
    Runing = mRuning
End Property
Public Property Let Runing(ByVal vNewValue As Boolean)
     mRuning = vNewValue
     If mRuning = True Then
         MnuOpen.Enabled = False
         MnuClose.Enabled = True
         Timer1.Enabled = True
         OpenTime = Now
         RaiseEvent isOpen
         
     Else
         MnuOpen.Enabled = True
         MnuClose.Enabled = False
        Timer1.Enabled = False
        CloseTime = Now
        RaiseEvent IsClose
     End If
     PropertyChanged "Runing"
End Property
'BackColor Property
Public Property Get BackColor() As OLE_COLOR
    BackColor = Picture1.BackColor
End Property
Public Property Let BackColor(ByVal vNewValue As OLE_COLOR)
     Picture1.BackColor = vNewValue
     PropertyChanged "BackColor"
End Property

'TitlName Property
Public Property Get TitlName() As String
    TitlName = mTitlName
End Property
Public Property Let TitlName(ByVal vNewValue As String)
     mTitlName = vNewValue
     PropertyChanged "TitlName"
End Property
Private Sub UserControl_Initialize()
    mRuning = False
    MnuClose.Enabled = False
    Picture1.Picture = ImageList1.ListImages(1).Picture
End Sub

Private Sub UserControl_Resize()
UserControl.BackColor = Picture1.BackColor
Picture1.Left = 2
Picture1.Top = 2
Picture1.Height = UserControl.ScaleHeight - 5
Picture1.Width = UserControl.ScaleWidth
End Sub
Private Sub UserControl_ReadProperties(Propbag As PropertyBag)
    mRuning = Propbag.ReadProperty("Runing", 0)
    Picture1.BackColor = Propbag.ReadProperty("BackColor", &H80000005)
    Timer1.Interval = Propbag.ReadProperty("Interval", 200)
    mTitlName = Propbag.ReadProperty("TitlName", "")
    mSetOpenTime = Propbag.ReadProperty("SetOpenTime", 0)
    mSetCloseTime = Propbag.ReadProperty("SetCloseTime", 0)
    mOpenTime = Propbag.ReadProperty("OpenTime", 0)
    mCloseTime = Propbag.ReadProperty("CloseTime", 0)
    
    mSetAmount = Propbag.ReadProperty("SetAmount", 0)
    mCurAmount = Propbag.ReadProperty("CurAmount", 0)
    mAddAmount = Propbag.ReadProperty("AddAmount", 0)
    
    mFluxSpeed = Propbag.ReadProperty("FluxSpeed", 0)
    mComputAuto = Propbag.ReadProperty("ComputAuto", 0)
    mInCyc = Propbag.ReadProperty("InCyc", 0)
    
    mFFOHandOpen = Propbag.ReadProperty("FFOHandOpen", 0)
    mIsChange = Propbag.ReadProperty("IsChange", 0)
    mIsInTab = Propbag.ReadProperty("IsInTab", 0)
    
    mValveState = Propbag.ReadProperty("ValveState", 0)
    mPopuMnuAble = Propbag.ReadProperty("PopuMnuAble", 0)
    mIsMaster = Propbag.ReadProperty("IsMaster", 0)
    mMasterID = Propbag.ReadProperty("MasterID", 0)

End Sub
Private Sub UserControl_WriteProperties(Propbag As PropertyBag)
    Propbag.WriteProperty "Runing", mRuning, 0
    Propbag.WriteProperty "BackColor", Picture1.BackColor, &H80000005
    Propbag.WriteProperty "Interval", Timer1.Interval, 200
    Propbag.WriteProperty "TitlName", mTitlName, ""
    
    Propbag.WriteProperty "SetOpenTime", mSetOpenTime, 0
    Propbag.WriteProperty "SetCloseTime", mSetCloseTime, 0
    Propbag.WriteProperty "OpenTime", mOpenTime, 0
    Propbag.WriteProperty "CloseTime", mCloseTime, 0
    
    Propbag.WriteProperty "SetAmount", mSetAmount, 0
    Propbag.WriteProperty "CurAmount", mCurAmount, 0
    Propbag.WriteProperty "AddAmount", 0
    
    Propbag.WriteProperty "FluxSpeed", mFluxSpeed, 0
    Propbag.WriteProperty "ComputAuto", mComputAuto, 0
    Propbag.WriteProperty "InCyc", mInCyc, 0
    
    Propbag.WriteProperty "FFOHandOpen", mFFOHandOpen, 0
    Propbag.WriteProperty "IsChange", mIsChange, 0
    Propbag.WriteProperty "IsInTab", mIsInTab, 0
    
    Propbag.WriteProperty "ValveState", mValveState, 0
    Propbag.WriteProperty "PopuMnuAble", mPopuMnuAble, 0
    Propbag.WriteProperty "IsMaster", mIsMaster, 0
    Propbag.WriteProperty "MasterID", mMasterID, 0

End Sub