为什么没有自定义颜色对话框?

gzh97730

没有自定义颜色对话框,设置颜色很不方便啊!

一点通

请将问题描述清楚,在什么地方没有自定义颜色?

tz-chf

要引用控件

一点通

不好意思,可能我太蠢,你说了等于没有说

tmtony

使用API来显示 颜色选取器,下面是Stephen Lebans的代码,调用 aDialogColor即可

' Original Code by Terry Kreft
' Modified by Stephen Lebans
' Contact Stephen@lebans.com

Option Compare Database
Option Explicit
'***********  Code Start  ***********
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


Private Const CC_RGBINIT = &H1
Private Const CC_FULLOPEN = &H2
Private Const CC_PREVENTFULLOPEN = &H4
Private Const CC_SHOWHELP = &H8
Private Const CC_ENABLEHOOK = &H10
Private Const CC_ENABLETEMPLATE = &H20
Private Const CC_ENABLETEMPLATEHANDLE = &H40
Private Const CC_SOLIDCOLOR = &H80
Private Const CC_ANYCOLOR = &H100


Private Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" _
  (pChoosecolor As COLORSTRUC) As Long


Public Function aDialogColor(ByRef SelectedColor As Long, Optional PreSelectedColor As Variant) As Boolean
    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(PreSelectedColor) Then
        CS.rgbResult = PreSelectedColor
    End If

    x = ChooseColor(CS)
    If x = 0 Then
        ' ERROR - return preselected Color
        aDialogColor = False
        Exit Function
    Else
        ' Normal processing
        SelectedColor = CS.rgbResult
        aDialogColor = True
    End If

End Function
'***********  Code End   ***********

gzh97730

谢谢大家的热心解答,实在感动呀!我的文字表达能力可能次了点,补个图吧.(word的)