home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / djport / ezport.ctl next >
Encoding:
Text File  |  1999-01-04  |  11.2 KB  |  387 lines
  1. VERSION 5.00
  2. Begin VB.UserControl EZPort 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H80000005&
  5.    BackStyle       =   0  'Transparent
  6.    ClientHeight    =   855
  7.    ClientLeft      =   0
  8.    ClientTop       =   0
  9.    ClientWidth     =   735
  10.    ClipControls    =   0   'False
  11.    ScaleHeight     =   855
  12.    ScaleWidth      =   735
  13.    ToolboxBitmap   =   "ezport.ctx":0000
  14.    Begin VB.PictureBox picDot 
  15.       Appearance      =   0  'Flat
  16.       BackColor       =   &H00C0FFC0&
  17.       BorderStyle     =   0  'None
  18.       DrawStyle       =   5  'Transparent
  19.       FillColor       =   &H00FFFFFF&
  20.       FillStyle       =   0  'Solid
  21.       ForeColor       =   &H00000000&
  22.       Height          =   108
  23.       Index           =   1
  24.       Left            =   165
  25.       ScaleHeight     =   105
  26.       ScaleWidth      =   135
  27.       TabIndex        =   1
  28.       TabStop         =   0   'False
  29.       Top             =   525
  30.       Width           =   132
  31.    End
  32.    Begin VB.Image imgPorts 
  33.       Appearance      =   0  'Flat
  34.       Height          =   300
  35.       Index           =   1
  36.       Left            =   75
  37.       Picture         =   "ezport.ctx":0312
  38.       Top             =   450
  39.       Width           =   315
  40.    End
  41.    Begin VB.Label lblPort 
  42.       Alignment       =   2  'Center
  43.       Appearance      =   0  'Flat
  44.       AutoSize        =   -1  'True
  45.       BackColor       =   &H80000005&
  46.       Caption         =   "lbl"
  47.       ForeColor       =   &H80000008&
  48.       Height          =   195
  49.       Index           =   1
  50.       Left            =   105
  51.       TabIndex        =   0
  52.       Top             =   105
  53.       Width           =   165
  54.    End
  55. End
  56. Attribute VB_Name = "EZPort"
  57. Attribute VB_GlobalNameSpace = False
  58. Attribute VB_Creatable = True
  59. Attribute VB_PredeclaredId = False
  60. Attribute VB_Exposed = True
  61. Option Explicit
  62. Option Base 1
  63.  
  64. Public Enum PortStates
  65.   stActive = 1
  66.   stInactive = 2
  67.   stOff = 3
  68. End Enum
  69. Dim m_ActiveColor As OLE_COLOR
  70. Dim m_InactiveColor As OLE_COLOR
  71. Dim m_OffColor As OLE_COLOR
  72. Dim mblnEnabled As Boolean
  73. Dim mintPorts As Integer
  74.  
  75. Const mdefActive As Long = &HFF00&
  76. Const mdefInactive As Long = &HC0FFC0
  77. Const mdefOff As Long = &H0&
  78. Public Event Click(Left As Long, top As Long, Port As Integer)
  79. Attribute Click.VB_Description = "Event raised when port is clicked. Left center, Top center, and Port number are returned"
  80. Public Event DblClick(Port As Integer, State As PortStates)
  81. Attribute DblClick.VB_Description = "Event raised when port is double clicked. Port number and current state of port are returned."
  82.  
  83. Private Sub UserControl_InitProperties()
  84.   mintPorts = 4
  85.   lblPort(1).BackColor = Ambient.BackColor
  86.   With Me
  87.     .ActiveColor = mdefActive
  88.     .InactiveColor = mdefInactive
  89.     .OffColor = mdefOff
  90.     .Ports = mintPorts
  91.     Set .Font = Ambient.Font
  92.     .Border = False
  93.   End With
  94.   Call StandardPortLabels
  95.   mblnEnabled = True
  96.   With imgPorts(mintPorts)
  97.     UserControl.Width = .Left + .Width
  98.   End With
  99. End Sub
  100.  
  101. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  102.   Dim intX As Integer
  103.   Call PropBag.WriteProperty("Font", Font, Ambient.Font)
  104.   Call PropBag.WriteProperty("Ports", mintPorts, 4)
  105.   Call PropBag.WriteProperty("ActiveColor", m_ActiveColor, mdefActive)
  106.   Call PropBag.WriteProperty("InactiveColor", m_InactiveColor, mdefInactive)
  107.   Call PropBag.WriteProperty("OffColor", m_OffColor, mdefOff)
  108.   Call PropBag.WriteProperty("Enabled", mblnEnabled, True)
  109.   Call PropBag.WriteProperty("Border", Me.Border, False)
  110.   For intX = 1 To mintPorts
  111.     Call PropBag.WriteProperty("PortCaption", _
  112.     lblPort(intX).Caption, Trim(Str(intX)) & "x")
  113.   Next
  114. End Sub
  115.  
  116. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  117.   Dim intX As Integer
  118.   With Me
  119.     .ActiveColor = PropBag.ReadProperty("ActiveColor", mdefActive)
  120.     .InactiveColor = PropBag.ReadProperty("InactiveColor", mdefInactive)
  121.     .OffColor = PropBag.ReadProperty("OffColor", mdefOff)
  122.     .Ports = PropBag.ReadProperty("Ports", 4)
  123.     .Enabled = PropBag.ReadProperty("Enabled", True)
  124.     .Border = PropBag.ReadProperty("Border", False)
  125.     For intX = 1 To mintPorts
  126.       .PortCaption(intX) = PropBag.ReadProperty("PortCaption", Trim(Str(intX)) & "x")
  127.     Next
  128.  End With
  129.  Set Font = PropBag.ReadProperty("Font", Ambient.Font)
  130.  lblPort(1).BackColor = Ambient.BackColor
  131. End Sub
  132. Private Sub UserControl_Resize()
  133.   Dim intX As Integer
  134.   Dim lngLeft As Long
  135.   
  136.   For intX = 1 To imgPorts.Count
  137.     With imgPorts(intX)
  138.       lngLeft = (intX - 1) * .Width
  139.       .Move lngLeft, lblPort(1).Height
  140.       picDot(intX).Move lngLeft + 90, .top + 60
  141.       lblPort(intX).Move lngLeft, 0
  142.     End With
  143.     Call ShowControl(imgPorts(intX), True)
  144.     Call ShowControl(picDot(intX), True)
  145.     Call ShowControl(lblPort(intX), True)
  146.   Next
  147.   With UserControl
  148.     .Height = lblPort(1).Height + imgPorts(1).Height
  149.     .Width = lngLeft + imgPorts(1).Width
  150.   End With
  151.   
  152. End Sub
  153.  
  154. Public Property Let Border(ByVal New_Border As Boolean)
  155. Attribute Border.VB_Description = "Sets/returns border status of control"
  156.   With UserControl
  157.     If New_Border = False Then
  158.       .BorderStyle = 0
  159.     Else
  160.       .BorderStyle = 1
  161.     End If
  162.   End With
  163.   PropertyChanged "Border"
  164. End Property
  165.  
  166. Public Property Get Border() As Boolean
  167.   With UserControl
  168.     If .BorderStyle = 0 Then
  169.       Border = False
  170.     Else
  171.       Border = True
  172.     End If
  173.   End With
  174. End Property
  175.  
  176. Public Property Get Font() As Font
  177. Attribute Font.VB_Description = "Set/return font of port lables"
  178.   Set Font = lblPort(1).Font
  179. End Property
  180.  
  181. Public Property Set Font(ByVal NewFont As Font)
  182.   Dim intX As Integer
  183.   For intX = 1 To mintPorts
  184.     Set lblPort(intX).Font = NewFont
  185.   Next
  186.   Call UserControl_Resize
  187.   PropertyChanged "Font"
  188. End Property
  189.  
  190. Public Property Get ActiveColor() As OLE_COLOR
  191. Attribute ActiveColor.VB_Description = "Sets/returns active color of ports in control"
  192.   ActiveColor = m_ActiveColor
  193. End Property
  194.  
  195. Public Property Let ActiveColor(ByVal New_ActiveColor As OLE_COLOR)
  196.   m_ActiveColor = New_ActiveColor
  197.   PropertyChanged "ActiveColor"
  198. End Property
  199.  
  200. Public Property Get InactiveColor() As OLE_COLOR
  201. Attribute InactiveColor.VB_Description = "Sets/returns inactive color of ports in control"
  202.   InactiveColor = m_InactiveColor
  203. End Property
  204.  
  205. Public Property Let InactiveColor(ByVal New_InactiveColor As OLE_COLOR)
  206.   m_InactiveColor = New_InactiveColor
  207.   PropertyChanged "InactiveColor"
  208. End Property
  209.  
  210. Public Property Get OffColor() As OLE_COLOR
  211. Attribute OffColor.VB_Description = "Sets/returns off color of ports in control"
  212.   OffColor = m_OffColor
  213. End Property
  214.  
  215. Public Property Let OffColor(ByVal New_OffColor As OLE_COLOR)
  216.   m_OffColor = New_OffColor
  217.   PropertyChanged "OffColor"
  218. End Property
  219.  
  220. Public Property Let Enabled(ByVal New_Bln As Boolean)
  221. Attribute Enabled.VB_Description = "Enable/Disable control"
  222.   mblnEnabled = New_Bln
  223.   UserControl.Enabled = New_Bln
  224. End Property
  225.  
  226. Public Property Get Enabled() As Boolean
  227.   Enabled = mblnEnabled
  228. End Property
  229.  
  230. Public Property Get PortCaption(Port As Integer) As String
  231. Attribute PortCaption.VB_Description = "Sets/returns port label"
  232.   PortCaption = lblPort(Port)
  233. End Property
  234.  
  235. Public Property Let PortCaption(Port As Integer, _
  236. ByVal NewCaption As String)
  237.   lblPort(Port) = NewCaption
  238.   PropertyChanged "PortCaption"
  239. End Property
  240.  
  241. Private Sub PortColor(pic As PictureBox, Color As OLE_COLOR)
  242.   pic.BackColor = Color
  243. End Sub
  244. Public Sub SetAllPorts(State As PortStates)
  245. Attribute SetAllPorts.VB_Description = "Sets all ports in control to specified state."
  246.   Dim intX As Integer
  247.   Dim Color As OLE_COLOR
  248.   
  249.   Color = SetColor(State)
  250.   For intX = 1 To picDot.Count
  251.     Call PortColor(picDot(intX), Color)
  252.   Next
  253. End Sub
  254.  
  255. Private Function SetColor(State As PortStates) As OLE_COLOR
  256.   Select Case State
  257.     Case 1
  258.       SetColor = m_ActiveColor
  259.     Case 2
  260.       SetColor = m_InactiveColor
  261.     Case 3
  262.       SetColor = m_OffColor
  263.   End Select
  264. End Function
  265.  
  266. Public Property Get Ports() As Long
  267. Attribute Ports.VB_Description = "Sets/Returns number of ports in control."
  268.   Ports = mintPorts
  269. End Property
  270.  
  271. Public Property Let Ports(ByVal New_Ports As Long)
  272.   Dim intX As Integer
  273.   Dim intCnt As Integer
  274.   intCnt = picDot.Count - 1
  275.   
  276.   If New_Ports < 1 Then New_Ports = 1
  277.   If New_Ports > 24 Then New_Ports = 24
  278.   New_Ports = New_Ports - 1
  279.   If intCnt = New_Ports Then Exit Property
  280.   
  281.   intX = New_Ports - intCnt
  282.   If intX < 0 Then
  283.     Call RemovePorts(Abs(intX))
  284.   Else
  285.     Call AddPorts(intX)
  286.   End If
  287.   
  288.   mintPorts = picDot.Count
  289.   Call SetAllPorts(stActive)
  290.   Call UserControl_Resize
  291.   PropertyChanged "Ports"
  292. End Property
  293. Private Sub AddPorts(intX As Integer)
  294.   Dim intY As Integer
  295.   Dim intCnt As Integer
  296.   
  297.   intCnt = picDot.Count
  298.   For intY = intCnt + 1 To (intX + intCnt)
  299.     Load imgPorts(intY)
  300.     Load picDot(intY)
  301.     Load lblPort(intY)
  302.     With lblPort(intY)
  303.       .BackColor = Ambient.BackColor
  304.       .Caption = Trim(Str(intY)) & "x"
  305.     End With
  306.   Next
  307.   Call UserControl_Resize
  308. End Sub
  309. Private Sub RemovePorts(intX As Integer)
  310.   Dim intCnt As Integer
  311.   Dim intC As Integer
  312.   intC = picDot.Count
  313.   Do While picDot.Count > (intC - intX)
  314.     intCnt = picDot.Count
  315.     Unload imgPorts(intCnt)
  316.     Unload picDot(intCnt)
  317.     Unload lblPort(intCnt)
  318.   Loop
  319.   Call UserControl_Resize
  320. End Sub
  321. Public Property Get PortState(ByVal Port As Integer) _
  322. As PortStates
  323. Attribute PortState.VB_Description = "Sets/Returns state of port specified. Active, inactive or off"
  324.   Select Case picDot(Port).BackColor
  325.     Case m_ActiveColor
  326.       PortState = stActive
  327.     Case m_InactiveColor
  328.       PortState = stInactive
  329.     Case m_OffColor
  330.       PortState = stOff
  331.   End Select
  332. End Property
  333.  
  334. Public Property Let PortState(ByVal Port As Integer, _
  335. State As PortStates)
  336.   If State < stActive Then State = stActive
  337.   If State > stOff Then State = stOff
  338.     
  339.   Call PortColor(picDot(Port), SetColor(State))
  340.   PropertyChanged "PortState"
  341. End Property
  342.  
  343. Private Sub ShowControl(ctl As Control, Show As Boolean)
  344.   With ctl
  345.     If Show Then
  346.       If Not .Visible Then .Visible = True
  347.     Else
  348.       If .Visible Then .Visible = False
  349.     End If
  350.   End With
  351. End Sub
  352.  
  353. Private Sub picDot_Click(Index As Integer)
  354.   Dim lngLeft As Long
  355.   Dim lngTop As Long
  356.   With picDot(Index)
  357.     lngLeft = .Left + (.Width / 2)
  358.     lngTop = .top + (.Height / 2)
  359.     RaiseEvent Click(lngLeft, lngTop, Index)
  360.   End With
  361. End Sub
  362.  
  363. Private Sub picDot_DblClick(Index As Integer)
  364.   RaiseEvent DblClick(Index, PortState(Index))
  365. End Sub
  366.  
  367. Public Sub LocatePort(ByVal Port As Integer, Left As Long, top As Long)
  368. Attribute LocatePort.VB_Description = "Returns left center and top center positon of port specified"
  369.   With picDot(Port)
  370.     Left = .Left + (.Width / 2)
  371.     top = .top + (.Height / 2)
  372.   End With
  373. End Sub
  374.  
  375. Public Sub StandardPortLabels()
  376. Attribute StandardPortLabels.VB_Description = "Sets all port labels to conventional standard (1x 2x 3x ...)"
  377.   Dim intX As Integer
  378.   For intX = 1 To mintPorts
  379.     lblPort(intX) = Trim(Str(intX)) & "x"
  380.   Next
  381. End Sub
  382.  
  383. Public Function GetPortColor(Port As Integer) As OLE_COLOR
  384. Attribute GetPortColor.VB_Description = "Returns color of port specified"
  385.   GetPortColor = picDot(Port).BackColor
  386. End Function
  387.