progressbarstylexp.ctl

一款比较专业

VERSION 5.00
Begin VB.UserControl XP_ProgressBar 
   ClientHeight    =   390
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   3000
   ScaleHeight     =   390
   ScaleWidth      =   3000
   ToolboxBitmap   =   "ProgressBarStyleXP.ctx":0000
End
Attribute VB_Name = "XP_ProgressBar"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'-----------------------------------------------------------
'Mario Flores Cool Xp ProgressBar
'Emulating The Windows XP Progress Bar
'Open Source
'6 May 2004
'-----------------------------------------------------------
'Mario Flores Cool Xp ProgressBar 2.0
'MultiStyle ProgressBar
'Open Source
'September 12 2004
'-----------------------------------------------------------

'CD JUAREZ CHIHUAHUA MEXICO

Option Explicit

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
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
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
Private Declare Function CreateHatchBrush Lib "gdi32" (ByVal fnStyle As Integer, ByVal COLORREF As Long) As Long
Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
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
Private Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function FrameRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long
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
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long


'=====================================================
'TEXT FORMAT CONST
Const DT_SINGLELINE   As Long = &H20
Const DT_CALCRECT     As Long = &H400
'=====================================================

'=====================================================
'BORDER FIELD CONST
Const BF_BOTTOM = &H8
Const BF_LEFT = &H1
Const BF_RIGHT = &H4
Const BF_TOP = &H2
Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)
'=====================================================

'=====================================================
'THE POINTAPI STRUCTURE
Private Type POINTAPI
    x As Long                       ' The POINTAPI structure defines the x- and y-coordinates of a point.
    y As Long
End Type
'=====================================================

'=====================================================
'THE RECT STRUCTURE
Private Type RECT
    Left      As Long     'The RECT structure defines the coordinates of the upper-left and lower-right corners of a rectangle
    Top       As Long
    Right     As Long
    Bottom    As Long
End Type
'=====================================================

'=====================================================
'THE BRUSHSTYLE ENUM
Public Enum BrushStyle
 HS_HORIZONTAL = 0
 HS_VERTICAL = 1
 HS_FDIAGONAL = 2
 HS_BDIAGONAL = 3
 HS_CROSS = 4
 HS_DIAGCROSS = 5
 HS_SOLID = 6
End Enum
'=====================================================

'=====================================================
'THE COOL XP PROGRESSBAR 2.0 STYLES
Public Enum cScrolling
    ccScrollingStandard = 0
    ccScrollingSmooth = 1
    ccScrollingSearch = 2
    ccScrollingOfficeXP = 3
    ccScrollingPastel = 4
    ccScrollingJavT = 5
    ccScrollingMediaPlayer = 6
    ccScrollingCustomBrush = 7
    ccScrollingPicture = 8
    ccScrollingMetallic = 9
End Enum
'=====================================================

'=====================================================
'THE ORIENTATION ENUM
Public Enum cOrientation
    ccOrientationHorizontal = 0
    ccOrientationVertical = 1
End Enum
'=====================================================

'----------------------------------------------------
Private m_Color       As OLE_COLOR
Private m_hDC         As Long
Private m_hWnd        As Long        'PROPERTIES VARIABLES
Private m_Max         As Long
Private m_Min         As Long
Private m_Value       As Long
Private m_ShowText    As Boolean
Private m_Scrolling   As cScrolling
Private m_Orientation As cOrientation
Private m_Brush       As BrushStyle
Private m_Picture     As StdPicture
'----------------------------------------------------

'----------------------------------------------------
Private m_MemDC    As Boolean
Private m_ThDC     As Long
Private m_hBmp     As Long
Private m_hBmpOld  As Long
Private iFnt       As IFont
Private m_fnt      As IFont          'VARIABLES USED IN PROCESS
Private hFntOld    As Long
Private m_lWidth   As Long
Private m_lHeight  As Long
Private fPercent   As Double
Private TR         As RECT
Private TBR        As RECT
Private TSR        As RECT
Private AT         As RECT
Private lSegmentWidth   As Long
Private lSegmentSpacing As Long
'----------------------------------------------------



'==========================================================
'/---Draw ALL ProgressXP Bar  !!!!PUBLIC CALL!!!
'==========================================================

Public Sub DrawProgressBar()

            
            If m_Value > 100 Then m_Value = 100
            
            
            GetClientRect m_hWnd, TR               '//--- Reference = Control Client Area
              
            DrawFillRectangle TR, IIf(m_Scrolling = ccScrollingMediaPlayer, &H0, vbWhite), m_hDC '//--- Draw BackGround
            
            '//-- Draw ProgressBar Style
            
            '==========================================================
            '/---Draw METALLIC XP STYLE
            '==========================================================

            If m_Scrolling = ccScrollingMetallic Then
                   
                 DrawMetalProgressbar
                    

            '==========================================================
            '/---Draw OFFICE XP STYLE
            '==========================================================

            ElseIf m_Scrolling = ccScrollingOfficeXP Then
                   
                 DrawOfficeXPProgressbar
                    
            '==========================================================
            '/---Draw PASTEL XP STYLE
            '==========================================================

            ElseIf m_Scrolling = ccScrollingPastel Then
                 
                 DrawPastelProgressbar
                 
            '==========================================================
            '/---Draw JAVT XP STYLE
            '==========================================================

            ElseIf m_Scrolling = ccScrollingJavT Then
                 
                 DrawJavTProgressbar
             
            '==========================================================
            '/---Draw MEDIA PLAYER XP STYLE
            '==========================================================
 
            ElseIf m_Scrolling = ccScrollingMediaPlayer Then
            
                 DrawMediaProgressbar
            
            '==========================================================
            '/---Draw CUSTOM BRUSH XP WASH COLOR STYLE
            '==========================================================

            ElseIf m_Scrolling = ccScrollingCustomBrush Then
            
                 DrawCustomBrushProgressbar
             
            '==========================================================
            '/---Draw PICTURE STYLE
            '==========================================================

            ElseIf m_Scrolling = ccScrollingPicture Then
            
                 DrawPictureProgressbar
       
            Else
            
            '==========================================================
            '/---Draw WINDOWS XP STYLE
            '==========================================================

            
                CalcBarSize                            '//--- Calculate Progress and Percent Values
  
                PBarDraw                               '//--- Draw Scolling Bar (Inside Bar)
                  
                If m_Scrolling = 0 Then DrawDivisions  '//--- Draw SegmentSpacing (This Will Generate the Blocks Effect)
  
                pDrawBorder                            '//--- Draw The XP Look Border
            
            End If
            
            '==========================================================
            
            DrawTexto                                  '//--- Draw The Percent Text
            
            '==========================================================
            '/---Use the AntiFlicker DC
            '==========================================================

            If m_MemDC Then
                With UserControl
                    pDraw .hdc, 0, 0, .ScaleWidth, .ScaleHeight, .ScaleLeft, .ScaleTop
                End With
            End If

End Sub

'==========================================================
'/---OFFICE XP STYLE
'==========================================================
Private Sub DrawOfficeXPProgressbar()
        
        DrawRectangle TR, ShiftColorXP(m_Color, 100), m_hDC
             
        With TBR
          .Left = 1
          .Top = 1
          .Bottom = TR.Bottom - 1
          .Right = TR.Left + (TR.Right - TR.Left) * (m_Value / 100)
        End With
             
        DrawFillRectangle TBR, ShiftColorXP(m_Color, 180), m_hDC
 
End Sub
'==========================================================
'/---JAVT XP STYLE
'==========================================================
Private Sub DrawJavTProgressbar()

       DrawRectangle TR, ShiftColorXP(m_Color, 10), m_hDC
       TBR.Right = TR.Left + (TR.Right - TR.Left) * (m_Value / 101)
       DrawGradient m_Color, ShiftColorXP(m_Color, 100), 2, 2, TR.Right - 2, TR.Bottom - 5, m_hDC ', True
       DrawGradient ShiftColorXP(m_Color, 250), m_Color, 3, 3, TBR.Right, TR.Bottom - 6, m_hDC  ', True
       DrawLine TBR.Right, 2, TBR.Right, TR.Bottom - 2, m_hDC, ShiftColorXP(m_Color, 25)
 
End Sub
'==========================================================
'/---PICTURE STYLE
'==========================================================
Private Sub DrawPictureProgressbar()

Dim Brush      As Long
Dim origBrush  As Long

       DrawEdge m_hDC, TR, 2, BF_RECT                       '//--- Draw ProgressBar Border
       
       If Nothing Is m_Picture Then Exit Sub                '//--- In Case No Picture is Choosen
              
       Brush = CreatePatternBrush(m_Picture.Handle)         '//-- Use Pattern Picture Draw
       origBrush = SelectObject(m_hDC, Brush)
       TBR.Right = TR.Left + (TR.Right - TR.Left) * (m_Value / 101)
       
       PatBlt m_hDC, 2, 2, TBR.Right, TR.Bottom - 4, vbPatCopy
         
       SelectObject m_hDC, origBrush
       DeleteObject Brush
       
End Sub
'==========================================================
'/---PASTEL XP STYLE
'==========================================================
Private Sub DrawPastelProgressbar()
        DrawEdge m_hDC, TR, 6, BF_RECT
        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
End Sub

'==========================================================
'/---METALLIC XP STYLE
'==========================================================
Private Sub DrawMetalProgressbar()
         TBR.Right = TR.Left + (TR.Right - TR.Left - 4) * (m_Value / 100)
         
         DrawGradient vbWhite, &HC0C0C0, 2, 2, TR.Right - 3, (TR.Bottom - 3) / 2, m_hDC
         DrawGradient BlendColor(&HC0C0C0, &H0, 255), &HC0C0C0, 2, (TR.Bottom - 3) / 2, TR.Right - 3, (TR.Bottom - 3) / 2, m_hDC
         DrawGradient ShiftColorXP(m_Color, 150), BlendColor(m_Color, &H0, 180), 2, 2, TBR.Right, (TR.Bottom - 3) / 2, m_hDC
         DrawGradient BlendColor(m_Color, &H0, 190), m_Color, 2, (TR.Bottom - 3) / 2, TBR.Right, (TR.Bottom - 3) / 2, m_hDC
        
         TR.Left = TR.Left + 3
         pDrawBorder
    
        
End Sub
'==========================================================
'/---CUSTOM BRUSH XP STYLE
'==========================================================
Private Sub DrawCustomBrushProgressbar()
        
   Dim hBrush As Long
    
   DrawEdge m_hDC, TR, 9, BF_RECT
       
   With TBR
      .Left = 2
      .Top = 2
      .Bottom = TR.Bottom - 2
      .Right = TR.Left + (TR.Right - TR.Left) * (m_Value / 101)
   End With

   hBrush = CreateHatchBrush(m_Brush, GetLngColor(Color))
   SetBkColor m_hDC, ShiftColorXP(m_Color, 140)
   FillRect m_hDC, TBR, hBrush
   DeleteObject hBrush
                
End Sub
'==========================================================
'/---MEDIA PROGRESS XP STYLE
'==========================================================
Private Sub DrawMediaProgressbar()
        
        DrawRectangle TR, BlendColor(m_Color, &H0, 200), m_hDC
        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

End Sub

'==========================================================
'/---Calculate Division Bars & Percent Values
'==========================================================