home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / POS_Cell_Z2101552122008.psc / verna / cb.ctl next >
Text File  |  2007-03-07  |  41KB  |  1,138 lines
  1. VERSION 5.00
  2. Begin VB.UserControl PB 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H00464646&
  5.    ClientHeight    =   3600
  6.    ClientLeft      =   0
  7.    ClientTop       =   0
  8.    ClientWidth     =   4800
  9.    ScaleHeight     =   3600
  10.    ScaleWidth      =   4800
  11. End
  12. Attribute VB_Name = "PB"
  13. Attribute VB_GlobalNameSpace = False
  14. Attribute VB_Creatable = True
  15. Attribute VB_PredeclaredId = False
  16. Attribute VB_Exposed = False
  17. '-----------------------------------------------------------
  18. 'Mario Flores Cool Xp ProgressBar
  19. 'Emulating The Windows XP Progress Bar
  20. 'Open Source
  21. '6 May 2004
  22. '-----------------------------------------------------------
  23. 'Mario Flores Cool Xp ProgressBar 2.0
  24. 'MultiStyle ProgressBar
  25. 'Open Source
  26. 'September 12 2004
  27. '-----------------------------------------------------------
  28.  
  29. 'CD JUAREZ CHIHUAHUA MEXICO
  30.  
  31. Option Explicit
  32.  
  33. Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
  34. Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
  35. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
  36. Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Any) As Long
  37. Private Declare Function CreateHatchBrush Lib "gdi32" (ByVal fnStyle As Integer, ByVal COLORREF As Long) As Long
  38. Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long
  39. Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
  40. Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
  41. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  42. Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
  43. Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
  44. Private Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Long
  45. Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
  46. Private Declare Function FrameRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
  47. Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
  48. Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
  49. Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
  50. Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, lpPoint As POINTAPI) As Long
  51. Private Declare Function PatBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As Long
  52. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  53. Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
  54. Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
  55. Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
  56. Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
  57.  
  58.  
  59. '=====================================================
  60. 'TEXT FORMAT CONST
  61. Const DT_SINGLELINE   As Long = &H20
  62. Const DT_CALCRECT     As Long = &H400
  63. '=====================================================
  64.  
  65. '=====================================================
  66. 'BORDER FIELD CONST
  67. Const BF_BOTTOM = &H8
  68. Const BF_LEFT = &H1
  69. Const BF_RIGHT = &H4
  70. Const BF_TOP = &H2
  71. Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)
  72. '=====================================================
  73.  
  74. '=====================================================
  75. 'THE POINTAPI STRUCTURE
  76. Private Type POINTAPI
  77.     X As Long                       ' The POINTAPI structure defines the x- and y-coordinates of a point.
  78.     Y As Long
  79. End Type
  80. '=====================================================
  81.  
  82. '=====================================================
  83. 'THE RECT STRUCTURE
  84. Private Type RECT
  85.     Left      As Long     'The RECT structure defines the coordinates of the upper-left and lower-right corners of a rectangle
  86.     Top       As Long
  87.     Right     As Long
  88.     Bottom    As Long
  89. End Type
  90. '=====================================================
  91.  
  92. '=====================================================
  93. 'THE BRUSHSTYLE ENUM
  94. Public Enum BrushStyle
  95.  HS_HORIZONTAL = 0
  96.  HS_VERTICAL = 1
  97.  HS_FDIAGONAL = 2
  98.  HS_BDIAGONAL = 3
  99.  HS_CROSS = 4
  100.  HS_DIAGCROSS = 5
  101.  HS_SOLID = 6
  102. End Enum
  103. '=====================================================
  104.  
  105. '=====================================================
  106. 'THE COOL XP PROGRESSBAR 2.0 STYLES
  107. Public Enum cScrolling
  108.     ccScrollingStandard = 0
  109.     ccScrollingSmooth = 1
  110.     ccScrollingSearch = 2
  111.     ccScrollingOfficeXP = 3
  112.     ccScrollingPastel = 4
  113.     ccScrollingJavT = 5
  114.     ccScrollingMediaPlayer = 6
  115.     ccScrollingCustomBrush = 7
  116.     ccScrollingPicture = 8
  117.     ccScrollingMetallic = 9
  118. End Enum
  119. '=====================================================
  120.  
  121. '=====================================================
  122. 'THE ORIENTATION ENUM
  123. Public Enum cOrientation
  124.     ccOrientationHorizontal = 0
  125.     ccOrientationVertical = 1
  126. End Enum
  127. '=====================================================
  128.  
  129. '----------------------------------------------------
  130. Private m_Color       As OLE_COLOR
  131. Private m_hDC         As Long
  132. Private m_hWnd        As Long        'PROPERTIES VARIABLES
  133. Private m_Max         As Long
  134. Private m_Min         As Long
  135. Private m_Value       As Long
  136. Private m_ShowText    As Boolean
  137. Private m_Scrolling   As cScrolling
  138. Private m_Orientation As cOrientation
  139. Private m_Brush       As BrushStyle
  140. Private m_Picture     As StdPicture
  141. '----------------------------------------------------
  142.  
  143. '----------------------------------------------------
  144. Private m_MemDC    As Boolean
  145. Private m_ThDC     As Long
  146. Private m_hBmp     As Long
  147. Private m_hBmpOld  As Long
  148. Private iFnt       As IFont
  149. Private m_fnt      As IFont          'VARIABLES USED IN PROCESS
  150. Private hFntOld    As Long
  151. Private m_lWidth   As Long
  152. Private m_lHeight  As Long
  153. Private fPercent   As Double
  154. Private TR         As RECT
  155. Private TBR        As RECT
  156. Private TSR        As RECT
  157. Private AT         As RECT
  158. Private lSegmentWidth   As Long
  159. Private lSegmentSpacing As Long
  160. '----------------------------------------------------
  161.  
  162.  
  163.  
  164. '==========================================================
  165. '/---Draw ALL ProgressXP Bar  !!!!PUBLIC CALL!!!
  166. '==========================================================
  167.  
  168. Public Sub DrawProgressBar()
  169.  
  170.             
  171.             If m_Value > 100 Then m_Value = 100
  172.             
  173.             
  174.             GetClientRect m_hWnd, TR               '//--- Reference = Control Client Area
  175.               
  176.             DrawFillRectangle TR, IIf(m_Scrolling = ccScrollingMediaPlayer, &H464646, vbWhite), m_hDC      '//--- Draw BackGround
  177.             
  178.             '//-- Draw ProgressBar Style
  179.             
  180.             '==========================================================
  181.             '/---Draw METALLIC XP STYLE
  182.             '==========================================================
  183.  
  184.             If m_Scrolling = ccScrollingMetallic Then
  185.                    
  186.                  DrawMetalProgressbar
  187.                     
  188.  
  189.             '==========================================================
  190.             '/---Draw OFFICE XP STYLE
  191.             '==========================================================
  192.  
  193.             ElseIf m_Scrolling = ccScrollingOfficeXP Then
  194.                    
  195.                  DrawOfficeXPProgressbar
  196.                     
  197.             '==========================================================
  198.             '/---Draw PASTEL XP STYLE
  199.             '==========================================================
  200.  
  201.             ElseIf m_Scrolling = ccScrollingPastel Then
  202.                  
  203.                  DrawPastelProgressbar
  204.                  
  205.             '==========================================================
  206.             '/---Draw JAVT XP STYLE
  207.             '==========================================================
  208.  
  209.             ElseIf m_Scrolling = ccScrollingJavT Then
  210.                  
  211.                  DrawJavTProgressbar
  212.              
  213.             '==========================================================
  214.             '/---Draw MEDIA PLAYER XP STYLE
  215.             '==========================================================
  216.  
  217.             ElseIf m_Scrolling = ccScrollingMediaPlayer Then
  218.             
  219.                  DrawMediaProgressbar
  220.             
  221.             '==========================================================
  222.             '/---Draw CUSTOM BRUSH XP WASH COLOR STYLE
  223.             '==========================================================
  224.  
  225.             ElseIf m_Scrolling = ccScrollingCustomBrush Then
  226.             
  227.                  DrawCustomBrushProgressbar
  228.              
  229.             '==========================================================
  230.             '/---Draw PICTURE STYLE
  231.             '==========================================================
  232.  
  233.             ElseIf m_Scrolling = ccScrollingPicture Then
  234.             
  235.                  DrawPictureProgressbar
  236.        
  237.             Else
  238.             
  239.             '==========================================================
  240.             '/---Draw WINDOWS XP STYLE
  241.             '==========================================================
  242.  
  243.             
  244.                 CalcBarSize                            '//--- Calculate Progress and Percent Values
  245.   
  246.                 PBarDraw                               '//--- Draw Scolling Bar (Inside Bar)
  247.                   
  248.                 If m_Scrolling = 0 Then DrawDivisions  '//--- Draw SegmentSpacing (This Will Generate the Blocks Effect)
  249.   
  250.                 pDrawBorder                            '//--- Draw The XP Look Border
  251.             
  252.             End If
  253.             
  254.             '==========================================================
  255.             
  256.             DrawTexto                                  '//--- Draw The Percent Text
  257.             
  258.             '==========================================================
  259.             '/---Use the AntiFlicker DC
  260.             '==========================================================
  261.  
  262.             If m_MemDC Then
  263.                 With UserControl
  264.                     pDraw .hdc, 0, 0, .ScaleWidth, .ScaleHeight, .ScaleLeft, .ScaleTop
  265.                 End With
  266.             End If
  267.  
  268. End Sub
  269.  
  270. '==========================================================
  271. '/---OFFICE XP STYLE
  272. '==========================================================
  273. Private Sub DrawOfficeXPProgressbar()
  274.         
  275.         DrawRectangle TR, ShiftColorXP(m_Color, 100), m_hDC
  276.              
  277.         With TBR
  278.           .Left = 1
  279.           .Top = 1
  280.           .Bottom = TR.Bottom - 1
  281.           .Right = TR.Left + (TR.Right - TR.Left) * (m_Value / 100)
  282.         End With
  283.              
  284.         DrawFillRectangle TBR, ShiftColorXP(m_Color, 180), m_hDC
  285.  
  286. End Sub
  287. '==========================================================
  288. '/---JAVT XP STYLE
  289. '==========================================================
  290. Private Sub DrawJavTProgressbar()
  291.  
  292.        DrawRectangle TR, ShiftColorXP(m_Color, 10), m_hDC
  293.        TBR.Right = TR.Left + (TR.Right - TR.Left) * (m_Value / 101)
  294.        DrawGradient m_Color, ShiftColorXP(m_Color, 100), 2, 2, TR.Right - 2, TR.Bottom - 5, m_hDC ', True
  295.        DrawGradient ShiftColorXP(m_Color, 250), m_Color, 3, 3, TBR.Right, TR.Bottom - 6, m_hDC  ', True
  296.        DrawLine TBR.Right, 2, TBR.Right, TR.Bottom - 2, m_hDC, ShiftColorXP(m_Color, 25)
  297.  
  298. End Sub
  299. '==========================================================
  300. '/---PICTURE STYLE
  301. '==========================================================
  302. Private Sub DrawPictureProgressbar()
  303.  
  304. Dim Brush      As Long
  305. Dim origBrush  As Long
  306.  
  307.        DrawEdge m_hDC, TR, 2, BF_RECT                       '//--- Draw ProgressBar Border
  308.        
  309.        If Nothing Is m_Picture Then Exit Sub                '//--- In Case No Picture is Choosen
  310.               
  311.        Brush = CreatePatternBrush(m_Picture.handle)         '//-- Use Pattern Picture Draw
  312.        origBrush = SelectObject(m_hDC, Brush)
  313.        TBR.Right = TR.Left + (TR.Right - TR.Left) * (m_Value / 101)
  314.        
  315.        PatBlt m_hDC, 2, 2, TBR.Right, TR.Bottom - 4, vbPatCopy
  316.          
  317.        SelectObject m_hDC, origBrush
  318.        DeleteObject Brush
  319.        
  320. End Sub
  321. '==========================================================
  322. '/---PASTEL XP STYLE
  323. '==========================================================
  324. Private Sub DrawPastelProgressbar()
  325.         DrawEdge m_hDC, TR, 6, BF_RECT
  326.         DrawGradient ShiftColorXP(m_Color, 140), ShiftColorXP(m_Color, 200), 2, 2, TR.Left + (TR.Right - TR.Left - 4) * (m_Value / 100), TR.Bottom - 3, m_hDC, True
  327. End Sub
  328.  
  329. '==========================================================
  330. '/---METALLIC XP STYLE
  331. '==========================================================
  332. Private Sub DrawMetalProgressbar()
  333.          TBR.Right = TR.Left + (TR.Right - TR.Left - 4) * (m_Value / 100)
  334.          
  335.          DrawGradient vbWhite, &HC0C0C0, 2, 2, TR.Right - 3, (TR.Bottom - 3) / 2, m_hDC
  336.          DrawGradient BlendColor(&HC0C0C0, &H0, 255), &HC0C0C0, 2, (TR.Bottom - 3) / 2, TR.Right - 3, (TR.Bottom - 3) / 2, m_hDC
  337.          DrawGradient ShiftColorXP(m_Color, 150), BlendColor(m_Color, &H0, 180), 2, 2, TBR.Right, (TR.Bottom - 3) / 2, m_hDC
  338.          DrawGradient BlendColor(m_Color, &H0, 190), m_Color, 2, (TR.Bottom - 3) / 2, TBR.Right, (TR.Bottom - 3) / 2, m_hDC
  339.         
  340.          TR.Left = TR.Left + 3
  341.          pDrawBorder
  342.     
  343.         
  344. End Sub
  345. '==========================================================
  346. '/---CUSTOM BRUSH XP STYLE
  347. '==========================================================
  348. Private Sub DrawCustomBrushProgressbar()
  349.         
  350.    Dim hBrush As Long
  351.     
  352.    DrawEdge m_hDC, TR, 9, BF_RECT
  353.        
  354.    With TBR
  355.       .Left = 2
  356.       .Top = 2
  357.       .Bottom = TR.Bottom - 2
  358.       .Right = TR.Left + (TR.Right - TR.Left) * (m_Value / 101)
  359.    End With
  360.  
  361.    hBrush = CreateHatchBrush(m_Brush, GetLngColor(Color))
  362.    SetBkColor m_hDC, ShiftColorXP(m_Color, 140)
  363.    FillRect m_hDC, TBR, hBrush
  364.    DeleteObject hBrush
  365.                 
  366. End Sub
  367. '==========================================================
  368. '/---MEDIA PROGRESS XP STYLE
  369. '==========================================================
  370. Private Sub DrawMediaProgressbar()
  371.         
  372.         DrawRectangle TR, BlendColor(m_Color, &H0, 200), m_hDC
  373.         DrawGradient &H0&, ShiftColorXP(GetLngColor(BlendColor(m_Color, &H0, 100)), 10), 2, 2, TR.Left + (TR.Right - TR.Left - 5) * (m_Value / 100), TR.Bottom - 2, m_hDC, True
  374.  
  375. End Sub
  376.  
  377. '==========================================================
  378. '/---Calculate Division Bars & Percent Values
  379. '==========================================================
  380.  
  381. Private Sub CalcBarSize()
  382.  
  383.       lSegmentWidth = IIf(m_Scrolling = 0, 6, 0) '/-- Windows Default
  384.       lSegmentSpacing = 2                        '/-- Windows Default
  385.             
  386.       TR.Left = TR.Left + 3
  387.    
  388.       LSet TBR = TR
  389.  
  390.       fPercent = m_Value / 98
  391.         
  392.       If fPercent < 0# Then fPercent = 0#
  393.    
  394.       If m_Orientation = 0 Then
  395.       
  396.       '=======================================================================================
  397.       '                                 Calc Horizontal ProgressBar
  398.       '---------------------------------------------------------------------------------------
  399.          
  400.          TBR.Right = TR.Left + (TR.Right - TR.Left) * fPercent
  401.          
  402.          TBR.Right = TBR.Right - ((TBR.Right - TBR.Left) Mod (lSegmentWidth + lSegmentSpacing))
  403.          
  404.          If TBR.Right < TR.Left Then
  405.             TBR.Right = TR.Left
  406.          End If
  407.                   
  408.       Else
  409.       
  410.       '=======================================================================================
  411.       '                                 Calc Vertical ProgressBar
  412.       '---------------------------------------------------------------------------------------
  413.          fPercent = 1# - fPercent
  414.          TBR.Top = TR.Top + (TR.Bottom - TR.Top) * fPercent
  415.          TBR.Top = TBR.Top - ((TBR.Top - TBR.Bottom) Mod (lSegmentWidth + lSegmentSpacing))
  416.          If TBR.Top > TR.Bottom Then TBR.Top = TR.Bottom
  417.     
  418.          
  419.       
  420.       End If
  421.  
  422. End Sub
  423.  
  424. '==========================================================
  425. '/---Draw Division Bars
  426. '==========================================================
  427.  
  428. Private Sub DrawDivisions()
  429.  Dim i As Long
  430.  Dim hBR As Long
  431.   
  432.   hBR = CreateSolidBrush(vbWhite)
  433.   
  434.       LSet TSR = TR
  435.       
  436.        
  437.       If m_Orientation = 0 Then
  438.       
  439.       
  440.       '=======================================================================================
  441.       '                                 Draw Horizontal ProgressBar
  442.       '---------------------------------------------------------------------------------------
  443.          For i = TBR.Left + lSegmentWidth To TBR.Right Step lSegmentWidth + lSegmentSpacing
  444.             TSR.Left = i + 1
  445.             TSR.Right = i + 1 + lSegmentSpacing
  446.             FillRect m_hDC, TSR, hBR
  447.          Next i
  448.       '---------------------------------------------------------------------------------------
  449.       
  450.       Else
  451.       
  452.       '=======================================================================================
  453.       '                                  Draw Vertical ProgressBar
  454.       '---------------------------------------------------------------------------------------
  455.          For i = TBR.Bottom To TBR.Top + lSegmentWidth Step -(lSegmentWidth + lSegmentSpacing)
  456.             TSR.Top = i - 2
  457.             TSR.Bottom = i - 2 + lSegmentSpacing
  458.             FillRect m_hDC, TSR, hBR
  459.          Next i
  460.        '---------------------------------------------------------------------------------------
  461.       
  462.       End If
  463.       
  464.       DeleteObject hBR
  465.      
  466. End Sub
  467.  
  468.  
  469. '==========================================================
  470. '/---Draw The ProgressXP Bar Border  ;)
  471. '==========================================================
  472.  
  473. Private Sub pDrawBorder()
  474. Dim RTemp As RECT
  475.  
  476.  TR.Left = TR.Left - 3
  477.  
  478.  Let RTemp = TR
  479.   
  480.  
  481.  DrawLine 2, 1, TR.Right - 2, 1, m_hDC, &HBEBEBE
  482.  DrawLine 2, TR.Bottom - 2, TR.Right - 2, TR.Bottom - 2, m_hDC, &HEFEFEF
  483.  DrawLine 1, 2, 1, TR.Bottom - 2, m_hDC, &HBEBEBE
  484.  DrawLine 2, 2, 2, TR.Bottom - 2, m_hDC, &HEFEFEF
  485.  DrawLine 2, 2, TR.Right - 2, 2, m_hDC, &HEFEFEF
  486.  DrawLine TR.Right - 2, 2, TR.Right - 2, TR.Bottom - 2, m_hDC, &HEFEFEF
  487.   
  488.  DrawRectangle TR, GetLngColor(&H686868), m_hDC
  489.  
  490.  
  491.  Call SetPixelV(m_hDC, 0, 0, GetLngColor(vbWhite))
  492.  Call SetPixelV(m_hDC, 0, 1, GetLngColor(&HA6ABAC))
  493.  Call SetPixelV(m_hDC, 0, 2, GetLngColor(&H7D7E7F))
  494.  Call SetPixelV(m_hDC, 1, 0, GetLngColor(&HA7ABAC)) '//TOP RIGHT CORNER
  495.  Call SetPixelV(m_hDC, 1, 1, GetLngColor(&H777777))
  496.  Call SetPixelV(m_hDC, 2, 0, GetLngColor(&H7D7E7F))
  497.  Call SetPixelV(m_hDC, 2, 2, GetLngColor(&HBEBEBE))
  498.    
  499.  Call SetPixelV(m_hDC, 0, TR.Bottom - 1, GetLngColor(vbWhite))
  500.  Call SetPixelV(m_hDC, 1, TR.Bottom - 1, GetLngColor(&HA6ABAC))
  501.  Call SetPixelV(m_hDC, 2, TR.Bottom - 1, GetLngColor(&H7D7E7F))
  502.  Call SetPixelV(m_hDC, 0, TR.Bottom - 3, GetLngColor(&H7D7E7F)) '//BOTTOM RIGHT CORNER
  503.  Call SetPixelV(m_hDC, 0, TR.Bottom - 2, GetLngColor(&HA7ABAC))
  504.  Call SetPixelV(m_hDC, 1, TR.Bottom - 2, GetLngColor(&H777777))
  505.  
  506.  Call SetPixelV(m_hDC, TR.Right - 1, 0, GetLngColor(vbWhite))
  507.  Call SetPixelV(m_hDC, TR.Right - 1, 1, GetLngColor(&HBEBEBE))
  508.  Call SetPixelV(m_hDC, TR.Right - 1, 2, GetLngColor(&H7D7E7F)) '//TOP LEFT CORNER
  509.  Call SetPixelV(m_hDC, TR.Right - 2, 2, GetLngColor(&HBEBEBE))
  510.  Call SetPixelV(m_hDC, TR.Right - 2, 1, GetLngColor(&H686868))
  511.  
  512.  Call SetPixelV(m_hDC, TR.Right - 1, TR.Bottom - 1, GetLngColor(vbWhite))
  513.  Call SetPixelV(m_hDC, TR.Right - 1, TR.Bottom - 2, GetLngColor(&HBEBEBE))
  514.  Call SetPixelV(m_hDC, TR.Right - 1, TR.Bottom - 3, GetLngColor(&H7D7E7F))
  515.  Call SetPixelV(m_hDC, TR.Right - 2, TR.Bottom - 2, GetLngColor(&H777777)) '//TOP RIGHT CORNER
  516.  Call SetPixelV(m_hDC, TR.Right - 2, TR.Bottom - 1, GetLngColor(&HBEBEBE))
  517.  Call SetPixelV(m_hDC, TR.Right - 3, TR.Bottom - 1, GetLngColor(&H7D7E7F))
  518.  
  519.  
  520. End Sub
  521.  
  522.  
  523. '==========================================================
  524. '/---Draw The ProgressXP Bar ;)
  525. '==========================================================
  526.  
  527. Private Sub PBarDraw()
  528. Dim TempRect As RECT
  529. Dim ITemp    As Long
  530.  
  531. If m_Orientation = 0 Then
  532.  
  533.     If TBR.Right <= 14 Then TBR.Right = 12
  534.         
  535.     TempRect.Left = 4
  536.     TempRect.Right = IIf(TBR.Right + 4 > TR.Right, TBR.Right - 4, TBR.Right)
  537.     TempRect.Top = 8
  538.     TempRect.Bottom = TR.Bottom - 8
  539.  
  540.     '=======================================================================================
  541.     '                                 Draw Horizontal ProgressBar
  542.     '---------------------------------------------------------------------------------------
  543.    
  544.          
  545.      If m_Scrolling = ccScrollingSearch Then
  546.          GoSub HorizontalSearch
  547.      Else
  548.         DrawGradient ShiftColorXP(m_Color, 150), m_Color, 4, 3, TempRect.Right, 6, m_hDC
  549.         DrawFillRectangle TempRect, m_Color, m_hDC
  550.         DrawGradient m_Color, ShiftColorXP(m_Color, 150), 4, TempRect.Bottom - 2, TempRect.Right, 6, m_hDC
  551.      End If
  552. Else
  553.     
  554.     TempRect.Left = 9
  555.     TempRect.Right = TR.Right - 8
  556.     TempRect.Top = TBR.Top
  557.     TempRect.Bottom = TR.Bottom
  558.     
  559.     '=======================================================================================
  560.     '                                 Draw Vertical ProgressBar
  561.     '---------------------------------------------------------------------------------------
  562.    
  563.     If m_Scrolling = ccScrollingSearch Then
  564.          GoSub VerticalSearch
  565.     Else
  566.         DrawGradient ShiftColorXP(m_Color, 150), m_Color, 4, TBR.Top, 4, TR.Bottom, m_hDC, True
  567.         DrawFillRectangle TempRect, m_Color, m_hDC
  568.         DrawGradient m_Color, ShiftColorXP(m_Color, 150), TR.Right - 8, TBR.Top, 4, TR.Bottom, m_hDC, True
  569.     End If
  570.    
  571.     '--------------------   <-------- Gradient Color From (- to +)
  572.     '||||||||||||||||||||   <-------- Fill Color
  573.     '--------------------   <-------- Gradient Color From (+ to -)
  574.  
  575. End If
  576.  
  577. Exit Sub
  578.  
  579. HorizontalSearch:
  580.     
  581.     
  582.     For ITemp = 0 To 2
  583.     
  584.         With TempRect
  585.           .Left = TBR.Right + ((lSegmentSpacing + 10) * (ITemp)) - (45 * ((100 - m_Value) / 100))
  586.           .Right = .Left + 10
  587.           .Top = 8
  588.           .Bottom = TR.Bottom - 8
  589.           DrawGradient ShiftColorXP(m_Color, 220 - (40 * ITemp)), ShiftColorXP(m_Color, 200 - (40 * ITemp)), .Left, 3, 9, TR.Bottom - 2, m_hDC, True
  590.         End With
  591.         
  592.     Next ITemp
  593.  
  594. Return
  595.  
  596. VerticalSearch:
  597.     
  598.      
  599.     For ITemp = 0 To 2
  600.     
  601.         With TempRect
  602.           .Left = 8
  603.           .Right = TR.Right - 8
  604.           .Top = TBR.Top + ((lSegmentSpacing + 10) * ITemp)
  605.           .Bottom = .Top + 10
  606.           DrawGradient ShiftColorXP(m_Color, 220 - (40 * ITemp)), ShiftColorXP(m_Color, 200 - (40 * ITemp)), TR.Right - 2, .Top, 2, 9, m_hDC
  607.         End With
  608.         
  609.     Next ITemp
  610.  
  611. Return
  612.  
  613. End Sub
  614.  
  615. '======================================================================
  616. 'DRAWS THE PERCENT TEXT ON PROGRESS BAR
  617. Private Function DrawTexto()
  618. Dim ThisText As String
  619. Dim isAlpha  As Boolean
  620.  
  621. If (m_Scrolling = ccScrollingMediaPlayer Or m_Scrolling = ccScrollingMetallic) Then isAlpha = True
  622.  
  623.  
  624.  If m_Scrolling = ccScrollingSearch Then
  625.     ThisText = "Searching.."
  626.  Else
  627.     ThisText = Round(m_Value) & " %"
  628.  End If
  629.  
  630.  If (m_ShowText) Then
  631.            
  632.       Set iFnt = Font                             '//--New Font
  633.       hFntOld = SelectObject(m_hDC, iFnt.hFont)   '//--Use the New Font
  634.       SetBkMode m_hDC, 1                          '//--Transparent Text
  635.      
  636.       '//--Use the Alpha Text Color Look if Progress is MediaPlayer Style, else Normal (Gray)
  637.       SetTextColor m_hDC, GetLngColor(IIf(m_Scrolling = ccScrollingMediaPlayer, &HC0C0C0, vbBlack))
  638.       
  639.       CalculateAlphaTextRect ThisText             '//--Calculate The Text Rectangle
  640.            
  641.       '//-- If ProgressBar is already over the Text don't draw the old text, yust draw the Alpha Text
  642.            'It saves some memory
  643.       
  644.       If ((TR.Right * (m_Value / 100)) <= AT.Right) Or Not isAlpha Then
  645.             DrawText m_hDC, ThisText, Len(ThisText), AT, DT_SINGLELINE
  646.       End If
  647.             
  648.       SelectObject m_hDC, hFntOld  'Delete the Used Font
  649.    
  650.       '//--Use the Alpha Text Look if Progress is AlPhA Style
  651.       If isAlpha Then DrawAlphaText ThisText
  652.               
  653.  End If
  654.  
  655.  
  656. End Function
  657. '======================================================================
  658.  
  659. '======================================================================
  660. 'ALPHA TEXT RECT FUNCTION
  661. Private Sub CalculateAlphaTextRect(ByVal ThisText As String)
  662.  
  663.       '//--Calculates the Bounding Rects Of the Text using DT_CALCRECT
  664.       DrawText m_hDC, ThisText, Len(ThisText), AT, DT_CALCRECT
  665.       AT.Left = (TR.Right / 2) - ((AT.Right - AT.Left) / 2)
  666.       AT.Top = (TR.Bottom / 2) - ((AT.Bottom - AT.Top) / 2)
  667.  
  668. End Sub
  669. '======================================================================
  670.  
  671. '======================================================================
  672. 'ALPHA TEXT FUNCTION
  673. Private Sub DrawAlphaText(ByVal ThisText As String)
  674.  
  675.  Set iFnt = Font                             '//--New Font
  676.  hFntOld = SelectObject(m_hDC, iFnt.hFont)   '//--Use the New Font
  677.  SetBkMode m_hDC, 1                          '//--Transparent Text
  678.         
  679.         
  680.         '//-- This is When the Text is Drawn
  681.             '//--Gives the Media Player Text Look (Changes Color When Progress is over the Text)
  682.             
  683.             If (TR.Right * (m_Value / 100)) >= AT.Left Then
  684.                 SetTextColor m_hDC, GetLngColor(IIf(m_Scrolling = ccScrollingMediaPlayer, ShiftColorXP(m_Color, 80), vbWhite))
  685.                 AT.Left = (TR.Right / 2) - ((AT.Right - AT.Left) / 2)
  686.                 AT.Right = (TR.Right * (m_Value / 100))
  687.                 DrawText m_hDC, ThisText, Len(ThisText), AT, DT_SINGLELINE
  688.                 SelectObject m_hDC, hFntOld
  689.             End If
  690.  
  691. End Sub
  692. '======================================================================
  693.  
  694. '======================================================================
  695. 'CONVERTION FUNCTION
  696. Private Function GetLngColor(Color As Long) As Long
  697.     
  698.     If (Color And &H80000000) Then
  699.         GetLngColor = GetSysColor(Color And &H7FFFFFFF)
  700.     Else
  701.         GetLngColor = Color
  702.     End If
  703. End Function
  704. '======================================================================
  705.  
  706. '======================================================================
  707. 'DRAWS A BORDER RECTANGLE AREA OF AN SPECIFIED COLOR
  708. Private Sub DrawRectangle(ByRef BRect As RECT, ByVal Color As Long, ByVal hdc As Long)
  709.  
  710. Dim hBrush As Long
  711.     
  712.     hBrush = CreateSolidBrush(Color)
  713.     FrameRect hdc, BRect, hBrush
  714.     DeleteObject hBrush
  715.  
  716. End Sub
  717. '======================================================================
  718.  
  719. '======================================================================
  720. 'DRAWS A LINE WITH A DEFINED COLOR
  721. Public Sub DrawLine( _
  722.            ByVal X As Long, _
  723.            ByVal Y As Long, _
  724.            ByVal Width As Long, _
  725.            ByVal Height As Long, _
  726.            ByVal cHdc As Long, _
  727.            ByVal Color As Long)
  728.  
  729.     Dim Pen1    As Long
  730.     Dim Pen2    As Long
  731.     Dim Outline As Long
  732.     Dim POS     As POINTAPI
  733.  
  734.     Pen1 = CreatePen(0, 1, GetLngColor(Color))
  735.     Pen2 = SelectObject(cHdc, Pen1)
  736.     
  737.         MoveToEx cHdc, X, Y, POS
  738.         LineTo cHdc, Width, Height
  739.           
  740.     SelectObject cHdc, Pen2
  741.     DeleteObject Pen2
  742.     DeleteObject Pen1
  743.  
  744. End Sub
  745. '======================================================================
  746.  
  747. '======================================================================
  748. 'BLENDS AN SPECIFIED COLOR TO GET XP COLOR LOOK
  749. Private Function ShiftColorXP(ByVal MyColor As Long, ByVal Base As Long) As Long
  750.  
  751.     Dim R As Long, G As Long, B As Long, Delta As Long
  752.  
  753.     R = (MyColor And &HFF)
  754.     G = ((MyColor \ &H100) Mod &H100)
  755.     B = ((MyColor \ &H10000) Mod &H100)
  756.     
  757.     Delta = &HFF - Base
  758.  
  759.     B = Base + B * Delta \ &HFF
  760.     G = Base + G * Delta \ &HFF
  761.     R = Base + R * Delta \ &HFF
  762.  
  763.     If R > 255 Then R = 255
  764.     If G > 255 Then G = 255
  765.     If B > 255 Then B = 255
  766.  
  767.     ShiftColorXP = R + 256& * G + 65536 * B
  768.  
  769. End Function
  770. '======================================================================
  771.  
  772. '======================================================================
  773. 'DRAWS A 2 COLOR GRADIENT AREA WITH A PREDEFINED DIRECTION
  774. Public Sub DrawGradient(lEndColor As Long, lStartcolor As Long, ByVal X As Long, ByVal Y As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal hdc As Long, Optional bH As Boolean)
  775.     On Error Resume Next
  776.     
  777.     ''Draw a Vertical Gradient in the current HDC
  778.     Dim sR As Single, sG As Single, sB As Single
  779.     Dim eR As Single, eG As Single, eB As Single
  780.     Dim ni As Long
  781.     
  782.     lEndColor = GetLngColor(lEndColor)
  783.     lStartcolor = GetLngColor(lStartcolor)
  784.  
  785.     sR = (lStartcolor And &HFF)
  786.     sG = (lStartcolor \ &H100) And &HFF
  787.     sB = (lStartcolor And &HFF0000) / &H10000
  788.     eR = (lEndColor And &HFF)
  789.     eG = (lEndColor \ &H100) And &HFF
  790.     eB = (lEndColor And &HFF0000) / &H10000
  791.     sR = (sR - eR) / IIf(bH, X2, Y2)
  792.     sG = (sG - eG) / IIf(bH, X2, Y2)
  793.     sB = (sB - eB) / IIf(bH, X2, Y2)
  794.     
  795.         
  796.     For ni = 0 To IIf(bH, X2, Y2)
  797.         
  798.         If bH Then
  799.             DrawLine X + ni, Y, X + ni, Y2, hdc, RGB(eR + (ni * sR), eG + (ni * sG), eB + (ni * sB))
  800.         Else
  801.             DrawLine X, Y + ni, X2, Y + ni, hdc, RGB(eR + (ni * sR), eG + (ni * sG), eB + (ni * sB))
  802.         End If
  803.         
  804.     Next ni
  805. End Sub
  806. '======================================================================
  807.  
  808. '======================================================================
  809. 'BLENDS 2 COLORS WITH A PREDEFINED ALPHA VALUE
  810. Private Function BlendColor(ByVal oColorFrom As OLE_COLOR, ByVal oColorTo As OLE_COLOR, Optional ByVal Alpha As Long = 128) As Long
  811. Dim lCFrom As Long
  812. Dim lCTo As Long
  813. Dim lSrcR As Long
  814. Dim lSrcG As Long
  815. Dim lSrcB As Long
  816. Dim lDstR As Long
  817. Dim lDstG As Long
  818. Dim lDstB As Long
  819.    
  820.    lCFrom = GetLngColor(oColorFrom)
  821.    lCTo = GetLngColor(oColorTo)
  822.    
  823.    lSrcR = lCFrom And &HFF
  824.    lSrcG = (lCFrom And &HFF00&) \ &H100&
  825.    lSrcB = (lCFrom And &HFF0000) \ &H10000
  826.    lDstR = lCTo And &HFF
  827.    lDstG = (lCTo And &HFF00&) \ &H100&
  828.    lDstB = (lCTo And &HFF0000) \ &H10000
  829.    
  830.    BlendColor = RGB( _
  831.       ((lSrcR * Alpha) / 255) + ((lDstR * (255 - Alpha)) / 255), _
  832.       ((lSrcG * Alpha) / 255) + ((lDstG * (255 - Alpha)) / 255), _
  833.       ((lSrcB * Alpha) / 255) + ((lDstB * (255 - Alpha)) / 255) _
  834.       )
  835.       
  836. End Function
  837. '======================================================================
  838.  
  839. '======================================================================
  840. 'DRAWS A FILL RECTANGLE AREA OF AN SPECIFIED COLOR
  841. Private Sub DrawFillRectangle(ByRef hRect As RECT, ByVal Color As Long, ByVal MyHdc As Long)
  842.  
  843. Dim hBrush As Long
  844.  
  845.    hBrush = CreateSolidBrush(GetLngColor(Color))
  846.    FillRect MyHdc, hRect, hBrush
  847.    DeleteObject hBrush
  848.  
  849. End Sub
  850. '======================================================================
  851.  
  852. '======================================================================
  853. 'CHECKS-CREATES CORRECT DIMENSIONS OF THE TEMP DC
  854. Private Function ThDC(Width As Long, Height As Long) As Long
  855.    If m_ThDC = 0 Then
  856.       If (Width > 0) And (Height > 0) Then
  857.          pCreate Width, Height
  858.       End If
  859.    Else
  860.       If Width > m_lWidth Or Height > m_lHeight Then
  861.          pCreate Width, Height
  862.       End If
  863.    End If
  864.    ThDC = m_ThDC
  865. End Function
  866. '======================================================================
  867.  
  868. '======================================================================
  869. 'CREATES THE TEMP DC
  870. Private Sub pCreate(ByVal Width As Long, ByVal Height As Long)
  871. Dim lhDCC As Long
  872.    pDestroy
  873.    lhDCC = CreateDC("DISPLAY", "", "", ByVal 0&)
  874.    If Not (lhDCC = 0) Then
  875.       m_ThDC = CreateCompatibleDC(lhDCC)
  876.       If Not (m_ThDC = 0) Then
  877.          m_hBmp = CreateCompatibleBitmap(lhDCC, Width, Height)
  878.          If Not (m_hBmp = 0) Then
  879.             m_hBmpOld = SelectObject(m_ThDC, m_hBmp)
  880.             If Not (m_hBmpOld = 0) Then
  881.                m_lWidth = Width
  882.                m_lHeight = Height
  883.                DeleteDC lhDCC
  884.                Exit Sub
  885.             End If
  886.          End If
  887.       End If
  888.       DeleteDC lhDCC
  889.       pDestroy
  890.    End If
  891. End Sub
  892. '======================================================================
  893.  
  894. '======================================================================
  895. 'DRAWS THE TEMP DC
  896. Public Sub pDraw( _
  897.       ByVal hdc As Long, _
  898.       Optional ByVal xSrc As Long = 0, Optional ByVal ySrc As Long = 0, _
  899.       Optional ByVal WidthSrc As Long = 0, Optional ByVal HeightSrc As Long = 0, _
  900.       Optional ByVal xDst As Long = 0, Optional ByVal yDst As Long = 0 _
  901.    )
  902.    If WidthSrc <= 0 Then WidthSrc = m_lWidth
  903.    If HeightSrc <= 0 Then HeightSrc = m_lHeight
  904.    BitBlt hdc, xDst, yDst, WidthSrc, HeightSrc, m_ThDC, xSrc, ySrc, vbSrcCopy
  905.  
  906. End Sub
  907. '======================================================================
  908.  
  909. '======================================================================
  910. 'DESTROYS THE TEMP DC
  911. Private Sub pDestroy()
  912.    If Not m_hBmpOld = 0 Then
  913.       SelectObject m_ThDC, m_hBmpOld
  914.       m_hBmpOld = 0
  915.    End If
  916.    If Not m_hBmp = 0 Then
  917.       DeleteObject m_hBmp
  918.       m_hBmp = 0
  919.    End If
  920.    If Not m_ThDC = 0 Then
  921.       DeleteDC m_ThDC
  922.       m_ThDC = 0
  923.    End If
  924.    m_lWidth = 0
  925.    m_lHeight = 0
  926. End Sub
  927. '======================================================================
  928.  
  929.  
  930.  
  931. '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  932. '===========================================================================
  933. 'USER CONTROL EVENTS
  934. '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  935. '===========================================================================
  936.  
  937.  
  938. Private Sub UserControl_Initialize()
  939.  
  940.      Dim fnt As New StdFont
  941.          Set Font = fnt
  942.  
  943.      With UserControl
  944.         .BackColor = vbWhite
  945.         .ScaleMode = vbPixels
  946.      End With
  947.      
  948.      '----------------------------------------------------------
  949.      'Default Values
  950.      hdc = UserControl.hdc
  951.      hwnd = UserControl.hwnd
  952.      m_Max = 100
  953.      m_Min = 0
  954.      m_Value = 0
  955.      m_Orientation = ccOrientationHorizontal
  956.      m_Scrolling = ccScrollingStandard
  957.      m_Color = GetLngColor(vbHighlight)
  958.      DrawProgressBar
  959.      '----------------------------------------------------------
  960.  
  961. End Sub
  962.  
  963. Private Sub UserControl_Paint()
  964.  DrawProgressBar
  965. End Sub
  966.  
  967. Private Sub UserControl_Resize()
  968. hdc = UserControl.hdc
  969. End Sub
  970.  
  971. Private Sub UserControl_Terminate()
  972.  pDestroy 'Destroy Temp DC
  973. End Sub
  974.  
  975.  
  976. '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  977. '===========================================================================
  978. 'USER CONTROL PROPERTIES
  979. '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  980. '===========================================================================
  981.  
  982. Public Property Let BrushStyle(ByVal Style As BrushStyle)
  983.    m_Brush = Style
  984.    PropertyChanged "BrushStyle"
  985. End Property
  986.  
  987. Public Property Get Color() As OLE_COLOR
  988.    Color = m_Color
  989. End Property
  990.  
  991. Public Property Let Color(ByVal lColor As OLE_COLOR)
  992.    m_Color = GetLngColor(lColor)
  993.    DrawProgressBar
  994. End Property
  995.  
  996. Public Property Get Font() As IFont
  997.    Set Font = m_fnt
  998. End Property
  999.  
  1000. Public Property Set Font(ByRef fnt As IFont)
  1001.    Set m_fnt = fnt    'Defined By System but can change by user choice.(ADD Property!!)
  1002. End Property
  1003.  
  1004. Public Property Let Font(ByRef fnt As IFont)
  1005.    Set m_fnt = fnt
  1006. End Property
  1007.  
  1008. Public Property Get hwnd() As Long
  1009.    hwnd = m_hWnd
  1010. End Property
  1011.  
  1012. Public Property Let hwnd(ByVal chWnd As Long)
  1013.    m_hWnd = chWnd
  1014. End Property
  1015.  
  1016. Public Property Get hdc() As Long
  1017.    hdc = m_hDC
  1018. End Property
  1019.  
  1020. Public Property Let hdc(ByVal cHdc As Long)
  1021.      '=============================================
  1022.    'AntiFlick...Cleaner HDC
  1023.    m_hDC = ThDC(UserControl.ScaleWidth, UserControl.ScaleHeight)
  1024.    
  1025.    If m_hDC = 0 Then
  1026.       m_hDC = UserControl.hdc   'On Fail...Do it Normally
  1027.    Else
  1028.       m_MemDC = True
  1029.    End If
  1030.    '=============================================
  1031.  
  1032. End Property
  1033.  
  1034. Public Property Get Image() As StdPicture
  1035.     If Nothing Is m_Picture Then Exit Property
  1036.     Set Image = m_Picture
  1037. End Property
  1038.  
  1039. Public Property Set Image(ByVal handle As StdPicture)
  1040.    Set m_Picture = handle
  1041.    PropertyChanged "Image"
  1042.    DrawProgressBar
  1043. End Property
  1044.  
  1045. Public Property Get Min() As Long
  1046.    Min = m_Min
  1047. End Property
  1048.  
  1049. Public Property Let Min(ByVal cMin As Long)
  1050.    m_Min = cMin
  1051.    PropertyChanged "Min"
  1052. End Property
  1053.  
  1054. Public Property Get Max() As Long
  1055.    Max = m_Max
  1056. End Property
  1057.  
  1058. Public Property Let Max(ByVal cMax As Long)
  1059.    m_Max = cMax
  1060.    PropertyChanged "Max"
  1061. End Property
  1062.  
  1063. Public Property Get Orientation() As cOrientation
  1064.    Orientation = m_Orientation
  1065. End Property
  1066.  
  1067. Public Property Let Orientation(ByVal cOrientation As cOrientation)
  1068.    m_Orientation = cOrientation
  1069.    PropertyChanged "Orientation"
  1070.    DrawProgressBar
  1071. End Property
  1072.  
  1073. Public Property Get Scrolling() As cScrolling
  1074.    Scrolling = m_Scrolling
  1075. End Property
  1076.  
  1077. Public Property Let Scrolling(ByVal lScrolling As cScrolling)
  1078.    m_Scrolling = lScrolling
  1079.    PropertyChanged "Scrolling"
  1080.    DrawProgressBar
  1081. End Property
  1082.  
  1083. Public Property Get ShowText() As Boolean
  1084.    ShowText = m_ShowText
  1085. End Property
  1086.  
  1087. Public Property Let ShowText(ByVal bShowText As Boolean)
  1088.    m_ShowText = bShowText
  1089.    PropertyChanged "ShowText"
  1090.    DrawProgressBar
  1091. End Property
  1092.  
  1093. Public Property Get Value() As Long
  1094.    Value = ((m_Value / 100) * m_Max) / IIf(m_Min > 0, m_Min, 1)
  1095. End Property
  1096.  
  1097. Public Property Let Value(ByVal cValue As Long)
  1098.     m_Value = ((cValue * 100) / m_Max) + m_Min
  1099.     'PropertyChanged "Value"
  1100.     DrawProgressBar
  1101. End Property
  1102.  
  1103. '=======================================================================================================================
  1104. ' USERCONTROL WRITE PROPERTIES
  1105. '=======================================================================================================================
  1106.  
  1107. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  1108.  Call PropBag.WriteProperty("Font", Font)
  1109.  Call PropBag.WriteProperty("BrushStyle", m_Brush, 4)
  1110.  Call PropBag.WriteProperty("Color", m_Color, vbHighlight)
  1111.  Call PropBag.WriteProperty("Image", m_Picture, Nothing)
  1112.  Call PropBag.WriteProperty("Max", m_Max, 100)
  1113.  Call PropBag.WriteProperty("Min", m_Min, 0)
  1114.  Call PropBag.WriteProperty("Orientation", m_Orientation, ccOrientationHorizontal)
  1115.  Call PropBag.WriteProperty("Scrolling", m_Scrolling, ccScrollingStandard)
  1116.  Call PropBag.WriteProperty("ShowText", m_ShowText, False)
  1117.  Call PropBag.WriteProperty("Value", m_Value, 0)
  1118.  End Sub
  1119.  
  1120. '=======================================================================================================================
  1121. ' USERCONTROL READ PROPERTIES
  1122. '=======================================================================================================================
  1123.  
  1124. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  1125. m_Brush = PropBag.ReadProperty("BrushStyle", 4)
  1126. Color = PropBag.ReadProperty("Color", vbHighlight)
  1127. Set m_Picture = PropBag.ReadProperty("Image", Nothing)
  1128. Max = PropBag.ReadProperty("Max", 100)
  1129. Min = PropBag.ReadProperty("Min", 0)
  1130. Orientation = PropBag.ReadProperty("Orientation", ccOrientationHorizontal)
  1131. Scrolling = PropBag.ReadProperty("Scrolling", ccScrollingStandard)
  1132. ShowText = PropBag.ReadProperty("ShowText", False)
  1133. Value = PropBag.ReadProperty("Value", 0)
  1134. End Sub
  1135.  
  1136.  
  1137.  
  1138.