DrawAlphaSelection

Esta es una función para dibujar una selección al estilo Windows XP.

Option Explicit
 
'=========Gdi32 Api========
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32.dll" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function GdiAlphaBlend Lib "gdi32.dll" (ByVal hdc As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal hdc As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal BLENDFUNCT 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 CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As Long
'=========user32 Api========
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hdc As Long) As Long
 
'=========Oleaut32 Api========
Private Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor As Long, ByVal lHPalette As Long, ByVal lColorRef As Long) As Long
 
'=========Kernel32 Api========
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
 
Private Type UcsRgbQuad
    R                       As Byte
    G                       As Byte
    B                       As Byte
    a                       As Byte
End Type
 
Private Type BLENDFUNCTION
    BlendOp                 As Byte
    BlendFlags              As Byte
    SourceConstantAlpha     As Byte
    AlphaFormat             As Byte
End Type
 
Private Sub DrawAlphaSelection(hdc As Long, ByVal X As Long, ByVal y As Long, ByVal Width As Long, ByVal Height As Long, ByVal Color As OLE_COLOR)
 
    Dim BF                  As BLENDFUNCTION
    Dim hDCMemory           As Long
    Dim hBmp                As Long
    Dim hOldBmp             As Long
    Dim DC                  As Long
    Dim lColor              As Long
    Dim hPen                As Long
    Dim hBrush              As Long
    Dim lBF                 As Long
 
    BF.SourceConstantAlpha = 128
 
    DC = GetDC(0)
    hDCMemory = CreateCompatibleDC(0)
    hBmp = CreateCompatibleBitmap(DC, Width, Height)
    hOldBmp = SelectObject(hDCMemory, hBmp)
 
    hPen = CreatePen(0, 1, Color)
    hBrush = CreateSolidBrush(pvAlphaBlend(Color, vbWhite, 120))
    DeleteObject SelectObject(hDCMemory, hBrush)
    DeleteObject SelectObject(hDCMemory, hPen)
    Rectangle hDCMemory, 0, 0, Width, Height
 
    CopyMemory VarPtr(lBF), VarPtr(BF), 4
    GdiAlphaBlend hdc, X, y, Width, Height, hDCMemory, 0, 0, Width, Height, lBF
 
    SelectObject hDCMemory, hOldBmp
    DeleteObject hBmp
    ReleaseDC 0&, DC
    DeleteDC hDCMemory
    DeleteObject hPen
    DeleteObject hBrush
 
End Sub
 
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_Paint()
    Cls
    DrawAlphaSelection Me.hdc, 10, 50, 100, 200, vbRed
    DrawAlphaSelection Me.hdc, 50, 30, 200, 100, vbBlue
    DrawAlphaSelection Me.hdc, 200, 80, 100, 100, vbGreen
    DrawAlphaSelection Me.hdc, 80, 200, 200, 30, vbYellow
    DrawAlphaSelection Me.hdc, 130, 70, 50, 200, vbMagenta
End Sub