electitl.ctl

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

VERSION 5.00
Begin VB.UserControl ElecTitl 
   ClientHeight    =   1125
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   1605
   Picture         =   "ElecTitl.ctx":0000
   ScaleHeight     =   1125
   ScaleWidth      =   1605
   ToolboxBitmap   =   "ElecTitl.ctx":030A
   Begin VB.PictureBox Picture2 
      Height          =   435
      Left            =   2100
      ScaleHeight     =   375
      ScaleWidth      =   615
      TabIndex        =   1
      Top             =   2340
      Width           =   675
   End
   Begin VB.Timer Timer1 
      Interval        =   300
      Left            =   1200
      Top             =   570
   End
   Begin VB.PictureBox Picture1 
      Appearance      =   0  'Flat
      BackColor       =   &H00FF8080&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   525
      Left            =   0
      Picture         =   "ElecTitl.ctx":061C
      ScaleHeight     =   525
      ScaleWidth      =   615
      TabIndex        =   0
      Top             =   0
      Width           =   615
   End
End
Attribute VB_Name = "ElecTitl"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Private mRuning As Boolean
Event Click()
Event DbClick()
Event KeyDown()
Event KeyPress()
Event KeyUp()
Event MouseDown()
Event MouseMove()
Event MouseUp()
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
End Sub

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

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Picture1.BorderStyle = 1
    RaiseEvent MouseDown
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Picture1.BorderStyle = 0
    RaiseEvent MouseUp
End Sub

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

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

'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 Picture1_Click()
    RaiseEvent Click
End Sub
Private Sub Timer1_Timer()
If Picture1.Picture = UserControl.Picture Then
    Picture1.Picture = Picture2.Picture
Else
    Picture1.Picture = UserControl.Picture
End If

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
         Timer1.Enabled = True
     Else
        Timer1.Enabled = False
        Picture1.Picture = UserControl.Picture
     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

Private Sub UserControl_Resize()
UserControl.BackColor = Picture1.BackColor
Picture1.Left = 0
Picture1.Top = 0
Picture1.Height = UserControl.ScaleHeight
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)

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

End Sub