VB利用API调用系统的通用颜色对话框

Option Explicit
'在窗体上添加一个Command1按钮控件
Private Type ChooseColor
lStructSize As Long
hwndOwner 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 Declare Function ChooseColor Lib “comdlg32.dll” Alias “ChooseColorA” (pChoosecolor As ChooseColor) As Long

Private Function Fcolor(Optional Color As Long = vbBlack) As Long
Dim cc As ChooseColor, CustColor(16) As Long, Mcolor As Long
Const CC_RGBINIT = &H1 '指定 rgbResult 颜色值
Const CC_FULLOPEN = &H2 '展开色谱
With cc
.lStructSize = Len(cc) '设置结构尺寸
.hwndOwner = Me.hWnd '设置所有者
.hInstance = App.hInstance '设置应用程序的实例
.rgbResult = Color '指向颜色值
.Flags = CC_RGBINIT Or CC_FULLOPEN ’
.lpCustColors = String$(64, vbUnicode) '设置自定义颜色(转换为Unicode)
End With

Mcolor = ChooseColor(cc)
If Mcolor Then
'Fcolor = StrKaTeX parse error: Expected 'EOF', got '&' at position 26: …ult) Fcolor = "&̲H" & Hex(Str(cc.rgbResult)) '转为16进制
Else
Fcolor = -1
End If
End Function

Private Sub Command1_Click()
Me.BackColor = Fcolor(Me.BackColor)
End Sub