(RESOLVED) Save custom colors

[rdcody]

Hey All,

I'm using the ChooseColor API to select a color. Is there any way to save the
custom colors a user selects?

Thanks in advance for any help,
Ron

Option Explicit
 
   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 ChooseColorAPI Lib "comdlg32.dll" Alias _
     "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long
 
   Dim CustomColors() As Byte
 
Private Sub Form_Load()
       ReDim CustomColors(0 To 16 * 4 - 1) As Byte
       Dim i As Integer
 
       For i = LBound(CustomColors) To UBound(CustomColors)
           CustomColors(i) = 0
       Next i
End Sub
 
Private Sub Command1_Click()
       Dim cc As CHOOSECOLOR
       Dim Custcolor(16) As Long
       Dim lReturn As Long
       cc.lStructSize = Len(cc)
       cc.hwndOwner = Me.hWnd
       cc.hInstance = 0
       cc.lpCustColors = StrConv(CustomColors, vbUnicode)
       cc.flags = 0
       lReturn = ChooseColorAPI(cc)
       If lReturn <> 0 Then
           Text1.Text = cc.rgbResult
           Label1.ForeColor = cc.rgbResult
           CustomColors = StrConv(cc.lpCustColors, vbFromUnicode)
       Else
           'MsgBox "User chose the Cancel Button"
       End If
   End Sub

[dglienna]

I just use the Common Dialog Control to change the colors. I click on a label to change it's color, and save them to a file. When I load the program, it reads the file and loads the label colors. I also put the CDC control on a small form, and can move the location of the form before I show it.

Here is how to use the CDC control. I added the Show Color today.

EDIT: After 66 views, I'm updating to version 6 that asks if you want to overwrite in a save operation.

[Joacim Andersson]

Change the lpCustColors member to a Long instead of a string and set it to VarPtr(CustColors(0)) instead of using StrConv. You can then store these values somewhere and load them before the call.

[rdcody]

Thanks dglienna, but I am/want to use the ChooseColor API.

[rdcody]

Hey Joacim,

So the code would be....

cc.lpCustColors = VarPtr(CustomColors(0))

instead of...

cc.lpCustColors = StrConv(CustomColors, vbUnicode)

Is this what your talking about?

[Joacim Andersson]

Yes. But you must of course also change the type from String to Long in the CHOOSECOLOR structure.

[rdcody]

I don't understand how to use this. I mean there are 16 custom color boxes,
how do I save the color number for each box?

[Joacim Andersson]

OK. I've made some slight changes to your code. I've changed the structure to use a Long for the lpCustColor member. I've also changed your CustomColors() array to be of the type Long instead of Byte. I removed the local Custcolor() array you had in the Command1_Click event since that doesn't do anything. Instead I use the CustomColors() array.

The changes are in bold below.

Private Type CHOOSECOLOR
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    rgbResult As Long
    lpCustColors[b] As Long [/b]
    flags As Long
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type
 
Private Declare Function ChooseColorAPI Lib "comdlg32.dll" Alias _
  "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long
 
Private CustomColors()[b] As Long [/b]
 
Private Sub Form_Load()
[b]    ReDim CustomColors(15) As Long 'index 0 to 15 = 16 colors [/b]
    Dim i As Integer
    
    For i = LBound(CustomColors) To UBound(CustomColors)
        CustomColors(i) = 0
    Next i
End Sub
 
Private Sub Command1_Click()
    Dim cc As CHOOSECOLOR
    Dim lReturn As Long
    cc.lStructSize = Len(cc)
    cc.hwndOwner = Me.hWnd
    cc.hInstance = 0
    cc.lpCustColors =[b] VarPtr(CustomColors(0)) [/b]
    cc.flags = 0
    lReturn = ChooseColorAPI(cc)
    If lReturn <> 0 Then
        Text1.Text = cc.rgbResult
        Label1.ForeColor = cc.rgbResult
[b]        'The CustomColors() array now contains all the custom colors
        'that the user has selected. You can save this array values
        'to a file if you want and reload them in Form_Load.
        'Next time you click this button these values are used again! [/b]
    Else
        'MsgBox "User chose the Cancel Button"
    End If
End Sub

[rdcody]

Hey thanks Joacim ...now if I can figure out to write/read that
array to an *.ini file, I'll be set.

[Joacim Andersson]

Why save them to an INI file? Why not use a binary file.

Private Type CHOOSECOLOR
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    rgbResult As Long
    lpCustColors As Long
    flags As Long
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type
 
Private Declare Function ChooseColorAPI Lib "comdlg32.dll" Alias _
  "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long
 
Private CustomColors() As Long
[b]Private sFileName As String [/b]
 
Private Sub Form_Load()
[b]    Dim hFile As Integer [/b]
    ReDim CustomColors(15) As Long 'index 0 to 15 = 16 colors
[b]    sFileName = App.Path & "\CustClrs.dat"
    'Check if the file exists
    If Len(Dir$(sFileName)) > 0 Then
        'read the file
        hFile = FreeFile
        Open sFileName For Binary Access Read As #hFile
            Get #hFile, , CustomColors
        Close #hFile
    End If [/b]
End Sub
 
Private Sub Command1_Click()
    Dim cc As CHOOSECOLOR
    Dim lReturn As Long
[b]    Dim hFile As Integer [/b]
    cc.lStructSize = Len(cc)
    cc.hwndOwner = Me.hWnd
    cc.hInstance = 0
    cc.lpCustColors = VarPtr(CustomColors(0))
    cc.flags = 0
    lReturn = ChooseColorAPI(cc)
    If lReturn <> 0 Then
        Text1.Text = cc.rgbResult
        Label1.ForeColor = cc.rgbResult
[b]        'Save the custom colors
        hFile = FreeFile
        Open sFileName For Binary Access Write As #hFile
            Put #hFile, , CustomColors
        Close #hFile [/b]
    Else
        'MsgBox "User chose the Cancel Button"
    End If
End Sub

[rdcody]

That's the answer! Thanks a lot
Joacim. I don't know where my heads been today...I've had that brain fog
all day. I'll be sure and give you an excellent rating! Thanks again and have
a good one.