xp_statusbar.ctl

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

                        DrawALine .hdc, .ScaleWidth - i, .ScaleHeight, .ScaleWidth, .ScaleHeight - i, lColorHighLite
                    Next i
                    
                    For i = 2 To 14
                        If i = 5 Or i = 10 Then
                            i = i + 2
                        End If
                        DrawALine .hdc, .ScaleWidth - i, .ScaleHeight, .ScaleWidth, .ScaleHeight - i, lColorShaddow
                    Next i
                                                      
            
            Case [Simple]
                    ' In progress ... ;)
                    For i = 2 To 14
                        DrawALine .hdc, .ScaleWidth - i, .ScaleHeight, .ScaleWidth, .ScaleHeight - i, oForeColor
                    Next i
            
            
            Case [XP Diagonal Left], [XP Diagonal Right]
                    For i = 3 To 13
                        lColorGrad = 140 + (6 * i)
                        DrawALine .hdc, .ScaleWidth - i, .ScaleHeight - 3, .ScaleWidth - 1, .ScaleHeight - i, _
                                RGB(lColorGrad, lColorGrad, lColorGrad)
                    Next i

        End Select
        
        UserControl.Refresh
    End With

End Sub


Private Sub ClearPanel(lPanelIndex As Long)
    ' Removes the text from a panel without a complete redraw of the whole control (speed! ...)
    ' This is done by copying the pixel colume left to the text to the whole area using
    ' the StretchBlt() API function. When a tile background picture is set
    ' setting a PanelCaption() uses a complete (slow!) redraw.

    Dim lSrcX   As Long
    Dim lWidth  As Long
    Dim lHeight As Long

    If lPanelIndex < 1 Or lPanelIndex > m_PanelCount Then
        
        Exit Sub
    End If
        
     With m_Panels(lPanelIndex)
         lSrcX = .ContentsLeft
         lWidth = .ContentsRight - lSrcX
         lHeight = .ClientHeight
         If m_Apperance = [XP Diagonal Left] Or m_Apperance = [XP Diagonal Right] Then
            lSrcX = lSrcX + (lHeight \ 2)
         End If
     End With
     
     With UserControl
        StretchBlt .hdc, lSrcX + 1, 0, lWidth + 3, lHeight, .hdc, lSrcX + 1, 0, 1, lHeight, ScrCopy
        .Refresh
    End With
       
End Sub


Private Sub TileBltBckGrnd(ByVal hBmpSrc As Long)
    ' Used for tileing a background pic on the statusbar
    
    Dim bmp      As BITMAP  ' Header info for passed bitmap handle
    Dim hDCSrc   As Long    ' Device context for source
    Dim hBmpTmp  As Long    ' Holding space for temporary bitmap
    Dim lRows    As Long    ' Number of lRows in destination
    Dim lCols    As Long    ' Number of columns in destination
    Dim dX       As Long    ' CurrentX in destination
    Dim dY       As Long    ' CurrentY in destination
    Dim i        As Long
    Dim k        As Long
    Dim lWidth   As Long
    Dim lHeight  As Long
    Dim lhDC     As Long
    
    
    With UserControl
    
        ' Get destinaton device context.
        lhDC = .hdc
        
        ' Create source DC and select passed bitmap into it.
        hDCSrc = CreateCompatibleDC(lhDC)
        hBmpTmp = SelectObject(hDCSrc, hBmpSrc)
        
        ' Get size information about passed bitmap, and
        ' calc number of lRows and columns to paint.
        GetObj hBmpSrc, Len(bmp), bmp
        lWidth = bmp.bmWidth
        lHeight = bmp.bmHeight
        lRows = .ScaleWidth \ lWidth
        lCols = .ScaleHeight \ lHeight
        If lHeight > .ScaleHeight Then          ' Tile bitmap (src) higher than statusbar ?
            lHeight = .ScaleHeight              ' Crop bottom part !
        End If
    End With
   
    ' Tile pic onto usercontrol.
    For i = 0 To lRows
        For k = 0 To lCols
            BitBlt lhDC, dX, dY, lWidth, lHeight, hDCSrc, 0, 0, ScrCopy
            dY = dY + lHeight
        Next k
        dY = 0
        dX = dX + lWidth
    Next i
    
    ' ... and clean up !
    SelectObject hDCSrc, hBmpTmp
    DeleteDC hDCSrc
   
End Sub


Private Sub SizeByGripper(ByVal iHwnd As Long)
  
  ReleaseCapture
  SendMessage iHwnd, WM_NCLBUTTONDOWN, HTBOTTOMRIGHT, 0

End Sub

Private Sub DrawVertGradient(lFromColor As Long, _
                                lToColor As Long, _
                                start_x As Long, _
                                wid As Long, _
                                start_y As Long, _
                                end_y As Long)
                                
    ' Fast draw gradient vertical lines
    
    Dim hgt             As Single
    Dim R               As Single
    Dim G               As Single
    Dim B               As Single
    Dim dR              As Single
    Dim dg              As Single
    Dim db              As Single
    Dim Y               As Single
    Dim end_r           As Single
    Dim end_g           As Single
    Dim end_b           As Single
    Dim lRight          As Long
    Dim bArray(1 To 4)  As Byte
    Dim pt              As API_POINT
    Dim dstDC           As Long
    
    Dim lOld            As Long
    
    lFromColor = OleToColor(lFromColor)
    CopyMemory bArray(1), lFromColor, 4
    R = bArray(1)
    G = bArray(2)
    B = bArray(3)
    
    lToColor = OleToColor(lToColor)
    CopyMemory bArray(1), lToColor, 4
    end_r = bArray(1)
    end_g = bArray(2)
    end_b = bArray(3)

    hgt = end_y - start_y
    If hgt = 0 Then
        hgt = 1
    End If
    
    dR = (end_r - R) / hgt
    dg = (end_g - G) / hgt
    db = (end_b - B) / hgt
    
    lRight = start_x + wid
    
    dstDC = UserControl.hdc
    
    With UserControl
        lOld = .ForeColor
        For Y = start_y To end_y
            .ForeColor = RGB(R, G, B)
            
            MoveToEx dstDC, start_x, Y, pt
            LineTo dstDC, lRight, Y
            
            R = R + dR
            G = G + dg
            B = B + db
    
        Next Y
        .ForeColor = lOld
    End With
    
End Sub


Private Function OleToColor(ByVal OleColor As OLE_COLOR) As Long

    If (OleColor And &H80000000) Then
        OleToColor = GetSysColor(OleColor And &HFF&)
    Else
        OleToColor = OleColor
    End If
        
End Function


Private Sub PaintTransparentPicture(ByVal hDCDest As Long, _
                                    ByVal picSource As Picture, _
                                    ByVal xDest As Long, _
                                    ByVal yDest As Long, _
                                    ByVal Width As Long, _
                                    ByVal Height As Long, _
                                    Optional ByVal xSrc As Long = 0, _
                                    Optional ByVal ySrc As Long = 0, _
                                    Optional ByVal clrMask As OLE_COLOR = 16711935, _
                                    Optional ByVal hPal As Long = 0)
                                    

    ' Purpose:  Draws a transparent bitmap to a DC.  The pixels of the passed
    '           bitmap that match the passed mask color will not be painted
    '           to the destination DC
    ' In:
    '   [hdcDest]
    '           Device context to paint the picture on
    '   [xDest]
    '           X coordinate of the upper left corner of the area that the
    '           picture is to be painted on. (in pixels)
    '   [yDest]
    '           Y coordinate of the upper left corner of the area that the
    '           picture is to be painted on. (in pixels)
    '   [Width]
    '           Width of picture area to paint in pixels.  Note: If this value
    '           is outrageous (i.e.: you passed a forms ScaleWidth in twips
    '           instead of the pictures' width in pixels), this procedure will
    '           attempt to create bitmaps that require outrageous
    '           amounts of memory.
    '   [Height]
    '           Height of picture area to paint in pixels.  Note: If this
    '           value is outrageous (i.e.: you passed a forms ScaleHeight in
    '           twips instead of the pictures' height in pixels), this
    '           procedure will attempt to create bitmaps that require
    '           outrageous amounts of memory.
    '   [picSource]
    '           Standard Picture object to be used as the image source
    '   [xSrc]
    '           X coordinate of the upper left corner of the area in the picture
    '           to use as the source. (in pixels)
    '           Ignored if picSource is an Icon.
    '   [ySrc]
    '           Y coordinate of the upper left corner of the area in the picture
    '           to use as the source. (in pixels)
    '           Ignored if picSource is an Icon.
    '   [clrMask]
    '           Color of pixels to be masked out
    '   [hPal]
    '           Handle of palette to select into the memory DC's used to create
    '           the painting effect.
    '           If not provided, a HalfTone palette is used.


    Dim hDCSrc          As Long         'hDC that the source bitmap is selected into
    Dim hbmMemSrcOld    As Long
    Dim hDCScreen       As Long
    Dim hPalOld         As Long
    
    
    ' Verify that the passed picture is a Bitmap
    If picSource Is Nothing Then
        
        Exit Sub
    End If

    If picSource.Type = vbPicTypeBitmap Then
        'Create halftone palette
        hDCScreen = GetDC(0&)
        m_hpalHalftone = CreateHalftonePalette(hDCScreen)
        ' Validate palette
        If hPal = 0 Then
            hPal = m_hpalHalftone
        End If
        hDCSrc = CreateCompatibleDC(hDCScreen)
        
        ' Select passed picture into an hDC
        hbmMemSrcOld = SelectObject(hDCSrc, picSource.handle)
        hPalOld = SelectPalette(hDCSrc, hPal, True)
        RealizePalette hDCSrc
        ' Draw the bitmap
        PaintTransparentDC hDCDest, xDest, yDest, Width, Height, hDCSrc, xSrc, ySrc, clrMask, hPal
        SelectObject hDCSrc, hbmMemSrcOld
    
        ' Clean up
        SelectPalette hDCSrc, hPalOld, True
        RealizePalette hDCSrc
        DeleteDC hDCSrc
        ReleaseDC 0&, hDCScreen
        DeleteObject m_hpalHalftone
    End If
        
End Sub

Private Sub PaintTransparentDC(ByVal hDCDest As Long, _
                                    ByVal xDest As Long, _
                                    ByVal yDest As Long, _
                                    ByVal Width As Long, _
                                    ByVal Height As Long, _
                                    ByVal hDCSrc As Long, _
                                    Optional ByVal xSrc As Long = 0, _
                                    Optional ByVal ySrc As Long = 0, _
                                    Optional ByVal clrMask As OLE_COLOR = 16711935, _
                                    Optional ByVal hPal As Long = 0)
                                    
                                    
    ' Purpose:  Draws a transparent bitmap to a DC.  The pixels of the passed
    '           bitmap that match the passed mask color will not be painted
    '           to the destination DC
    '
    ' Called by:    PaintTransparentPicture()
    '
    ' In:
    '   [hdcDest]
    '           Device context to paint the picture on
    '   [xDest]
    '           X coordinate of the upper left corner of the area that the
    '           picture is to be painted on. (in pixels)
    '   [yDest]
    '           Y coordinate of the upper left corner of the area that the
    '           picture is to be painted on. (in pixels)
    '   [Width]
    '           Width of picture area to paint in pixels.  Note: If this value
    '           is outrageous (i.e.: you passed a forms ScaleWidth in twips
    '           instead of the pictures' width in pixels), this procedure will
    '           attempt to create bitmaps that require outrageous
    '           amounts of memory.
    '   [Height]
    '           Height of picture area to paint in pixels.  Note: If this
    '           value is outrageous (i.e.: you passed a forms ScaleHeight in
    '           twips instead of the pictures' height in pixels), this
    '           procedure will attempt to create bitmaps that require
    '           o