csliderxp.cls

进销存管理系统

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cSliderXP"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

' **********************************************************************
'  描  述：巨牛的XP风格控件引擎，非常厉害
'  Play78.com : 网站导航，源码之家，绝对开源
'  海阔天空收集整理
'  主站地址：http://www.play78.com/
'  源码下载地址：http://www.play78.com/blog
'  图片下在地址：http://www.play78.com/pic
'  QQ：13355575
'  e-mail:[e-mail]
'  编写日期：2005年08月24日
' **********************************************************************

'--------------------------------------------------------------------------------------------------'
'--------------------------------------------------------------------------------------------------'
'                                                                                                  '
'                                            cSliderXP.cls                                         '
'                                            Version 1.00                                          '
'                                                                                                  '
'                           AUTHOR:    MARIO ALBERTO FLORES GONZALEZ                               '
'                                                                                                  '
'                                     CD.JUAREZ CHIHUAHUA MEXICO                                   '
'                                                                                                  '
'                                    [e-mail]                                  '
'                                                                                                  '
'--------------------------------------------------------------------------------------------------'
'--------------------------------------------------------------------------------------------------'


' !!!!! This Version of cSliderXP Doesn't Fully Supports Smaller Sliders...The have some Drawing Problems :(



Option Explicit
Private m_hWnd As Long
Private m_Hdc As Long
Private m_Min As Integer
Private m_Max As Integer
Private m_Val As Integer           '//--- Control Value
Private m_Ort As Byte              '//--- Control Orientation
Private m_Tsl As Byte              '//--- Control TickStyle
Private m_Stt As ControlState      '//--- Control State
Private AreaRgn As RECT
Private TrackRect As RECT


Private Enum cDirection
    Left_TO_Right = 0
    Right_TO_Left = 1
    Top_TO_Bottom = 2
    Bottom_TO_Top = 3
End Enum

Private AB As Long
Private AT As Long   '//---Area Regions ..
Private AL As Long
Private AR As Long

Private TT As Long   '//---Area Regions ..
Private TL As Long
Private TR As Long


'//-- Border Colors
Dim Col1 As Long, Col2 As Long, Col3 As Long, Col4 As Long, Col5 As Long, Col6 As Long
'//-- Inner Colors
Dim ICol1 As Long, ICol2 As Long, ICol3 As Long, ICol4 As Long, ICol5 As Long, ICol6 As Long, ICol7 As Long

'====================================================================================================
'====================================================================================================

'                            DRAW A STYLED XP SLIDER ...NOT EXACTLY BUT CLOSE .. ;)

'====================================================================================================
'====================================================================================================

Public Sub DrawSlider()
    
    SendMessageLong m_hWnd, TBM_GETCHANNELRECT, 0, TrackRect
    SendMessageLong m_hWnd, TBM_GETTHUMBRECT, 0, AreaRgn
    
    AB = AreaRgn.Bottom: AT = AreaRgn.Top: AR = AreaRgn.Right: AL = AreaRgn.Left
    TT = TrackRect.Top: TR = TrackRect.Right: TL = TrackRect.Left
    
    Call DrawSlideLine
    Call DrawSliderMod
    Call DrawCenter
    Call SelectSliderPos
   
   
End Sub

'====================================================================================================
'====================================================================================================

'                                SELECT THE SLIDER ROTATION AND STYLE

'====================================================================================================
'====================================================================================================

Private Sub SelectSliderPos()

Select Case m_Tsl

      
      Case 1
                If m_Ort = 0 Then
                    DrawSliderBody (Bottom_TO_Top)
                Else
                    DrawSliderBody (Right_TO_Left)
                End If
                
      Case 0, 3
                If m_Ort = 0 Then
                    DrawSliderBody (Top_TO_Bottom)
                Else
                    DrawSliderBody (Left_TO_Right)
                End If
      Case 2
                Call DrawSqR
      
      Case Else
           'Nothing
   
   End Select

End Sub

'====================================================================================================
'====================================================================================================

'                                DRAW THE XP STYLED CHANNEL TRACK ....

'            MOST OF THE LINES ARE ""SetPixelV Function"" TO DRAW CORNERS OF THE TRACKS

'====================================================================================================
'====================================================================================================

Private Sub DrawSlideLine()
 
    
    If m_Ort = 0 Then
        
        DrawLine TL, TT, TR, TT, m_Hdc, GetLngColor(&H999C9D)
        DrawLine TL, TT + 1, TR, TT + 1, m_Hdc, GetLngColor(&HE9F1F2)
        DrawLine TL, TT + 2, TR, TT + 2, m_Hdc, GetLngColor(&HE0EDF0)
        DrawLine TL, TT + 3, TR, TT + 3, m_Hdc, GetLngColor(vbWhite)
        
        Call SetPixelV(m_Hdc, TL, TT, GetLngColor(&HD5DCDD))
        Call SetPixelV(m_Hdc, TL + 1, TT, GetLngColor(&HBCC0C0))
        Call SetPixelV(m_Hdc, TL, TT + 1, GetLngColor(&HADB1B2))
        Call SetPixelV(m_Hdc, TL + 1, TT + 1, GetLngColor(&HC7CDCE))
        Call SetPixelV(m_Hdc, TL, TT + 2, GetLngColor(&H999C9C))
        Call SetPixelV(m_Hdc, TL + 1, TT + 2, GetLngColor(&HD5D6D6))
        Call SetPixelV(m_Hdc, TL, TT + 3, GetLngColor(&HCFD3D4))
        Call SetPixelV(m_Hdc, TL + 1, TT + 3, GetLngColor(&HBDC2C3))
         
    Else
    
         'TBM_GETCHANNELRECT Returns Horizontal Rects'..Yust Invert them ;)   TOP=LEFT ,LEFT=TOP,.. ETC...
         DrawLine TT, TL, TT, TR, m_Hdc, GetLngColor(&H999C9D)
         DrawLine TT + 1, TL, TT + 1, TR, m_Hdc, GetLngColor(&HE9F1F2)
         DrawLine TT + 2, TL, TT + 2, TR, m_Hdc, GetLngColor(&HE0EDF0)
         DrawLine TT + 3, TL, TT + 3, TR, m_Hdc, GetLngColor(vbWhite)

         Call SetPixelV(m_Hdc, TT, TL, GetLngColor(&HD5DCDD))
         Call SetPixelV(m_Hdc, TT + 1, TL, GetLngColor(&HBCC0C0))
         Call SetPixelV(m_Hdc, TT, TL + 1, GetLngColor(&HADB1B2))
         Call SetPixelV(m_Hdc, TT + 1, TL + 1, GetLngColor(&HC7CDCE))
         Call SetPixelV(m_Hdc, TT, TR - 1, GetLngColor(&HD5DCDD))
         Call SetPixelV(m_Hdc, TT + 1, TR - 1, GetLngColor(&HBCC0C0))
         Call SetPixelV(m_Hdc, TT, TR - 2, GetLngColor(&HADB1B2))
         Call SetPixelV(m_Hdc, TT + 1, TR - 2, GetLngColor(&HC7CDCE))
       
    End If

        DrawTicks
  
End Sub

'====================================================================================================
'====================================================================================================

'                                   DRAW THE SLIDER STATE MODE ....

'                          (SELECT COLORS DEPENDING ON THE CURRENT STATE OF CONTROL)

'====================================================================================================
'====================================================================================================


Private Sub DrawSliderMod()


    Select Case m_Stt

           Case C_Normal
            
                GoSub DefaultCornerColors
                ICol1 = &H76AC63: ICol2 = &H1FB621: ICol3 = &H18911A: ICol4 = &H59824B: ICol5 = &H64CE66: ICol6 = &H46C447: ICol7 = &H23B925
             
           Case C_Disabled
           
                GoSub DisabledCornerColors
                ICol1 = &HBAC7CA: ICol2 = vbWhite: ICol3 = &HD7E0E1: ICol4 = &HA9B6B9: ICol5 = &HC6D0D2: ICol6 = &HC1CCCE: ICol7 = vbWhite
          
           Case C_Over, C_Focus
            
                GoSub DefaultCornerColors
                ICol1 = &H7EABBA: ICol2 = &H35B4F9: ICol3 = &H2A8EC4: ICol4 = &H60828E: ICol5 = &H74CBFB: ICol6 = &H55C0FA: ICol7 = &H39B5F9
     
           Case C_Down
            
                GoSub DefaultCornerColors
                ICol1 = &H709E63: ICol2 = &H129522: ICol3 = &HE751B: ICol4 = &H55784B: ICol5 = &H5BB666: ICol6 = &H3BA748: ICol7 = &H129522
     
           
           Case Else
           'Nothing
    
    End Select


Exit Sub


DefaultCornerColors:
Col1 = &HCDC4B5: Col2 = &HB2A691: Col3 = &H928877: Col4 = &HC0C3C3: Col5 = &HD9DCDC: Col6 = &H887E6E
Return
DisabledCornerColors:
Col1 = &HC6D4D6: Col2 = &HBAC9CC: Col3 = &HADBCBF: Col4 = &HD9E2E3: Col5 = &HE2EBEC: Col6 = &HA9B8BB
Return

End Sub

'====================================================================================================
'====================================================================================================

'                                   DRAW THE SLIDER BODY ....

'====================================================================================================
'====================================================================================================

Private Sub DrawSliderBody(ByRef Dtn As cDirection)
Dim i As Integer

Dim PMX As Long          '//--Prox VAL
Dim FBM As Long          '//--FixedBottom
Dim DIF As Integer       '//--FLAG TO ROTATE X ANGLE THE SLIDER


Select Case Dtn

        
        
     Case Top_TO_Bottom, Bottom_TO_Top
 
        '=========================================================================================================
        'DRAW THE SLIDER.. 'DIF' IS THE FLAG TO ROTATE THE SLIDER UPSIDE DOWN OR UP DEPENDING ON THE TSL
          
        DIF = IIf(Dtn = Top_TO_Bottom, 0, 2)
        FBM = AB - 1 - ((AR - AL) / 2)