xp_progressbar.ctl

主要功能：接收和发送短信

      '                                 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
                  
      Else
      
      '=======================================================================================
      '                                 Calc Vertical ProgressBar
      '---------------------------------------------------------------------------------------
         fPercent = 1# - fPercent
         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 + 1
            TSR.Right = i + 1 + 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
 
 TR.Left = TR.Left - 3
 
 Let RTemp = TR
  
 
 DrawLine 2, 1, TR.Right - 2, 1, m_hDC, &HBEBEBE
 DrawLine 2, TR.Bottom - 2, TR.Right - 2, TR.Bottom - 2, m_hDC, &HEFEFEF
 DrawLine 1, 2, 1, TR.Bottom - 2, m_hDC, &HBEBEBE
 DrawLine 2, 2, 2, TR.Bottom - 2, m_hDC, &HEFEFEF
 DrawLine 2, 2, TR.Right - 2, 2, m_hDC, &HEFEFEF
 DrawLine TR.Right - 2, 2, TR.Right - 2, TR.Bottom - 2, m_hDC, &HEFEFEF
  
 DrawRectangle TR, GetLngColor(&H686868), m_hDC

 
 Call SetPixelV(m_hDC, 0, 0, GetLngColor(vbWhite))
 Call SetPixelV(m_hDC, 0, 1, GetLngColor(&HA6ABAC))
 Call SetPixelV(m_hDC, 0, 2, GetLngColor(&H7D7E7F))
 Call SetPixelV(m_hDC, 1, 0, GetLngColor(&HA7ABAC)) '//TOP RIGHT CORNER
 Call SetPixelV(m_hDC, 1, 1, GetLngColor(&H777777))
 Call SetPixelV(m_hDC, 2, 0, GetLngColor(&H7D7E7F))
 Call SetPixelV(m_hDC, 2, 2, GetLngColor(&HBEBEBE))
   
 Call SetPixelV(m_hDC, 0, TR.Bottom - 1, GetLngColor(vbWhite))
 Call SetPixelV(m_hDC, 1, TR.Bottom - 1, GetLngColor(&HA6ABAC))
 Call SetPixelV(m_hDC, 2, TR.Bottom - 1, GetLngColor(&H7D7E7F))
 Call SetPixelV(m_hDC, 0, TR.Bottom - 3, GetLngColor(&H7D7E7F)) '//BOTTOM RIGHT CORNER
 Call SetPixelV(m_hDC, 0, TR.Bottom - 2, GetLngColor(&HA7ABAC))
 Call SetPixelV(m_hDC, 1, TR.Bottom - 2, GetLngColor(&H777777))
 
 Call SetPixelV(m_hDC, TR.Right - 1, 0, GetLngColor(vbWhite))
 Call SetPixelV(m_hDC, TR.Right - 1, 1, GetLngColor(&HBEBEBE))
 Call SetPixelV(m_hDC, TR.Right - 1, 2, GetLngColor(&H7D7E7F)) '//TOP LEFT CORNER
 Call SetPixelV(m_hDC, TR.Right - 2, 2, GetLngColor(&HBEBEBE))
 Call SetPixelV(m_hDC, TR.Right - 2, 1, GetLngColor(&H686868))
 
 Call SetPixelV(m_hDC, TR.Right - 1, TR.Bottom - 1, GetLngColor(vbWhite))
 Call SetPixelV(m_hDC, TR.Right - 1, TR.Bottom - 2, GetLngColor(&HBEBEBE))
 Call SetPixelV(m_hDC, TR.Right - 1, TR.Bottom - 3, GetLngColor(&H7D7E7F))
 Call SetPixelV(m_hDC, TR.Right - 2, TR.Bottom - 2, GetLngColor(&H777777)) '//TOP RIGHT CORNER
 Call SetPixelV(m_hDC, TR.Right - 2, TR.Bottom - 1, GetLngColor(&HBEBEBE))
 Call SetPixelV(m_hDC, TR.Right - 3, TR.Bottom - 1, GetLngColor(&H7D7E7F))

 
End Sub


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

Private Sub PBarDraw()
Dim TempRect As RECT
Dim ITemp    As Long

If m_Orientation = 0 Then

    If TBR.Right <= 14 Then TBR.Right = 12
        
    TempRect.Left = 4
    TempRect.Right = IIf(TBR.Right + 4 > TR.Right, TBR.Right - 4, TBR.Right)
    TempRect.Top = 8
    TempRect.Bottom = TR.Bottom - 8

    '=======================================================================================
    '                                 Draw Horizontal ProgressBar
    '---------------------------------------------------------------------------------------
   
         
     If m_Scrolling = ccScrollingSearch Then
         GoSub HorizontalSearch
     Else
        DrawGradient ShiftColorXP(m_Color, 150), m_Color, 4, 3, TempRect.Right, 6, m_hDC
        DrawFillRectangle TempRect, m_Color, m_hDC
        DrawGradient m_Color, ShiftColorXP(m_Color, 150), 4, TempRect.Bottom - 2, TempRect.Right, 6, m_hDC
     End If
Else
    
    TempRect.Left = 9
    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 ShiftColorXP(m_Color, 150), m_Color, 4, TBR.Top, 4, TR.Bottom, m_hDC, True
        DrawFillRectangle TempRect, m_Color, m_hDC
        DrawGradient m_Color, ShiftColorXP(m_Color, 150), TR.Right - 8, TBR.Top, 4, TR.Bottom, m_hDC, True
    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)) - (45 * ((100 - m_Value) / 100))
          .Right = .Left + 10
          .Top = 8
          .Bottom = TR.Bottom - 8
          DrawGradient ShiftColorXP(m_Color, 220 - (40 * ITemp)), ShiftColorXP(m_Color, 200 - (40 * ITemp)), .Left, 3, 9, TR.Bottom - 2, m_hDC, True
        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 ShiftColorXP(m_Color, 220 - (40 * ITemp)), ShiftColorXP(m_Color, 200 - (40 * ITemp)), TR.Right - 2, .Top, 2, 9, m_hDC
        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 = "Searching.."
 Else
    ThisText = Round(m_Value) & " %"
 End If

 If (m_ShowText) Then
           
      Set iFnt = Font                             '//--New Font
      hFntOld = SelectObject(m_hDC, iFnt.hFont)   '//--Use the New Font
      SetBkMode m_hDC, 1                          '//--Transparent Text
     
      '//--Use the Alpha Text Color Look if Progress is MediaPlayer Style, else Normal (Gray)
      SetTextColor m_hDC, GetLngColor(IIf(m_Scrolling = ccScrollingMediaPlayer, &HC0C0C0, vbBlack))
      
      CalculateAlphaTextRect ThisText             '//--Calculate The Text Rectangle
           
      '//-- If ProgressBar is already over the Text don't draw the old text, yust draw the Alpha Text
           'It saves some memory
      
      If (TR.Right * (m_Value / 100)) <= AT.Right Or m_Scrolling <> ccScrollingMediaPlayer Then
            DrawText m_hDC, ThisText, Len(ThisText), AT, DT_SINGLELINE
      End If
            
      SelectObject m_hDC, hFntOld  'Delete the Used Font
   
      '//--Use the Alpha Text Look if Progress is MediaPlayer Style
      If m_Scrolling = ccScrollingMediaPlayer Then DrawAlphaText ThisText
              
 End If


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

'======================================================================
'ALPHA TEXT RECT FUNCTION
Private Sub CalculateAlphaTextRect(ByVal ThisText As String)

      '//--Calculates the Bounding Rects Of the Text using DT_CALCRECT
      DrawText m_hDC, ThisText, Len(ThisText), AT, DT_CALCRECT
      AT.Left = (TR.Right / 2) - ((AT.Right - AT.Left) / 2)
      AT.Top = (TR.Bottom / 2) - ((AT.Bottom - AT.Top) / 2)

End Sub
'======================================================================

'======================================================================
'ALPHA TEXT FUNCTION
Private Sub DrawAlphaText(ByVal ThisText As String)

 Set iFnt = Font                             '//--New Font
 hFntOld = SelectObject(m_hDC, iFnt.hFont)   '//--Use the New Font
 SetBkMode m_hDC, 1                          '//--Transparent Text
        
        
        '//-- This is When the Text is Drawn
            '//--Gives the Media Player Text Look (Changes Color When Progress is over the Text)
            
            If (TR.Right * (m_Value / 100)) >= AT.Left Then
                SetTextColor m_hDC, GetLngColor(ShiftColorXP(m_Color, 80))
                AT.Left = (TR.Right / 2) - ((AT.Right - AT.Left) / 2)
                AT.Right = (TR.Right * (m_Value / 100))
                DrawText m_hDC, ThisText, Len(ThisText), AT, DT_SINGLELINE
                SelectObject m_hDC, hFntOld
            End If

End Sub
'======================================================================

'======================================================================
'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
'======================================================================

'======================================================================
'DRAWS A BORDER RECTANGLE AREA OF AN SPECIFIED COLOR
Private Sub DrawRectangle(ByRef BRect As RECT, ByVal Color As Long, ByVal hdc As Long)

Dim hBrush As Long
    
    hBrush = CreateSolidBrush(Color)
    FrameRect hdc, BRect, hBrush
    DeleteObject hBrush

End Sub
'======================================================================

'======================================================================
'DRAWS A LINE WITH A DEFINED COLOR
Public Sub DrawLine( _
           ByVal X As Long, _
           ByVal Y As Long, _
           ByVal Width As Long, _
           ByVal Height As Long, _
           ByVal cHdc As Long, _
           ByVal Color As Long)

    Dim Pen1    As Long
    Dim Pen2    As Long
    Dim Outline As Long
    Dim POS     As POINTAPI

    Pen1 = CreatePen(0, 1, GetLngColor(Color))
    Pen2 = SelectObject(cHdc, Pen1)
    
        MoveToEx cHdc, X, Y, POS
        LineTo cHdc, Width, Height
          
    SelectObject cHdc, Pen2
    DeleteObject Pen2
    DeleteObject Pen1

End Sub
'======================================================================

'======================================================================
'BLENDS AN SPECIFIED COLOR TO GET XP COLOR LOOK
Private Function ShiftColorXP(ByVal MyColor As Long, ByVal Base As Long) As Long

    Dim R As Long, G As Long, B As Long, Delta As Long

    R = (MyColor And &HFF)
    G = ((MyColor \ &H100) Mod &H100)
    B = ((MyColor \ &H10000) Mod &H100)
    
    Delta = &HFF - Base

    B = Base + B * Delta \ &HFF
    G = Base + G * Delta \ &HFF
    R = Base + R * Delta \ &HFF

    If R > 255 Then R = 255
    If G > 255 Then G = 255
    If B > 255 Then B = 255