Mikla
Mar 30th, 2007, 08:05 PM
There is probably a better way, but below is the code for a form (named frmColors) that can be used to pick a color. It returns the color in the form of "colorname|htmlHex". You can then parse store the value in a public variable and parse the htmlHex out. Included is a hex to RGB function.
I use it when I create html files and want the user to be able to select colors for tables, text, etc...
The thing I like is that it is all contained in one form.
I am less than a rookie at this (more of a hack), but no need to be gentle...
Option Explicit
Dim ColorArray() As String
Private Sub carrLabel_Click(Index As Integer)
If Index <= UBound(ColorArray) Then
MsgBox ColorArray(Index)
'Set a public variable to ColorArray(Index) and parse it
Else
MsgBox "Cancel Pressed"
Unload frmColors
End If
End Sub
Private Sub Form_Load()
Dim x As Integer, y As Integer, cnt As Integer
Dim flgFor As Boolean
Call FillColorArray
carrLabel(0).Visible = False
cnt = 0
flgFor = False
For x = 0 To 24
For y = 0 To 7
If cnt <= UBound(ColorArray) Then
If cnt > 0 Then Load carrLabel(cnt)
carrLabel(cnt).Left = carrLabel(0).Left + 1200 * y
carrLabel(cnt).Top = carrLabel(0).Top + 300 * x
carrLabel(cnt).Width = 1185
carrLabel(cnt).Height = 285
carrLabel(cnt).BackColor = HEXCOL2RGB(Right(ColorArray(cnt), 7))
carrLabel(cnt).Caption = Left(ColorArray(cnt), Len(ColorArray(cnt)) - 8)
carrLabel(cnt).Visible = True
cnt = cnt + 1
Else
flgFor = True
Exit For
End If
Next y
If flgFor Then Exit For
Next x
Load carrLabel(cnt)
carrLabel(cnt).Left = carrLabel(0).Left + 1200 * y / 2
carrLabel(cnt).Top = carrLabel(0).Top + 300 * x + 600
carrLabel(cnt).Width = 2000
carrLabel(cnt).Height = 400
' carrLabel(cnt).BackColor = HEXCOL2RGB(Right(ColorArray(cnt), 7))
carrLabel(cnt).Caption = "Cancel"
carrLabel(cnt).Visible = True
End Sub
Public Function HEXCOL2RGB(ByVal HexColor As String) As String
'The input at this point could be HexColor = "#00FF1F"
Dim Red As String
Dim Green As String
Dim Blue As String
HexColor = Replace(HexColor, "#", "")
'Here HexColor = "00FF1F"
Red = Val("&H" & Mid(HexColor, 1, 2))
'The red value is now the long version of "00"
Green = Val("&H" & Mid(HexColor, 3, 2))
'The red value is now the long version of "FF"
Blue = Val("&H" & Mid(HexColor, 5, 2))
'The red value is now the long version of "1F"
HEXCOL2RGB = RGB(Red, Green, Blue)
'The output is an RGB value
End Function
Sub FillColorArray()
Dim tmpColStr
tmpColStr = tmpColStr & "AliceBlue|#F0F8FF,"
tmpColStr = tmpColStr & "AntiqueWhite|#FAEBD7,"
tmpColStr = tmpColStr & "Aqua|#00FFFF,"
tmpColStr = tmpColStr & "Aquamarine|#7FFFD4,"
tmpColStr = tmpColStr & "Wheat|#F5DEB3,"
'.
'. 146 colors in total (too many to post all the code, see the form)
'.
tmpColStr = tmpColStr & "White|#FFFFFF,"
tmpColStr = tmpColStr & "WhiteSmoke|#F5F5F5,"
tmpColStr = tmpColStr & "Yellow|#FFFF00,"
tmpColStr = tmpColStr & "YellowGreen|#9ACD32"
ColorArray = Split(tmpColStr, ",")
End Sub
I use it when I create html files and want the user to be able to select colors for tables, text, etc...
The thing I like is that it is all contained in one form.
I am less than a rookie at this (more of a hack), but no need to be gentle...
Option Explicit
Dim ColorArray() As String
Private Sub carrLabel_Click(Index As Integer)
If Index <= UBound(ColorArray) Then
MsgBox ColorArray(Index)
'Set a public variable to ColorArray(Index) and parse it
Else
MsgBox "Cancel Pressed"
Unload frmColors
End If
End Sub
Private Sub Form_Load()
Dim x As Integer, y As Integer, cnt As Integer
Dim flgFor As Boolean
Call FillColorArray
carrLabel(0).Visible = False
cnt = 0
flgFor = False
For x = 0 To 24
For y = 0 To 7
If cnt <= UBound(ColorArray) Then
If cnt > 0 Then Load carrLabel(cnt)
carrLabel(cnt).Left = carrLabel(0).Left + 1200 * y
carrLabel(cnt).Top = carrLabel(0).Top + 300 * x
carrLabel(cnt).Width = 1185
carrLabel(cnt).Height = 285
carrLabel(cnt).BackColor = HEXCOL2RGB(Right(ColorArray(cnt), 7))
carrLabel(cnt).Caption = Left(ColorArray(cnt), Len(ColorArray(cnt)) - 8)
carrLabel(cnt).Visible = True
cnt = cnt + 1
Else
flgFor = True
Exit For
End If
Next y
If flgFor Then Exit For
Next x
Load carrLabel(cnt)
carrLabel(cnt).Left = carrLabel(0).Left + 1200 * y / 2
carrLabel(cnt).Top = carrLabel(0).Top + 300 * x + 600
carrLabel(cnt).Width = 2000
carrLabel(cnt).Height = 400
' carrLabel(cnt).BackColor = HEXCOL2RGB(Right(ColorArray(cnt), 7))
carrLabel(cnt).Caption = "Cancel"
carrLabel(cnt).Visible = True
End Sub
Public Function HEXCOL2RGB(ByVal HexColor As String) As String
'The input at this point could be HexColor = "#00FF1F"
Dim Red As String
Dim Green As String
Dim Blue As String
HexColor = Replace(HexColor, "#", "")
'Here HexColor = "00FF1F"
Red = Val("&H" & Mid(HexColor, 1, 2))
'The red value is now the long version of "00"
Green = Val("&H" & Mid(HexColor, 3, 2))
'The red value is now the long version of "FF"
Blue = Val("&H" & Mid(HexColor, 5, 2))
'The red value is now the long version of "1F"
HEXCOL2RGB = RGB(Red, Green, Blue)
'The output is an RGB value
End Function
Sub FillColorArray()
Dim tmpColStr
tmpColStr = tmpColStr & "AliceBlue|#F0F8FF,"
tmpColStr = tmpColStr & "AntiqueWhite|#FAEBD7,"
tmpColStr = tmpColStr & "Aqua|#00FFFF,"
tmpColStr = tmpColStr & "Aquamarine|#7FFFD4,"
tmpColStr = tmpColStr & "Wheat|#F5DEB3,"
'.
'. 146 colors in total (too many to post all the code, see the form)
'.
tmpColStr = tmpColStr & "White|#FFFFFF,"
tmpColStr = tmpColStr & "WhiteSmoke|#F5F5F5,"
tmpColStr = tmpColStr & "Yellow|#FFFF00,"
tmpColStr = tmpColStr & "YellowGreen|#9ACD32"
ColorArray = Split(tmpColStr, ",")
End Sub