' Paul's Color Picker uses an innovative approach to the color selection process.
' The starting point is the RGB color model.
' First a color pair is selected and this color combination is presented in a 17x17 matrix
' with the colors shown with 16 units increments. Beneath the matrix is a slider allowing
' variations of the third color.
' To further refine the search the increments can be modified down to 1 unit.
' Clicking a color in the matrix shows detailed info of the color picked.
' Additional features:
' - selected colors are preserved to allow comparisons
' - the form's backcolor can be set (standard or picked color) to aid visualization and
' comparison
' - save to the clipboard in three possible formats: numeric (long), Hexadecimal or RGB
'
Option Explicit
'............................ DC
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private CursorDC As Long
'............................ OBJECT
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private oldCursorObj As Long
Private oldBrush As Long
'............................ BITMAP
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function PatBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As Long
Private Const PATCOPY = &HF00021 ' (DWORD) dest = pattern
Private Type BITMAP '14 bytes
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Private Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbAlpha As Byte
End Type
Private Type BITMAPINFOHEADER
bmSize As Long
bmWidth As Long
bmHeight As Long
bmPlanes As Integer
bmBitCount As Integer
bmCompression As Long
bmSizeImage As Long
bmXPelsPerMeter As Long
bmYPelsPerMeter As Long
bmClrUsed As Long
bmClrImportant As Long
End Type
Private Type BITMAPINFO
bmHeader As BITMAPINFOHEADER
bmColors(0 To 255) As RGBQUAD
End Type
Private bm As BITMAP
Private bmi As BITMAPINFO
'............................ DIB
Private Declare Function StretchDIBits Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal dWidth As Long, ByVal dHeight As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal SrcWidth As Long, ByVal SrcHeight As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long, ByVal RasterOp As Long) As Long
Private arDIB() As Byte
'............................ CURSOR
' The ICONINFO structure contains information about an icon or a cursor.
Private Type ICONINFO
fIcon As Long ' Specifies whether this structure defines an icon or a cursor.
' A value of TRUE specifies an icon; FALSE specifies a cursor.
xHotspot As Long ' Specifies the x-coordinate of a cursor's hot spot.
yHotspot As Long ' Specifies the y-coordinate of a cursor's hot spot.
' If these structures defines an icon, the hot spot is always
' in the center of the icon, and this member is ignored.
hbmMask As Long ' Specifies the icon bitmask bitmap.
hbmColor As Long ' Identifies the icon color bitmap.
End Type
' The GetIconInfo function retrieves information about the specified icon or cursor.
Private Declare Function GetIconInfo Lib "user32" (ByVal hIcon As Long, piconinfo As ICONINFO) As Long
' The CreateIconIndirect function creates an icon or cursor from an ICONINFO structure.
Private Declare Function CreateIconIndirect Lib "user32" (piconinfo As ICONINFO) As Long
' The DestroyIcon function destroys an icon and frees any memory the icon occupied
Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
' The SetClassLong function replaces the specified 32-bit (long) value
' at the specified offset into the extra class memory or the WNDCLASS structure
' for the class to which the specified window belongs.
Private Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GCL_HCURSOR = (-12)
Private pIF As ICONINFO
Private oldCursor As Long
Private hCursor As Long ' handle to active cursor
'............................ BRUSH
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private hBrush As Long
' color pick
Private iRed As Integer
Private iGreen As Integer
Private iBlue As Integer
Private iIncrement As Integer
Private iLower As Integer
Private iSelected As Integer
Private swActivated As Boolean
Private lColorUnderMouse As Long
' Constants form width
Private Const cFormWidthDefault As Single = 6315
Private Const cFormWidthLarge As Single = 7500
Private Sub chCompare_Click()
' show/hide the second set of labels (color,values)
