May 012009
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