cell.ctl

来自「采用VB编写的一个电路分析系统」· CTL 代码 · 共 1,237 行 · 第 1/3 页

'注意！不要删除或修改下列被注释的行！
'MappingInfo=UserControl,UserControl,-1,OLEDropMode
Public Property Get OLEDropMode() As Integer
Attribute OLEDropMode.VB_Description = "返回/设置该对象是否能作为一个 OLE 放下目标。"
    OLEDropMode = UserControl.OLEDropMode
End Property

Public Property Let OLEDropMode(ByVal New_OLEDropMode As Integer)
    UserControl.OLEDropMode() = New_OLEDropMode
    PropertyChanged "OLEDropMode"
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=UserControl,UserControl,-1,PopupMenu
Public Sub PopupMenu(ByVal Menu As Object, Optional ByVal Flags As Variant, Optional ByVal x As Variant, Optional ByVal Y As Variant, Optional ByVal DefaultMenu As Variant)
Attribute PopupMenu.VB_Description = "显示一个 MDIForm 或 Form 对象上的弹出菜单。"
    UserControl.PopupMenu Menu, Flags, x, Y, DefaultMenu
End Sub

' "Point" 后面的下划线是必须的，
'因为它是 VBA 中的保留字。
'注意！不要删除或修改下列被注释的行！
'MappingInfo=UserControl,UserControl,-1,Point
Public Function Point(x As Single, Y As Single) As Long
Attribute Point.VB_Description = "返回一个长整型值，作为 Form 或 PictureBox 对象上指定点的 RGB 颜色值。"
    Point = UserControl.Point(x, Y)
End Function

' "PSet" 后面的下划线是必须的，
'因为它是 VBA 中的保留字。
'注意！不要删除或修改下列被注释的行！
'MappingInfo=UserControl,UserControl,-1,PSet
Public Sub PSet_(x As Single, Y As Single, Color As Long)
    UserControl.PSet Step(x, Y), Color
End Sub

' "Scale" 后面的下划线是必须的，
'因为它是 VBA 中的保留字。
'注意！不要删除或修改下列被注释的行！
'MappingInfo=UserControl,UserControl,-1,Scale
Public Sub Scale_(Optional X1 As Variant, Optional Y1 As Variant, Optional X2 As Variant, Optional Y2 As Variant)
    UserControl.Scale (X1, Y1)-(X2, Y2)
End Sub

'注意！不要删除或修改下列被注释的行！
'MappingInfo=UserControl,UserControl,-1,ScaleHeight
Public Property Get ScaleHeight() As Single
Attribute ScaleHeight.VB_Description = "返回/设置对象内部的垂直度量的单位数。"
    ScaleHeight = UserControl.ScaleHeight
End Property

Public Property Let ScaleHeight(ByVal New_ScaleHeight As Single)
    UserControl.ScaleHeight() = New_ScaleHeight
    PropertyChanged "ScaleHeight"
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=UserControl,UserControl,-1,ScaleLeft
Public Property Get ScaleLeft() As Single
Attribute ScaleLeft.VB_Description = "返回/设置对象左边界的水平坐标。"
    ScaleLeft = UserControl.ScaleLeft
End Property

Public Property Let ScaleLeft(ByVal New_ScaleLeft As Single)
    UserControl.ScaleLeft() = New_ScaleLeft
    PropertyChanged "ScaleLeft"
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=UserControl,UserControl,-1,ScaleMode
Public Property Get ScaleMode() As Integer
Attribute ScaleMode.VB_Description = "返回/设置一个值，指示当使用 graphics 方法或可定位的控件时，对象坐标的度量单位。"
    ScaleMode = UserControl.ScaleMode
End Property

Public Property Let ScaleMode(ByVal New_ScaleMode As Integer)
    UserControl.ScaleMode() = New_ScaleMode
    PropertyChanged "ScaleMode"
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=UserControl,UserControl,-1,ScaleTop
Public Property Get ScaleTop() As Single
Attribute ScaleTop.VB_Description = "返回/设置对象上边界的垂直坐标。"
    ScaleTop = UserControl.ScaleTop
End Property

Public Property Let ScaleTop(ByVal New_ScaleTop As Single)
    UserControl.ScaleTop() = New_ScaleTop
    PropertyChanged "ScaleTop"
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=UserControl,UserControl,-1,ScaleWidth
Public Property Get ScaleWidth() As Single
Attribute ScaleWidth.VB_Description = "返回/设置对象内部的水平度量单位数。"
    ScaleWidth = UserControl.ScaleWidth
End Property

Public Property Let ScaleWidth(ByVal New_ScaleWidth As Single)
    UserControl.ScaleWidth() = New_ScaleWidth
    PropertyChanged "ScaleWidth"
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=UserControl,UserControl,-1,ScaleX
Public Function ScaleX(ByVal Width As Single, Optional ByVal FromScale As Variant, Optional ByVal ToScale As Variant) As Single
Attribute ScaleX.VB_Description = "转换不同度量单位的窗体、图片框或打印机的宽度值。"
    ScaleX = UserControl.ScaleX(Width, FromScale, ToScale)
End Function

'注意！不要删除或修改下列被注释的行！
'MappingInfo=UserControl,UserControl,-1,ScaleY
Public Function ScaleY(ByVal Height As Single, Optional ByVal FromScale As Variant, Optional ByVal ToScale As Variant) As Single
Attribute ScaleY.VB_Description = "转换不同度量单位的窗体、图片框或打印机的高度值。"
    ScaleY = UserControl.ScaleY(Height, FromScale, ToScale)
End Function

Private Sub UserControl_Show()
    RaiseEvent Show

End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    RaiseEvent WriteProperties(PropBag)
    Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
    Call PropBag.WriteProperty("ForeColor", UserControl.ForeColor, &H80000012)
    Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
    Call PropBag.WriteProperty("Font", UserControl.Font, Ambient.Font)
    Call PropBag.WriteProperty("BackStyle", UserControl.BackStyle, 1)
    Call PropBag.WriteProperty("AutoRedraw", UserControl.AutoRedraw, False)
    Call PropBag.WriteProperty("CurrentX", UserControl.CurrentX, 0)
    Call PropBag.WriteProperty("CurrentY", UserControl.CurrentY, 0)
    Call PropBag.WriteProperty("DrawMode", UserControl.DrawMode, 13)
    Call PropBag.WriteProperty("FillColor", UserControl.FillColor, &H0&)
    Call PropBag.WriteProperty("FillStyle", UserControl.FillStyle, 1)
    Call PropBag.WriteProperty("FontSize", UserControl.FontSize, 0)
    Call PropBag.WriteProperty("MouseIcon", MouseIcon, Nothing)
    Call PropBag.WriteProperty("MousePointer", UserControl.MousePointer, 0)
    Call PropBag.WriteProperty("OLEDropMode", UserControl.OLEDropMode, 0)
    Call PropBag.WriteProperty("ScaleHeight", UserControl.ScaleHeight, 3600)
    Call PropBag.WriteProperty("ScaleLeft", UserControl.ScaleLeft, 0)
    Call PropBag.WriteProperty("ScaleMode", UserControl.ScaleMode, 1)
    Call PropBag.WriteProperty("ScaleTop", UserControl.ScaleTop, 0)
    Call PropBag.WriteProperty("ScaleWidth", UserControl.ScaleWidth, 4800)
    Call PropBag.WriteProperty("cellstate", m_cellstate, m_def_cellstate)
    Call PropBag.WriteProperty("cellindex", m_cellindex, m_def_cellindex)
    Call PropBag.WriteProperty("celltype", m_celltype, m_def_celltype)
    Call PropBag.WriteProperty("cellarc", m_cellarc, m_def_cellarc)
    Call PropBag.WriteProperty("cellvalue", m_cellvalue, m_def_cellvalue)
    Call PropBag.WriteProperty("cellinbranch", m_cellinbranch, m_def_cellinbranch)
    Call PropBag.WriteProperty("celln1", m_celln1, m_def_celln1)
    Call PropBag.WriteProperty("celln2", m_celln2, m_def_celln2)
    Call PropBag.WriteProperty("cellinhole1", m_cellinhole1, m_def_cellinhole1)
    Call PropBag.WriteProperty("cellinhole2", m_cellinhole2, m_def_cellinhole2)
    Call PropBag.WriteProperty("celltag", m_celltag, m_def_celltag)
    Call PropBag.WriteProperty("n1volt", m_n1volt, m_def_n1volt)
    Call PropBag.WriteProperty("n2volt", m_n2volt, m_def_n2volt)
    Call PropBag.WriteProperty("cellcurrent", m_cellcurrent, m_def_cellcurrent)
    Call PropBag.WriteProperty("mytag", m_mytag, m_def_mytag)
    Call PropBag.WriteProperty("n1x", m_n1x, m_def_n1x)
    Call PropBag.WriteProperty("n1y", m_n1y, m_def_n1y)
    Call PropBag.WriteProperty("n2x", m_n2x, m_def_n2x)
    Call PropBag.WriteProperty("n2y", m_n2y, m_def_n2y)
    Call PropBag.WriteProperty("isnew", m_isnew, m_def_isnew)
    Call PropBag.WriteProperty("main1", m_main1, m_def_main1)
    Call PropBag.WriteProperty("main2", m_main2, m_def_main2)
    Call PropBag.WriteProperty("n1tag", m_n1tag, m_def_n1tag)
    Call PropBag.WriteProperty("n2tag", m_n2tag, m_def_n2tag)
End Sub

'注意！不要删除或修改下列被注释的行！
'MappingInfo=UserControl,UserControl,-1,TextHeight
Public Function TextHeight(ByVal Str As String) As Single
Attribute TextHeight.VB_Description = "返回文本串的高度作为当前打印字体的高度。"
    TextHeight = UserControl.TextHeight(Str)
End Function

'注意！不要删除或修改下列被注释的行！
'MappingInfo=UserControl,UserControl,-1,TextWidth
Public Function TextWidth(ByVal Str As String) As Single
Attribute TextWidth.VB_Description = "返回文本串的宽度作为当前打印字体的宽度。"
    TextWidth = UserControl.TextWidth(Str)
End Function

'注意！不要删除或修改下列被注释的行！
'MemberInfo=7,0,0,-1
Public Property Get cellstate() As Integer
    cellstate = m_cellstate
End Property

Public Property Let cellstate(ByVal New_cellstate As Integer)
    m_cellstate = New_cellstate
    PropertyChanged "cellstate"
End Property

'注意！不要删除或修改下列被注释的行！
'MemberInfo=7,0,0,0
Public Property Get cellindex() As Integer
    cellindex = m_cellindex
End Property

Public Property Let cellindex(ByVal New_cellindex As Integer)
    m_cellindex = New_cellindex
    PropertyChanged "cellindex"
End Property

'注意！不要删除或修改下列被注释的行！
'MemberInfo=7,0,0,0
Public Property Get celltype() As Integer
    celltype = m_celltype
End Property

Public Property Let celltype(ByVal New_celltype As Integer)
    m_celltype = New_celltype
    PropertyChanged "celltype"
End Property

'注意！不要删除或修改下列被注释的行！
'MemberInfo=7
Public Function caution(lorr As Integer) As Integer

End Function

'为用户控件初始化属性
Private Sub UserControl_InitProperties()
    Set UserControl.Font = Ambient.Font
    m_cellstate = m_def_cellstate
    m_cellindex = m_def_cellindex
    m_celltype = m_def_celltype
    m_cellarc = m_def_cellarc
    m_cellvalue = m_def_cellvalue
    m_cellinbranch = m_def_cellinbranch
    m_celln1 = m_def_celln1
    m_celln2 = m_def_celln2
    m_cellinhole1 = m_def_cellinhole1
    m_cellinhole2 = m_def_cellinhole2
    m_celltag = m_def_celltag
    m_n1volt = m_def_n1volt
    m_n2volt = m_def_n2volt
    m_cellcurrent = m_def_cellcurrent

    m_mytag = m_def_mytag
    m_n1x = m_def_n1x
    m_n1y = m_def_n1y
    m_n2x = m_def_n2x
    m_n2y = m_def_n2y
    m_isnew = m_def_isnew
    m_main1 = m_def_main1
    m_main2 = m_def_main2
Call drawface
    m_n1tag = m_def_n1tag
    m_n2tag = m_def_n2tag
End Sub

'从存贮器中加载属性值
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

    UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
    UserControl.ForeColor = PropBag.ReadProperty("ForeColor", &H80000012)
    UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
    Set UserControl.Font = PropBag.ReadProperty("Font", Ambient.Font)
    UserControl.BackStyle = PropBag.ReadProperty("BackStyle", 1)
    UserControl.AutoRedraw = PropBag.ReadProperty("AutoRedraw", False)
 
    UserControl.DrawMode = PropBag.ReadProperty("DrawMode", 13)
    UserControl.FillColor = PropBag.ReadProperty("FillColor", &H0&)
    UserControl.FillStyle = PropBag.ReadProperty("FillStyle", 1)
    UserControl.FontSize = PropBag.ReadProperty("FontSize", 1)
    Set MouseIcon = PropBag.ReadProperty("MouseIcon", Nothing)
    UserControl.MousePointer = PropBag.ReadProperty("MousePointer", 0)
    UserControl.OLEDropMode = PropBag.ReadProperty("OLEDropMode", 0)
    UserControl.ScaleHeight = PropBag.ReadProperty("ScaleHeight", 3600)
    UserControl.ScaleLeft = PropBag.ReadProperty("ScaleLeft", 0)
    UserControl.ScaleMode = PropBag.ReadProperty("ScaleMode", 1)
    UserControl.ScaleTop = PropBag.ReadProperty("ScaleTop", 0)
    UserControl.ScaleWidth = PropBag.ReadProperty("ScaleWidth", 4800)
    m_cellstate = PropBag.ReadProperty("cellstate", m_def_cellstate)
    m_cellindex = PropBag.ReadProperty("cellindex", m_def_cellindex)
    m_celltype = PropBag.ReadProperty("celltype", m_def_celltype)
    m_cellarc = PropBag.ReadProperty("cellarc", m_def_cellarc)
    m_cellvalue = PropBag.ReadProperty("cellvalue", m_def_cellvalue)
    m_cellinbranch = PropBag.ReadProperty("cellinbranch", m_def_cellinbranch)
    m_celln1 = PropBag.ReadProperty("celln1", m_def_celln1)
    m_celln2 = PropBag.ReadProperty("celln2", m_def_celln2)
    m_cellinhole1 = PropBag.ReadProperty("cellinhole1", m_def_cellinhole1)
    m_cellinhole2 = PropBag.ReadProperty("cellinhole2", m_def_cellinhole2)
    m_celltag = PropBag.ReadProperty("celltag", m_def_celltag)
    m_n1volt = PropBag.ReadProperty("n1volt", m_def_n1volt)
    m_n2volt = PropBag.ReadProperty("n2volt", m_def_n2volt)
    m_cellcurrent = PropBag.ReadProperty("cellcurrent", m_def_cellcurrent)
    m_mytag = PropBag.ReadProperty("mytag", m_def_mytag)
    m_n1x = PropBag.ReadProperty("n1x", m_def_n1x)
    m_n1y = PropBag.ReadProperty("n1y", m_def_n1y)
    m_n2x = PropBag.ReadProperty("n2x", m_def_n2x)
    m_n2y = PropBag.ReadProperty("n2y", m_def_n2y)
    m_isnew = PropBag.ReadProperty("isnew", m_def_isnew)
    m_main1 = PropBag.ReadProperty("main1", m_def_main1)
    m_main2 = PropBag.ReadProperty("main2", m_def_main2)
    m_n1tag = PropBag.ReadProperty("n1tag", m_def_n1tag)
    m_n2tag = PropBag.ReadProperty("n2tag", m_def_n2tag)
End Sub

'注意！不要删除或修改下列被注释的行！
'MemberInfo=7,0,0,0
Public Property Get cellarc() As Integer
    cellarc = m_cellarc
End Property

Public Property Let cellarc(ByVal New_cellarc As Integer)
    m_cellarc = New_cellarc
    PropertyChanged "cellarc"
End Property

Private Sub cng_wh()
If cellarc = 0 Then
  UserControl.Height = 600
  UserControl.Width = 800
Else
  UserControl.Height = 800
  UserControl.Width = 600
End If
Call drawface
End Sub
Private Sub drawface()
  
If cellarc = 0 Then
  UserControl.Height = 600
  UserControl.Width = 800
   UserControl.ScaleHeight = 600
  UserControl.ScaleWidth = 800
    
    n1x = 0
    n1y = 300
    n2x = 800
   n2y = 300
    
    Select Case celltype
     Case 0
      UserControl.Line (200, 200)-(600, 400), , B
      UserControl.Line (0, 300)-(200, 300)
      UserControl.Line (600, 300)-(800, 300)
      UserControl.CurrentX = 300
      UserControl.CurrentY = 0
      UserControl.Print ("R" + CStr(cellindex))
      UserControl.CurrentX = 250
      UserControl.CurrentY = 400
      UserControl.Print (CStr(cellvalue) + "Ω")
    Case 1
      UserControl.Line (350, 200)-(350, 400)
      UserControl.Line (450, 200)-(450, 400)
      UserControl.Line (0, 300)-(350, 300)
      UserControl.Line (450, 300)-(800, 300)
      UserControl.CurrentX = 300
      UserControl.CurrentY = 0
      UserControl.Print ("C" + CStr(cellindex))
      UserControl.CurrentX = 250
      UserControl.CurrentY = 400
      UserControl.Print (CStr(cellvalue) + "F")
    Case 2
      UserControl.Line (200, 300)-(266, 200)
      UserControl.Line (266, 200)-(333, 400)
      UserControl.Line (333, 400)-(400, 200)
      UserControl.Line (400, 200)-(466, 400)
      UserControl.Line (466, 400)-(533, 200)
      UserControl.Line (533, 200)-(600, 300)
      UserControl.Line (0, 300)-(200, 300)
      UserControl.Line (600, 300)-(800, 300)
      UserControl.CurrentX = 300
      UserControl.CurrentY = 0
      UserControl.Print ("L" + CStr(cellindex))
      UserControl.CurrentX = 250
      UserControl.CurrentY = 400
      UserControl.Print (CStr(cellvalue) + "H")
    Case 3
      UserControl.Circle (400, 300), 100
      UserControl.Line (0, 300)-(800, 300)
      UserControl.CurrentX = 0
      UserControl.CurrentY = 0
      UserControl.Print ("+     U" + CStr(cellindex))
      UserControl.CurrentX = 250
      UserControl.CurrentY = 400
      If celltag = 0 Then
      UserControl.Print (CStr(cellvalue) + "V")
      ElseIf celltag = 1 Then
      UserControl.Print (CStr(sourcemat(cellvalue).a) + "V")
      End If
   Case 4
       
      UserControl.Circle (400, 300), 100
      UserControl.Line (400, 200)-(400, 400)
      UserControl.Line (0, 300)-(300, 300)
      UserControl.Line (500, 300)-(800, 300)
      UserControl.CurrentX = 0
      UserControl.CurrentY = 0
      UserControl.Print ("+     I" + CStr(cellindex))
      UserControl.CurrentX = 250
      UserControl.CurrentY = 400
      If celltag = 0 Then
      UserControl.Print (CStr(cellvalue) + "A")
      ElseIf celltag = 1 Then
      UserControl.Print (CStr(sourcemat(cellvalue).a) + "A")
      End If
    Case 5
      UserControl.Line (0, 300)-(200, 300)
      UserControl.Line (600, 300)-(800, 300)
      UserControl.Line (200, 300)-(400, 200)
      UserControl.Line (400, 200)-(600, 300)
      UserControl.Line (600, 300)-(400, 400)
      UserControl.Line (400, 400)-(200, 300)
    Select Case celltag
     Case 1
      UserControl.Line (200, 300)-(600, 300)