DrawSelectionEx

Este es una función para dibujar una selección al estilo Windows Vista o MSN, útil para hacer controles de usuarios o según la necesidad de cada uno. creo que si bien es hay unas cuantas  Apis, la función es muy rápida en dibujar.

Option Explicit
' ---------------------------------------------------
' Autor: Leandro Ascierto
' ----------------------------------------------------

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc 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 SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function CreatePatternBrush Lib "gdi32.dll" (ByVal hBitmap As Long) As Long
Private Declare Function SetPixelV Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function RoundRect Lib "gdi32.dll" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function CreatePen Lib "gdi32.dll" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
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 OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor As Long, ByVal lHPalette As Long, ByVal lColorRef As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hdc As Long) As Long
 
Private Type UcsRgbQuad
    R As Byte
    G As Byte
    B As Byte
    a As Byte
End Type 
 
Private Sub DrawSelectionEx(DestDC As Long, DestX As Long, DestY As Long, DestWidth As Long, DestHeight As Long, oColorStar As Long, oColorEnd As Long) 
    Dim DC As Long, hDCMemory As Long, hBmp As Long
    Dim hPen1 As Long, hPen2 As Long, hBrush As Long
    Dim OldhBmp As Long, OldhPen As Long, OldhBrush As Long
    Dim DivValue As Double
    Dim i As Long
 
    ' Creamos una Pluma oscura para el borde
    hPen1 = CreatePen(0, 1, pvAlphaBlend(vbBlack, oColorEnd, 10))
 
    ' Creamos un Pluma para un pequeño borde interior, bien claro
    hPen2 = CreatePen(0, 1, pvAlphaBlend(oColorStar, vbWhite, 10))
 
    ' Creamos un HDC temporal
    DC = GetDC(0)
    hDCMemory = CreateCompatibleDC(0)
    hBmp = CreateCompatibleBitmap(DC, 1, DestHeight)
    OldhBmp = SelectObject(hDCMemory, hBmp)
 
    ' Creamos un bucle haciendo un degradado
    For i = 1 To DestHeight
        DivValue = ((i * 255) / DestHeight)
        SetPixelV hDCMemory, 0, i, pvAlphaBlend(oColorEnd, oColorStar, DivValue)
    Next
 
    ' Creamos una brocha con el bmp
    hBrush = CreatePatternBrush(hBmp)
 
    ' Creamos un buffer temporal
    DeleteObject hBmp
    hBmp = CreateCompatibleBitmap(DC, DestWidth, DestHeight)
    Call SelectObject(hDCMemory, hBmp)
 
    ' Pintamos el destino en el buffer
    BitBlt hDCMemory, 0, 0, DestWidth, DestHeight, DestDC, DestX, DestY, vbSrcCopy
 
    ' Le asignamos la pluma al hdc de destino
    OldhPen = SelectObject(hDCMemory, hPen1)
 
    ' Pintamos un borde oscuro alrededor sin relleno
    RoundRect hDCMemory, 0, 0, DestWidth, DestHeight, 9, 9
 
    ' Asignamos la segunda pluma más clara
    Call SelectObject(hDCMemory, hPen2)
 
    ' Creamos y asignamos una brocha con el bmp de nuestro degradado
    OldhBrush = SelectObject(hDCMemory, hBrush)
 
    ' Pintamos un rectángulo redondeado con la pluma y la brocha
    RoundRect hDCMemory, 1, 1, DestWidth - 1, DestHeight - 1, 8, 8
 
    ' Pintamos el buffer en el destino
    BitBlt DestDC, DestX, DestY, DestWidth, DestHeight, hDCMemory, 0, 0, vbSrcCopy
 
    ' Descargamos todo
    SelectObject hDCMemory, OldhPen
    SelectObject hDCMemory, OldhBrush
    SelectObject hDCMemory, OldhBmp
    DeleteObject hPen1
    DeleteObject hPen2
    DeleteObject hBrush
    DeleteObject hBmp
    ReleaseDC 0&, DC
    DeleteDC hDCMemory
 
End Sub 
 
' Función para trasladar un color a otro en porcentaje lAlpha(0 A 255)
Private Function pvAlphaBlend(ByVal clrFirst As Long, ByVal clrSecond As Long, ByVal lAlpha As Long) As Long
 
    Dim clrFore         As UcsRgbQuad
    Dim clrBack         As UcsRgbQuad
 
    OleTranslateColor clrFirst, 0, VarPtr(clrFore)
    OleTranslateColor clrSecond, 0, VarPtr(clrBack)
    With clrFore
        .R = (.R * lAlpha + clrBack.R * (255 - lAlpha)) / 255
        .G = (.G * lAlpha + clrBack.G * (255 - lAlpha)) / 255
        .B = (.B * lAlpha + clrBack.B * (255 - lAlpha)) / 255
    End With
 
    CopyMemory VarPtr(pvAlphaBlend), VarPtr(clrFore), 4
 
End Function
  
Private Sub Form_Load()
    Me.ScaleMode = vbPixels
    Me.FontName = "Calibri"
    Me.FontSize = 12
    Me.BackColor = vbWhite
    Me.Width = 8500
    Me.Height = 8700
    HScroll1.Max = 255
    HScroll1.Value = 70
    HScroll1.Move 320, 210, 230, 30
End Sub
  
' Ejemplo de uso
Private Sub Form_Paint()
 
    Dim i As Integer
 
    ' Colores empleados en Windows Vista, y MSN
    DrawSelectionEx Me.hdc, 320, 10, 100, 100, RGB(249, 253, 255), RGB(234, 247, 255)
    DrawSelectionEx Me.hdc, 440, 10, 100, 100, RGB(251, 251, 251), RGB(231, 231, 231)
 
    ' Con quince colores diferentes
    For i = 0 To 15
        DrawSelectionEx Me.hdc, 10, 10 + (i * 35), 300, 30, Me.BackColor, pvAlphaBlend(QBColor(i), Me.BackColor, HScroll1.Value)
    Next
 
    ' Utilizando el color resalte del sistema
    DrawSelectionEx Me.hdc, 320, 120, 220, 70, Me.BackColor, pvAlphaBlend(vbHighlight, Me.BackColor, 50)
 
    Me.CurrentX = 330
    Me.CurrentY = 145
    Me.Print "Color de selección del Sistema"
 
End Sub 
 
Private Sub HScroll1_Change()
    Form_Paint
End Sub