xppbr.ctl

VB 设计的排课管理系统,轻松解决排课难的问题！

VERSION 5.00
Begin VB.UserControl XP_ProgressBar 
   ClientHeight    =   990
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   3000
   ScaleHeight     =   990
   ScaleWidth      =   3000
End
Attribute VB_Name = "XP_ProgressBar"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'/****************************************************************************
'    我为人人,人人为我!
'    枕善居收集汉化整理
'    http://www.mndsoft.com/blog/
'    e-mail:[e-mail]
' ****************************************************************************/
'Mario Flores Cool Xp ProgressBar
'Emulating The Windows XP Progress Bar
'Open Source
'6 May 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 CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode 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 CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 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 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 GradientFillRect Lib "msimg32" Alias "GradientFill" (ByVal HDC As Long, pVertex As TRIVERTEX, ByVal dwNumVertex As Long, pMesh As GRADIENT_RECT, ByVal dwNumMesh As Long, ByVal dwMode 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
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long


Const RGN_DIFF        As Long = 4
Const DT_SINGLELINE   As Long = &H20


'=====================================================
'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 TRIVERTEX STRUCTURE
Private Type TRIVERTEX
    X         As Long
    Y         As Long
    Red       As Integer     'The TRIVERTEX structure contains color information and position information.
    Green     As Integer
    Blue      As Integer
    Alpha     As Integer
End Type
'=====================================================

'=====================================================
'THE GRADIENT_RECT STRUCTURE
Private Type GRADIENT_RECT
    UPPERLEFT  As Long       'The GRADIENT_RECT structure specifies the index of two vertices in the pVertex array.
    LOWERRIGHT As Long       'These two vertices form the upper-left and lower-right boundaries of a rectangle.
End Type
'=====================================================

'=====================================================
'THE RGB STRUCTURE
Private Type RGB
    R         As Integer
    G         As Integer     'Selects a red, green, blue (RGB) color based on the arguments supplied
    B         As Integer
End Type
'=====================================================


Public Enum cScrolling
    ccScrollingStandard = 0
    ccScrollingSmooth = 1
    ccScrollingSearch = 2
End Enum

Public Enum cOrientation
    ccOrientationHorizontal = 0
    ccOrientationVertical = 1
End Enum

Private m_Scrolling   As cScrolling
Private m_Orientation As cOrientation

'----------------------------------------------------
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_ShowInTask As Boolean
'----------------------------------------------------


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
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 lSegmentWidth   As Long
Private lSegmentSpacing As Long



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

Public Sub DrawProgressBar()

  GetClientRect m_hWnd, TR                '//--- Reference = Control Client Area
  
            
            DrawFillRectangle TR, vbWhite, m_hDC
            
            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)
            
            DrawTexto
  
            pDrawBorder                  '//--- Draw The XP Look Border

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

End Sub


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

Private Sub CalcBarSize()

   lSegmentWidth = 8   '/-- Windows Default
   lSegmentSpacing = 2 '/-- Windows Default
         
   LSet TBR = TR

   fPercent = (m_Value - m_Min) / (m_Max - m_Min)
   If fPercent > 1# Then fPercent = 1#              '/--  0 < Percent < 100
   If fPercent < 0# Then fPercent = 0#
   
      If m_Orientation = 0 Then
      
      '=======================================================================================
      '                                 Calc Horizontal ProgressBar
      '---------------------------------------------------------------------------------------
         TBR.Right = TR.Left + (TR.Right - TR.Left) * fPercent
         TBR.Right = TBR.Right - ((TBR.Right - TBR.Left) Mod (lSegmentWidth + lSegmentSpacing))
         If TBR.Right < TR.Left Then
            TBR.Right = TR.Left
         End If
         If TBR.Right < TR.Left Then TBR.Right = TR.Left
         
      Else
      
      '=======================================================================================
      '                                 Calc Vertical ProgressBar
      '---------------------------------------------------------------------------------------
         fPercent = 1# - fPercent - 0.02
         TBR.Top = TR.Top + (TR.Bottom - TR.Top) * fPercent
         TBR.Top = TBR.Top - ((TBR.Top - TBR.Bottom) Mod (lSegmentWidth + lSegmentSpacing))
         If TBR.Top > TR.Bottom Then TBR.Top = TR.Bottom
    
         
      
      End If

End Sub

'==========================================================
'/---Draw Division Bars
'==========================================================

Private Sub DrawDivisions()
 Dim i As Long
 Dim hBR As Long
  
  hBR = CreateSolidBrush(vbWhite)
  
      LSet TSR = TR
      
      If m_Orientation = 0 Then
      
      '=======================================================================================
      '                                 Draw Horizontal ProgressBar
      '---------------------------------------------------------------------------------------
         For i = TBR.Left + lSegmentWidth To TBR.Right Step lSegmentWidth + lSegmentSpacing
            TSR.Left = i + 2
            TSR.Right = i + 2 + lSegmentSpacing
            FillRect m_hDC, TSR, hBR
         Next i
      '---------------------------------------------------------------------------------------
      
      Else
      
      '=======================================================================================
      '                                  Draw Vertical ProgressBar
      '---------------------------------------------------------------------------------------
         For i = TBR.Bottom To TBR.Top + lSegmentWidth Step -(lSegmentWidth + lSegmentSpacing)
            TSR.Top = i - 2
            TSR.Bottom = i - 2 + lSegmentSpacing
            FillRect m_hDC, TSR, hBR
         Next i
       '---------------------------------------------------------------------------------------
      
      End If
      
      DeleteObject hBR
     
End Sub


'==========================================================
'/---Draw The ProgressXP Bar Border  ;)
'==========================================================

Private Sub pDrawBorder()
Dim RTemp As RECT
 
 Let RTemp = TR
  
 RTemp.Left = TR.Left + 1: RTemp.Top = TR.Top + 1
 DrawRectangle RTemp, GetLngColor(&HBEBEBE), m_hDC
 RTemp.Left = TR.Left + 1: RTemp.Top = TR.Top + 2: RTemp.Right = TR.Right - 1: RTemp.Bottom = TR.Bottom - 1
 DrawRectangle RTemp, GetLngColor(&HEFEFEF), m_hDC
 DrawRectangle TR, GetLngColor(&H686868), m_hDC

 Call SetPixelV(m_hDC, 1, 1, GetLngColor(&H686868))
 Call SetPixelV(m_hDC, TR.Right - 2, 1, GetLngColor(&H686868))
 Call SetPixelV(m_hDC, 1, TR.Bottom - 2, GetLngColor(&H686868))
 Call SetPixelV(m_hDC, TR.Right - 2, TR.Bottom - 2, GetLngColor(&H686868))  '//--Clean Up Corners

End Sub


'==========================================================
'/---Draw The ProgressXP Bar ;)
'==========================================================

Private Sub PBarDraw()
Dim TempRect As RECT
Dim ITemp    As Long
 
If m_Orientation = 0 Then

    TempRect.Left = TBR.Right
    TempRect.Right = 2
    TempRect.Top = 8
    TempRect.Bottom = TR.Bottom - 6


    '=======================================================================================
    '                                 Draw Horizontal ProgressBar
    '---------------------------------------------------------------------------------------
     
     If m_Scrolling = ccScrollingSearch Then
         GoSub HorizontalSearch
     Else
         DrawGradient m_hDC, 2, 3, TBR.Right - 2, 6, GetRGBColors(ShiftColorXP(m_Color, 150)), GetRGBColors(m_Color)
         DrawFillRectangle TempRect, m_Color, m_hDC
         DrawGradient m_hDC, 2, TempRect.Bottom - 2, TBR.Right - 2, 6, GetRGBColors(m_Color), GetRGBColors(ShiftColorXP(m_Color, 150))
     End If
     
Else
    
    TempRect.Left = 7
    TempRect.Right = TR.Right - 8
    TempRect.Top = TBR.Top
    TempRect.Bottom = TR.Bottom
    
    '=======================================================================================
    '                                 Draw Vertical ProgressBar
    '---------------------------------------------------------------------------------------
   
    If m_Scrolling = ccScrollingSearch Then
         GoSub VerticalSearch
    Else
         DrawGradient m_hDC, 2, TBR.Top, 6, TR.Bottom, GetRGBColors(ShiftColorXP(m_Color, 150)), GetRGBColors(m_Color), 0
         DrawFillRectangle TempRect, m_Color, m_hDC
         DrawGradient m_hDC, TR.Right - 8, TBR.Top, 6, TR.Bottom, GetRGBColors(m_Color), GetRGBColors(ShiftColorXP(m_Color, 150)), 0
    End If
   
    '--------------------   <-------- Gradient Color From (- to +)
    '||||||||||||||||||||   <-------- Fill Color
    '--------------------   <-------- Gradient Color From (+ to -)

End If

Exit Sub

HorizontalSearch:
    
    
    For ITemp = 0 To 2
    
        With TempRect
          .Left = TBR.Right + ((lSegmentSpacing + 10) * ITemp)
          .Right = .Left + 10
          .Top = 8
          .Bottom = TR.Bottom - 6
          DrawGradient m_hDC, .Left, 3, 10, 6, GetRGBColors(ShiftColorXP(m_Color, 220 - (40 * ITemp))), GetRGBColors(ShiftColorXP(m_Color, 200 - (40 * ITemp)))
          DrawFillRectangle TempRect, ShiftColorXP(m_Color, 200 - (40 * ITemp)), m_hDC
          DrawGradient m_hDC, .Left, .Bottom - 2, 10, 6, GetRGBColors(ShiftColorXP(m_Color, 200 - (40 * ITemp))), GetRGBColors(ShiftColorXP(m_Color, 220 - (40 * ITemp)))
        End With
        
    Next ITemp

Return

VerticalSearch:
    
     
    For ITemp = 0 To 2
    
        With TempRect
          .Left = 8
          .Right = TR.Right - 8
          .Top = TBR.Top + ((lSegmentSpacing + 10) * ITemp)
          .Bottom = .Top + 10
          DrawGradient m_hDC, 2, .Top, 6, 10, GetRGBColors(ShiftColorXP(m_Color, 220 - (40 * ITemp))), GetRGBColors(ShiftColorXP(m_Color, 200 - (40 * ITemp)))
          DrawFillRectangle TempRect, ShiftColorXP(m_Color, 200 - (40 * ITemp)), m_hDC
          DrawGradient m_hDC, .Right, .Top, 6, 10, GetRGBColors(ShiftColorXP(m_Color, 200 - (40 * ITemp))), GetRGBColors(ShiftColorXP(m_Color, 220 - (40 * ITemp)))
        End With
        
    Next ITemp

Return



End Sub

'======================================================================
'DRAWS THE PERCENT TEXT ON PROGRESS BAR
Private Function DrawTexto()
Dim ThisText As String

 If m_Scrolling = ccScrollingSearch Then
    ThisText = "正在查找.."
 Else
    ThisText = (m_Max * m_Value) / 100 & " %"
 End If
 
  If (m_ShowText) Then
      Set iFnt = Font
      hFntOld = SelectObject(m_hDC, iFnt.hFont)
      SetBkMode m_hDC, 1
      SetTextColor m_hDC, vbBlack
      DrawText m_hDC, ThisText, -1, TR, DT_SINGLELINE Or 1 Or 4
      SelectObject m_hDC, hFntOld
   End If

End Function
'======================================================================

'======================================================================
'CONVERTION FUNCTION
Private Function GetLngColor(Color As Long) As Long
    
    If (Color And &H80000000) Then
        GetLngColor = GetSysColor(Color And &H7FFFFFFF)
    Else
        GetLngColor = Color
    End If
End Function
'======================================================================

'======================================================================
'CONVERTION FUNCTION