home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD48704162000.psc / ctlProgress.ctl (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2000-04-14  |  7.0 KB  |  212 lines
  1. VERSION 5.00
  2. Begin VB.UserControl ctlProgress 
  3.    ClientHeight    =   300
  4.    ClientLeft      =   0
  5.    ClientTop       =   0
  6.    ClientWidth     =   4800
  7.    HasDC           =   0   'False
  8.    ScaleHeight     =   300
  9.    ScaleWidth      =   4800
  10.    Begin VB.PictureBox picProgress 
  11.       AutoRedraw      =   -1  'True
  12.       ClipControls    =   0   'False
  13.       FillStyle       =   0  'Solid
  14.       Height          =   255
  15.       Left            =   0
  16.       ScaleHeight     =   195
  17.       ScaleWidth      =   4695
  18.       TabIndex        =   0
  19.       Top             =   0
  20.       Width           =   4755
  21.    End
  22. Attribute VB_Name = "ctlProgress"
  23. Attribute VB_GlobalNameSpace = False
  24. Attribute VB_Creatable = True
  25. Attribute VB_PredeclaredId = False
  26. Attribute VB_Exposed = False
  27. Option Explicit
  28. Dim lMaxValue As Long
  29. Dim lMinValue As Long
  30. Dim lValue As Long
  31. Dim sCaption As String
  32. Dim nCaptionStyle As Integer
  33. Dim oFillColor As OLE_COLOR
  34. Public Enum eBorderStyle
  35.     eBor_None = 0
  36.     eBor_FixedSingle
  37. End Enum
  38. Public Enum eCaptionStyle
  39.     eCap_None = 0
  40.     eCap_CaptionOnly
  41.     eCap_PercentOnly
  42.     eCap_CaptionPercent
  43. End Enum
  44. Public Enum eAppearance
  45.     eApp_Flat = 0
  46.     eApp_3D
  47. End Enum
  48. Public Property Let Appearance(nValue As eAppearance)
  49.     picProgress.Appearance = nValue
  50.     PropertyChanged
  51. End Property
  52. Public Property Get Appearance() As eAppearance
  53.     Appearance = picProgress.Appearance
  54. End Property
  55. Public Property Let Caption(nValue As String)
  56.     sCaption = Trim(nValue)
  57.     PropertyChanged
  58. End Property
  59. Public Property Get Caption() As String
  60.     Caption = sCaption
  61. End Property
  62. Public Property Let Max(nValue As Long)
  63.     lMaxValue = nValue
  64.     PropertyChanged
  65. End Property
  66. Public Property Get Max() As Long
  67.     Max = lMaxValue
  68. End Property
  69. Public Property Let Min(nValue As Long)
  70.     lMinValue = nValue
  71.     PropertyChanged
  72. End Property
  73. Public Property Get Min() As Long
  74.     Min = lMinValue
  75. End Property
  76. Public Property Let Enabled(nValue As Boolean)
  77.     picProgress.Enabled = nValue
  78.     PropertyChanged
  79. End Property
  80. Public Property Get Enabled() As Boolean
  81.     Enabled = picProgress.Enabled
  82. End Property
  83. Public Property Let BorderStyle(nValue As eBorderStyle)
  84.     picProgress.BorderStyle = nValue
  85.     PropertyChanged
  86. End Property
  87. Public Property Get BorderStyle() As eBorderStyle
  88.     BorderStyle = picProgress.BorderStyle
  89. End Property
  90. Public Property Let CaptionStyle(nValue As eCaptionStyle)
  91.     nCaptionStyle = nValue
  92.     PropertyChanged
  93. End Property
  94. Public Property Get CaptionStyle() As eCaptionStyle
  95.     CaptionStyle = nCaptionStyle
  96. End Property
  97. Public Property Get CaptionFont() As Font
  98.     Set CaptionFont = UserControl.Font
  99. End Property
  100. Public Property Set CaptionFont(ByVal NewFont As Font)
  101.     Set UserControl.Font = NewFont
  102.     SyncLabelFonts
  103.     PropertyChanged
  104. End Property
  105. Private Sub SyncLabelFonts()
  106. Dim objCtl As Object
  107.     For Each objCtl In Controls
  108.         Set objCtl.Font = UserControl.Font
  109.     Next
  110. End Sub
  111. Public Property Let FillColor(nValue As OLE_COLOR)
  112.     oFillColor = nValue
  113.     PropertyChanged
  114. End Property
  115. Public Property Get FillColor() As OLE_COLOR
  116.     FillColor = oFillColor
  117. End Property
  118. Public Property Let ForeColor(nValue As OLE_COLOR)
  119.     picProgress.ForeColor = nValue
  120.     PropertyChanged
  121. End Property
  122. Public Property Get ForeColor() As OLE_COLOR
  123.     ForeColor = picProgress.ForeColor
  124. End Property
  125. Public Property Let BackColor(nValue As OLE_COLOR)
  126.     picProgress.BackColor = nValue
  127.     PropertyChanged
  128. End Property
  129. Public Property Get BackColor() As OLE_COLOR
  130.     BackColor = picProgress.BackColor
  131. End Property
  132. Public Property Let value(nValue As Long)
  133.     lValue = nValue
  134.     Call ChangeValue(nValue)
  135. End Property
  136. Public Property Get value() As Long
  137. Attribute value.VB_MemberFlags = "400"
  138.     value = lValue
  139. End Property
  140. Public Sub Refresh()
  141.     picProgress.Refresh
  142. End Sub
  143. Private Sub UserControl_InitProperties()
  144.     Max = 100
  145.     Min = 0
  146.     BackColor = UserControl.BackColor
  147.     FillColor = vbBlue
  148.     CaptionStyle = eCap_PercentOnly
  149.     SyncLabelFonts
  150. End Sub
  151. Private Sub UserControl_Resize()
  152.     picProgress.Width = UserControl.Width
  153.     picProgress.Height = UserControl.Height
  154. End Sub
  155. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  156.     On Error Resume Next
  157.     picProgress.Appearance = PropBag.ReadProperty("Appearance", picProgress.Appearance)
  158.     picProgress.ForeColor = PropBag.ReadProperty("ForeColor", picProgress.ForeColor)
  159.     picProgress.BackColor = PropBag.ReadProperty("BackColor", picProgress.BackColor)
  160.     oFillColor = PropBag.ReadProperty("FillColor", oFillColor)
  161.     BorderStyle = PropBag.ReadProperty("BorderStyle", 1)
  162.     CaptionStyle = PropBag.ReadProperty("CaptionStyle", 3)
  163.     Enabled = PropBag.ReadProperty("Enabled", True)
  164.     Caption = PropBag.ReadProperty("Caption", "")
  165.     Max = PropBag.ReadProperty("Max", 100)
  166.     Min = PropBag.ReadProperty("Min", 0)
  167.     Set CaptionFont = PropBag.ReadProperty("CaptionFont")
  168. End Sub
  169. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  170.     Call PropBag.WriteProperty("Appearance", picProgress.Appearance)
  171.     Call PropBag.WriteProperty("ForeColor", picProgress.ForeColor)
  172.     Call PropBag.WriteProperty("BackColor", picProgress.BackColor)
  173.     Call PropBag.WriteProperty("FillColor", oFillColor)
  174.     Call PropBag.WriteProperty("Font", Font, Ambient.Font)
  175.     Call PropBag.WriteProperty("BorderStyle", BorderStyle, 1)
  176.     Call PropBag.WriteProperty("CaptionStyle", CaptionStyle, 3)
  177.     Call PropBag.WriteProperty("Enabled", Enabled, True)
  178.     Call PropBag.WriteProperty("Caption", Caption)
  179.     Call PropBag.WriteProperty("Min", Min, 0)
  180.     Call PropBag.WriteProperty("CaptionFont", CaptionFont)
  181. End Sub
  182. Private Sub ChangeValue(nValue As Long)
  183. Dim NewCaption As String
  184.     If nValue > lMaxValue Then
  185.         nValue = lMaxValue
  186.     ElseIf nValue < lMinValue Then
  187.         nValue = lMinValue
  188.     End If
  189.     picProgress.Cls
  190.     If CaptionStyle <> eCap_None Then
  191.         If CaptionStyle <> eCap_CaptionOnly Then
  192.             If Caption = "" Or CaptionStyle = eCap_PercentOnly Then
  193.                 NewCaption = Format(Str((nValue - Min) / (Max - Min)) * 100, "0") + "%"
  194.             Else
  195.                 NewCaption = Caption & " " & Format(Str((nValue - Min) / (Max - Min)) * 100, "0") + "%"
  196.             End If
  197.         Else
  198.             NewCaption = Caption
  199.         End If
  200.     End If
  201.     picProgress.ScaleWidth = Max - Min
  202.     picProgress.DrawMode = 10
  203.     picProgress.CurrentX = (picProgress.ScaleWidth / 2 - picProgress.TextWidth(NewCaption) / 2)
  204.     picProgress.CurrentY = (picProgress.ScaleHeight - picProgress.TextHeight(NewCaption)) / 2
  205.     picProgress.Print NewCaption
  206.     picProgress.Line (0, 0)-((nValue - Min), picProgress.Width), FillColor, BF
  207. End Sub
  208. Public Sub About()
  209. Attribute About.VB_UserMemId = -552
  210.     Call MsgBox("Progress Bar v1.0" & vbCr & "Paul Mather" & vbCr & "November 30, 1999" & vbCr & "paulbmather@hotmail.com", vbOKOnly + vbInformation, "About")
  211. End Sub
  212.