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
Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As ChooseColor) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (Byval lpClassName As String, Byval lpWindowName As String) As Long
'---------
Function ShowColor() As Long
Dim ChooseColorStructure As ChooseColor
Dim Custcolor(16) As Long
Static CustomColors As String * 70
Dim lReturn As Long
Dim Break_Mode As Long
ChooseColorStructure.lStructSize = Len(ChooseColorStructure)
ChooseColorStructure.hwndOwner = FindWindow("NOTES", "New Memo - IBM Lotus Notes")
ChooseColorStructure.hInstance = 0
ChooseColorStructure.lpCustColors = CustomColors
ChooseColorStructure.flags = 0
If ChooseColor(ChooseColorStructure) <> 0 Then
ShowColor = ChooseColorStructure.rgbResult
CustomColors = ChooseColorStructure.lpCustColors
Else
ShowColor = -1
End If
If ShowColor > &HFFFFFF Or ShowColor < -1 Then ShowColor = -1
End Function
'---------
Sub Click(Source As Button)
Dim workspace As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Set uidoc = workspace.CurrentDocument
If uidoc.EditMode = True Then
Call uidoc.FieldAppendText("Subject", Cstr(showcolor))
Else
Msgbox "You must be in edit mode before you can set the colour"
End If
End Sub