Palabras clave: color, paleta, API, CHOOSECOLOR
Autor: ni me acuerdo
Extraído de: No sabria decir
Objetivo:
Abrir la paleta de colores para realizar una selección
En un módulo independiente:
Option Compare Database
Option Explicit
' Declaraciones (para aDialogColor)
#If Win64 Then
Private Declare PtrSafe Function CHOOSECOLOR Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As COLORSTRUC) As Long
#Else
Private Declare Function CHOOSECOLOR Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As COLORSTRUC) As Long
#End If
' Estructura (para aDialogColor)
Private Type COLORSTRUC
lStructSize As Long
hWnd As Long
hInstance As Long
rgbResult As Long
lpCustColors As String
Flags As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
' Estructura de devolución de valor
Public Type udtSysDialogColor
IsSelected As Boolean
PreSelected As Variant
SelectedColor As Long
End Type
Public uSysDialogColor As udtSysDialogColor
' Constantes (para aDialogColor)
Private Const CC_SOLIDCOLOR = &H80
Private Const CC_RGBINIT = &H1
Public Function aDialogColor()
Dim x As Long, CS As COLORSTRUC, CustColor(16) As Long
CS.lStructSize = Len(CS)
CS.hWnd = Application.hWndAccessApp
CS.Flags = CC_SOLIDCOLOR Or CC_RGBINIT
CS.lpCustColors = String$(16 * 4, 0)
' Were we passed a value in PreselectedColor
If Not IsMissing(uSysDialogColor.PreSelected) Then
CS.rgbResult = uSysDialogColor.PreSelected
End If
x = CHOOSECOLOR(CS)
If x = 0 Then
' ERROR - return preselected Color
uSysDialogColor.IsSelected = False
Exit Function
Else
' Normal processing
uSysDialogColor.SelectedColor = CS.rgbResult
uSysDialogColor.IsSelected = True
End If
End Function
