Autor Tema: Abrir paleta de colores  (Leído 1558 veces)

Desconectado xavi

  • Administrador
  • Habitual
  • *****
  • Mensajes: 220
Abrir paleta de colores
« en: Mayo 12, 2023, 09:58:01 am »
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:
Código: [Seleccionar]
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