cstatusbarxp.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 = "cStatusBarXP"
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日
' **********************************************************************

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

Private m_hWnd As Long
Private m_Hdc As Long
Private RcItem As RECT


Public Sub DrawBar()
Dim i As Long, II As Long, StepXP1 As Long, XPFace As Long

GetClientRect m_hWnd, RcItem
CleanCornerArea RcItem


XPFace = ShiftColor(GetSysColor(15), -&H2, True)

   StepXP1 = 66 / 3
                    
   For i = 0 To 3
     DrawLine 0, Abs(i - 3), RcItem.Right, Abs(i - 3), m_Hdc, ShiftColor(XPFace, -StepXP1 * ((((i / 3) * 100) * 3) / 100), True)
   Next i

'XPFace = ShiftColor(GetSysColor(15), -&H2, True)

   StepXP1 = 25 / RcItem.Bottom
                    
   For i = 0 To 6
     DrawLine 0, RcItem.Bottom - 6 + i, RcItem.Right, RcItem.Bottom - 6 + i, m_Hdc, ShiftColor(XPFace, -StepXP1 * ((((i / 6) * 100) * RcItem.Bottom) / 100), True)
   Next i


For II = 3 To 1 Step -1
    For i = 2 To 3.3 * II Step 4
        CenterRectangle (RcItem.Right - 1) - i, (RcItem.Bottom - 3 - (Abs(II - 3) * 4)), vbWhite
        CenterRectangle (RcItem.Right - 2) - i, (RcItem.Bottom - 4 - (Abs(II - 3) * 4)), GetLngColor(&HA3B4B8)
    Next i
Next II

End Sub


Public Sub DrawPanel(ByVal X As Integer)
    DrawLine X, 5, X, RcItem.Bottom - 3, m_Hdc, GetLngColor(vbGrayText)
    DrawLine X + 1, 5, X + 1, RcItem.Bottom - 3, m_Hdc, GetLngColor(vbWhite)
End Sub

Private Sub CenterRectangle(ByVal X As Integer, ByVal Y As Integer, ByVal Color As Long)
Dim hBrush As Long
Dim hRect As RECT
    
    hRect.Top = Y
    hRect.Left = X
    hRect.Bottom = Y + 2
    hRect.Right = X + 2
    
    hBrush = CreateSolidBrush(Color)
    FillRect m_Hdc, hRect, hBrush
    DeleteObject hBrush

End Sub

Private Sub CleanCornerArea(ByRef hRect As RECT)
Dim hBrush As Long
    
    hRect.Left = hRect.Right - 15
    
      
    hBrush = CreateSolidBrush(GetSysColor(15))
    FillRect m_Hdc, hRect, hBrush
    DeleteObject hBrush

End Sub

Public Property Get hwnd() As Long
   hwnd = m_hWnd
End Property

Public Property Let hwnd(ByVal cHwnd As Long)
   m_hWnd = cHwnd
End Property

Public Property Get hdc() As Long
   hdc = m_Hdc
End Property
Public Property Let hdc(ByVal cHdc As Long)
   m_Hdc = cHdc
End Property