Leandro Ascierto

Esta es una función simple para dibujar puntos sobre un Formulario, Picture Box o hdc, la función es rápida.

Option Explicit

'=========GDI32 Api========
Private Declare Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As Long
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function SetRect Lib "user32.dll" (ByRef lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function GetDCBrushColor Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function GetBkColor Lib "gdi32.dll" (ByVal hdc 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 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 CreatePatternBrush Lib "gdi32.dll" (ByVal hBitmap As Long) As Long
Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function GdiTransparentBlt Lib "gdi32.dll" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal crTransparent As Long) As Boolean

'============User32 Api===========
Private Declare Function FillRect Lib "user32.dll" (ByVal hdc As Long, ByRef lpRect As RECT, ByVal hBrush As Long) As Long

'============Estructura Rect========
Private Type RECT
    Left                        As Long
    Top                         As Long
    Right                       As Long
    Bottom                      As Long
End Type

Public Function ShiftColor(ByVal clr As Long, ByVal d As Long) As Long
  Dim R As Long, B As Long, G As Long
    R = (clr And &HFF) + d
    G = ((clr \ &H100) Mod &H100) + d
    B = ((clr \ &H10000) Mod &H100) + d
    
    If (d > 0) Then
        If (R > &HFF) Then R = &HFF
        If (G > &HFF) Then G = &HFF
        If (B > &HFF) Then B = &HFF
    ElseIf (d < 0) Then
        If (R < 0) Then R = 0
        If (G < 0) Then G = 0
        If (B < 0) Then B = 0
    End If
    ShiftColor = R + &H100& * G + &H10000 * B
End Function

Public Sub DrawGrip(DestDC As Long, DestX As Long, DestY As Long, DestWidth As Long, DestHeight As Long)
    Dim DC                      As Long
    Dim hDCMemory               As Long
    Dim hBmp                    As Long
    Dim hOldBmp                 As Long
    Dim hBrush                  As Long
    Dim Rec                     As RECT
    Dim lOriginalColor          As Long
    Dim clrHighLight            As Long
    Dim clrShadow               As Long

    lOriginalColor = GetBkColor(DestDC)
    clrHighLight = ShiftColor(lOriginalColor, &H40)
    clrShadow = ShiftColor(lOriginalColor, -&H40)
    
    DC = GetDC(0)
    hDCMemory = CreateCompatibleDC(0)
    hBmp = CreateCompatibleBitmap(DC, 6, 6)
    hOldBmp = SelectObject(hDCMemory, hBmp)
          
    hBrush = CreateSolidBrush(lOriginalColor)
    SetRect Rec, 0, 0, 6, 6
    FillRect hDCMemory, Rec, hBrush
    DeleteObject hBrush
    
    SetPixelV hDCMemory, 2, 1, clrShadow
    SetPixelV hDCMemory, 1, 2, clrShadow
    SetPixelV hDCMemory, 2, 2, clrShadow
    
    SetPixelV hDCMemory, 0, 0, clrHighLight
    SetPixelV hDCMemory, 1, 0, clrHighLight
    SetPixelV hDCMemory, 0, 1, clrHighLight
    SetPixelV hDCMemory, 1, 1, clrHighLight
    
    SetPixelV hDCMemory, 5, 4, clrShadow
    SetPixelV hDCMemory, 4, 5, clrShadow
    SetPixelV hDCMemory, 5, 5, clrShadow
    
    SetPixelV hDCMemory, 3, 3, clrHighLight
    SetPixelV hDCMemory, 4, 3, clrHighLight
    SetPixelV hDCMemory, 3, 4, clrHighLight
    SetPixelV hDCMemory, 4, 4, clrHighLight
    
    hBrush = CreatePatternBrush(hBmp)
    SelectObject hDCMemory, hOldBmp
    DeleteObject hBmp
    hBmp = CreateCompatibleBitmap(DC, DestWidth, DestHeight)
    hOldBmp = SelectObject(hDCMemory, hBmp)
    SetRect Rec, 0, 0, DestWidth, DestHeight
    FillRect hDCMemory, Rec, hBrush
    
    GdiTransparentBlt DestDC, DestX, DestY, DestWidth, DestHeight, hDCMemory, 0, 0, DestWidth, DestHeight, lOriginalColor

    DeleteObject hBrush
    SelectObject hDCMemory, hOldBmp
    DeleteObject hBmp
    DeleteDC DC
    DeleteDC hDCMemory    
End Sub

Private Sub Form_Paint()
    DrawGrip Me.hdc, 0, 50, Me.ScaleWidth / Screen.TwipsPerPixelX, 9
    DrawGrip Me.hdc, 100, 59, 16, Me.ScaleHeight / Screen.TwipsPerPixelY - 59
End Sub