ctlmeter.ctl

电力行业通用的矢量图控件原码

VERSION 5.00
Begin VB.UserControl ctlMeter 
   BackColor       =   &H00C0C0C0&
   ClientHeight    =   4995
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4995
   ScaleHeight     =   4995
   ScaleWidth      =   4995
   Begin VB.PictureBox ctlPic 
      AutoRedraw      =   -1  'True
      BackColor       =   &H00FFFFFF&
      Height          =   5000
      Left            =   -15
      ScaleHeight     =   4935
      ScaleWidth      =   4935
      TabIndex        =   0
      Top             =   -15
      Width           =   5000
   End
End
Attribute VB_Name = "ctlMeter"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Private ctlW As Single
Private mUa As Single
Private mUb As Single
Private mUc As Single
Private mUaQ As Single
Private mUbQ As Single
Private mUcQ As Single
Private mIa As Single
Private mIb As Single
Private mIc As Single
Private mIaQ As Single
Private mIbQ As Single
Private mIcQ As Single
Private mR As Single
Private mFlaG34 As Boolean
Private mPreSet As Boolean

Private Sub UserControl_Initialize()
  ctlW = UserControl.Width
  UserControl.Height = ctlW
  ctlPic.Move 0, 0, ctlW, ctlW
  UserControl.Line (0, 0)-(ctlW, ctlW), &HFFFFFF, B
  UserControl.Line (-15, -15)-(ctlW - 15, ctlW - 15), &H808080, B
  mR = ctlW - 120
  Size ctlW, ctlW
  mFlaG34 = True
End Sub

Private Sub UserControl_Resize()
  ctlW = UserControl.Width
  UserControl.Height = ctlW
  ctlPic.Move 0, 0, ctlW, ctlW
  Debug.Print UserControl.Width, ctlPic.Width, ctlPic.ScaleWidth
  If ctlW < 300 Then
    UserControl.Width = 300
  Else
    RefreshMeter
  End If
End Sub

Public Property Let Ua(ByVal vNewValue As Single)
  mUa = vNewValue
  PropertyChanged "Ua"
End Property

Public Property Get Ua() As Single
    Ua = mUa
End Property

Public Property Let Ub(ByVal vNewValue As Single)
  mUb = vNewValue
  PropertyChanged "Ub"
End Property

Public Property Get Ub() As Single
    Ub = mUb
End Property
Public Property Let Uc(ByVal vNewValue As Single)
  mUc = vNewValue
  PropertyChanged "Uc"
End Property

Public Property Get Uc() As Single
    Uc = mUc
End Property
Public Property Get FlaG34() As Boolean
  FlaG34 = mFlaG34
End Property

Public Property Let FlaG34(ByVal vNewValue As Boolean)
  mFlaG34 = vNewValue
  If Not mFlaG34 Then
    mIb = 0
    mIbQ = 0
  End If
  PropertyChanged "FlaG34"
End Property

Public Property Get PreSet() As Boolean
  PreSet = mPreSet
End Property

Public Property Let PreSet(ByVal vNewValue As Boolean)
  mPreSet = vNewValue
  PropertyChanged "PreSet"
End Property

Public Property Let Ic(ByVal vNewValue As Single)
  mIc = vNewValue
  PropertyChanged "Ic"
End Property

Public Property Get Ic() As Single
    Ic = mIc
End Property
Public Property Let Ib(ByVal vNewValue As Single)
  mIb = vNewValue
  PropertyChanged "Ib"
End Property

Public Property Get Ib() As Single
    Ib = mIb
End Property

Public Property Let Ia(ByVal vNewValue As Single)
  mIa = vNewValue
  PropertyChanged "Ia"
End Property

Public Property Get Ia() As Single
    Ia = mIa
End Property
''''''
Public Property Let UaQ(ByVal vNewValue As Single)
  mUaQ = vNewValue
  PropertyChanged "UaQ"
End Property

Public Property Get UaQ() As Single
    UaQ = mUaQ
End Property

Public Property Let UbQ(ByVal vNewValue As Single)
  mUbQ = vNewValue
  PropertyChanged "UbQ"
End Property

Public Property Get UbQ() As Single
    UbQ = mUbQ
End Property
Public Property Let UcQ(ByVal vNewValue As Single)
  mUcQ = vNewValue
  PropertyChanged "UcQ"
End Property

Public Property Get UcQ() As Single
    UcQ = mUcQ
End Property
Public Property Let IcQ(ByVal vNewValue As Single)
  mIcQ = vNewValue
  PropertyChanged "IcQ"
End Property

Public Property Get IcQ() As Single
    IcQ = mIcQ
End Property
Public Property Let IbQ(ByVal vNewValue As Single)
  mIbQ = vNewValue
  PropertyChanged "IbQ"
End Property

Public Property Get IbQ() As Single
    IbQ = mIbQ
End Property

Public Property Let IaQ(ByVal vNewValue As Single)
  mIaQ = vNewValue
  PropertyChanged "IaQ"
End Property

Public Property Get IaQ() As Single
    IaQ = mIaQ
End Property

'''''
Public Property Let R(ByVal vNewValue As Single)
  mR = vNewValue
  PropertyChanged "R"
End Property

Public Property Get R() As Single
    R = mR
End Property

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    On Error Resume Next
    Ua = PropBag.ReadProperty("Ua", 100)
    Ub = PropBag.ReadProperty("Ub", 100)
    Uc = PropBag.ReadProperty("Uc", 100)
    Ia = PropBag.ReadProperty("Ia", 100)
    Ib = PropBag.ReadProperty("Ib", 100)
    Ic = PropBag.ReadProperty("Ic", 100)
    UaQ = PropBag.ReadProperty("UaQ", 90)
    UbQ = PropBag.ReadProperty("UbQ", 210)
    UcQ = PropBag.ReadProperty("UcQ", 330)
    IaQ = PropBag.ReadProperty("IaQ", 90)
    IbQ = PropBag.ReadProperty("IbQ", 210)
    IcQ = PropBag.ReadProperty("IcQ", 330)
    R = PropBag.ReadProperty("R", ctlW - 120)
    FlaG34 = PropBag.ReadProperty("FlaG34", True)
    PreSet = PropBag.ReadProperty("PreSet", True)
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    PropBag.WriteProperty "Ua", mUa
    PropBag.WriteProperty "Ub", mUb
    PropBag.WriteProperty "Uc", mUc
    PropBag.WriteProperty "Ia", mIa
    PropBag.WriteProperty "Ib", mIb
    PropBag.WriteProperty "Ic", mIc
    PropBag.WriteProperty "UaQ", mUaQ
    PropBag.WriteProperty "UbQ", mUbQ
    PropBag.WriteProperty "UcQ", mUcQ
    PropBag.WriteProperty "IaQ", mIaQ
    PropBag.WriteProperty "IbQ", mIbQ
    PropBag.WriteProperty "IcQ", mIcQ
    PropBag.WriteProperty "R", mR
    PropBag.WriteProperty "FlaG34", True
End Sub

Private Sub RefreshMeter1()
    Dim X As Double
    Dim Y As Double
    Dim Xx As Double
    Dim Yy As Double
    Dim I As Integer
    Dim j As Integer
    Dim R As Double
    Dim T As Single
    Dim QQQ As Single
    Dim XXX(2) As Single
    Dim YYY(2) As Single
    Dim RRR(2) As Single
    Dim QQQQ(2) As Single
    
    On Error Resume Next
    ctlPic.Cls
    If ctlW > 600 Then mR = (ctlW - 600) / 2
    ctlPic.Move 0, 0, ctlW, ctlW
    ctlPic.ForeColor = vbGreen
    ctlPic.DrawWidth = 1
    T = (ctlW - mR * 2) / 2
    ctlPic.Line (ctlW / 2, 0)-(ctlW / 2, ctlW)    'Y轴
    ctlPic.Line (0, ctlW / 2)-(ctlW, ctlW / 2)    'X轴
    ctlPic.DrawWidth = 1
    For I = 1 To 6
      ctlPic.Circle (ctlW / 2, ctlW / 2), mR / 6 * I
    Next I
    R = mR + 300
    ctlPic.FontSize = 9
    For I = 1 To 12
          X = ctlW / 2 + R * Cos(-30 * I / 360 * 2 * 3.1415926)
          Y = ctlW / 2 + R * Sin(-30 * I / 360 * 2 * 3.1415926)
          ctlPic.Line (ctlW / 2, ctlW / 2)-(X, Y)
          If I = 12 Then X = X - 240
          If I < 4 Then X = X - 120
          If I = 9 Then Y = Y - 240
          If I = 11 Then X = X - 120
          ctlPic.CurrentX = X
          ctlPic.CurrentY = Y
          ctlPic.Print IIf(30 * I = 360, 0, 30 * I) & "°"
    Next I
    ctlPic.CurrentX = 0
    ctlPic.CurrentY = 0
    ctlPic.Print "向量图"