[RESOLVED] Writing Colors to ini for later use

[BrailleSchool]

I am wanting to write the color values to a ini file for later use. This is the code I am using and what the output is. Am I doing it right or would you recommend a different approach?

Option Explicit
 
Private Sub cmdBackgroundColor_Click()
    ShowColorPicker
    lblColorScheme.BackColor = CDlgColorPicker.Color
End Sub
 
Private Sub cmdForegroundColor_Click()
    ShowColorPicker
    lblColorScheme.ForeColor = CDlgColorPicker.Color
End Sub
 
Private Sub ShowColorPicker()
    With CDlgColorPicker
        .Flags = cdlCCFullOpen
        .ShowColor
        .CancelError = True
    End With
End Sub
 
Private Sub cmdSave_Click()
    Dim intFF As Integer, strFileName As String, strFileLocation As String
    
    intFF = FreeFile
    
    strFileName = "ColorScheme.ini"
    strFileLocation = App.Path & "\" & strFileName
    
    Open strFileLocation For Output As #intFF
    
    With lblColorScheme
        Print #intFF, .BackColor & "|" & .ForeColor
    End With
    
    Close #intFF
End Sub

output is:

12615808|255

[CVMichael]

Why not store in the registry using SaveSetting and GetSetting ?

[BrailleSchool]

Why not store in the registry using SaveSetting and GetSetting ?

my client doesnt allow writing to the registry so i have to use text files instead

[CVMichael]

Now that I actually looked at the code, I did not see anything wrong with it...

Looks OK to me...

What kind of problems to you have exactly ?

[BrailleSchool]

Now that I actually looked at the code, I did not see anything wrong with it...

Looks OK to me...

What kind of problems to you have exactly ?

when i retrieve the values from the ini file and then load the "colors" to the forecolor and backcolor properties. i am getting a type mismatch error.

this is what i am using:

Private Sub Form_Load()
    Dim strParts() As String, sngSectionValue As Single, strLine As String
    Dim sngBC As Single, sngFC As Single
    Dim strFileName As String, strFileLocation As String, intFF As Integer
    
    strFileName = "ColorScheme.ini"
    strFileLocation = App.Path & "\" & strFileName
    
    If FileExists(strFileLocation) Then
        Open strFileLocation For Input As #intFF
            Line Input #intFF, strLine
                strParts = Split(strLine, "|")
                    For sngSectionValue = 0 To 1
                        sngBC = strParts(0)
                        sngFC = strParts(1)
                    Next sngSectionValue
                Close #intFF
    End If
End Sub

[CVMichael]

First of all, you don't need the For loop, I'm not sure why you put it in there...

Try using the Val function to convert from string to number
sngBC = Val(strParts(0))
sngFC = Val(strParts(1))

And second, a color is stored in a Long value type, not a Single type, so change the sngBC and sngFC variables to Long

[BrailleSchool]

so the for loop does line by line?

[BrailleSchool]

Bad file name or number

Private Sub Form_Load()
    Dim strParts() As String, strLine As String
    Dim lngBC As Long, lngFC As Long
    Dim strFileName As String, strFileLocation As String, intFF As Integer
    
    strFileName = "ColorScheme.ini"
    strFileLocation = App.Path & "\" & strFileName
    
    If FileExists(strFileLocation) Then
        [hl]Open strFileLocation For Input As #intFF[/hl]
            Line Input #intFF, strLine
                strParts = Split(strLine, "|")
                        lngBC = Val(strParts(0))
                        lngFC = Val(strParts(1))
                Close #intFF
    End If
End Sub

[BrailleSchool]

i forgot to do intFF = FreeFile

i am almost there, just one of the properties is being populated with the relevant color (backcolor)

[BrailleSchool]

this is the content of the file:

0|16777215

and when i do a breakpoint, both variables for the colors contain 0 instead of one containing 0 and the other containing 16777215

Private Sub Form_Load()
    Dim strParts() As String, strLine As String
    Dim lngBC As Long, lngFC As Long
    Dim strFileName As String, strFileLocation As String, intFF As Integer
    
    intFF = FreeFile
    
    strFileName = "Settings.ini"
    strFileLocation = App.Path & "\" & strFileName
    
    If FileExists(strFileLocation) Then
        Open strFileLocation For Input As #intFF
            Line Input #intFF, strLine
                strParts = Split(strLine, "|")
                        lngBC = Val(strParts(0))
                        lngFC = Val(strParts(1))
                Close #intFF
    End If
    
    With lblColorScheme
        .BackColor = lngBC
        .ForeColor = lngFC
    End With
End Sub

[HanneSThEGreaT]

When writing to to Ini files, and getting info from them, I actually prefer using APIs:
GetPrivateProfileString
http://www.allapi.net/apilist/GetPri...leString.shtml

WritePrivateProfileString
http://www.allapi.net/apilist/WriteP...leString.shtml

There are also various other Reading / Writing INI files APIs, which can make your life a bit easier :
WriteProfileSection
http://www.allapi.net/apilist/WriteP...eSection.shtml

GetPrivateProfileSection
http://www.allapi.net/apilist/GetPri...eSection.shtml

GetPrivateProfileInt
http://www.allapi.net/apilist/GetPri...ofileInt.shtml

GetPrivatePrivateProfileSectionNames
http://www.allapi.net/apilist/GetPri...ionNames.shtml

to name a few

[schoolbusdriver]

Agreed, HanneSThEGreaT. Why bother with splitting strings etc when a one liner will do? There's also the appalingly badly documented "Write/Get PrivateProfileStruct" APIs I mentioned in this thread. They don't seem to have caught on, yet . Maybe I should put something in the FAQs or codebank ?

BTW, is it something I've done wrong, or have the VBCODE (and other) tags gone kaput?

Try this:

Option Explicit

'Put 2 command buttons and a label on a form.

Private Declare Function WritePrivateProfileStruct Lib "kernel32.dll" Alias "WritePrivateProfileStructA" _
(ByVal lpszSection As String, ByVal lpszKey As String, lpStruct As Any, _
ByVal uSizeStruct As Long, ByVal szFile As String) As Long

Private Declare Function GetPrivateProfileStruct Lib "kernel32.dll" Alias "GetPrivateProfileStructA" _
(ByVal lpszSection As String, ByVal lpszKey As String, lpStruct As Any, _
ByVal uSizeStruct As Long, ByVal szFile As String) As Long

Private Type MyUDT
   Password As String * 20
   FormBackColour As Long
   LabelBackColour As Long
   LabelForeColour As Long
End Type

Private Sub Command1_Click() 'Change some colours etc...
   Label1.Caption = "Christmas"
   Form1.BackColor = vbRed
   Label1.BackColor = vbYellow
   Label1.ForeColor = vbBlue
End Sub

Private Sub Command2_Click() 'Save the settings...
   Dim MyNewUDT As MyUDT

   MyNewUDT.Password = Label1.Caption
   MyNewUDT.FormBackColour = Form1.BackColor
   MyNewUDT.LabelBackColour = Label1.BackColor
   MyNewUDT.LabelForeColour = Label1.ForeColor
   
   Call WritePrivateProfileStruct("MySection", "MySettings", _
      MyNewUDT, Len(MyNewUDT), App.Path & "\INITest.ini")

'File contents:
'[MySection]
'MySettings=4368726973746D61732020202020202020202020FF000000FFFF00000000FF000A
End Sub

Private Sub Form_Load() 'Load `em up...
   Dim MyNewUDT As MyUDT
      
   Call GetPrivateProfileStruct("MySection", "MySettings", _
      MyNewUDT, Len(MyNewUDT), App.Path & "\INITest.ini")

   Label1.Caption = MyNewUDT.Password
   Form1.BackColor = MyNewUDT.FormBackColour
   Label1.BackColor = MyNewUDT.LabelBackColour
   Label1.ForeColor = MyNewUDT.LabelForeColour

End Sub

[BrailleSchool]

yep. worked great. thanks for the help.

Agreed, HanneSThEGreaT. Why bother with splitting strings etc when a one liner will do? There's also the appalingly badly documented "Write/Get PrivateProfileStruct" APIs I mentioned in this thread. They don't seem to have caught on, yet . Maybe I should put something in the FAQs or codebank ?

BTW, is it something I've done wrong, or have the VBCODE (and other) tags gone kaput?

Try this:

Option Explicit

'Put 2 command buttons and a label on a form.

Private Declare Function WritePrivateProfileStruct Lib "kernel32.dll" Alias "WritePrivateProfileStructA" _
(ByVal lpszSection As String, ByVal lpszKey As String, lpStruct As Any, _
ByVal uSizeStruct As Long, ByVal szFile As String) As Long

Private Declare Function GetPrivateProfileStruct Lib "kernel32.dll" Alias "GetPrivateProfileStructA" _
(ByVal lpszSection As String, ByVal lpszKey As String, lpStruct As Any, _
ByVal uSizeStruct As Long, ByVal szFile As String) As Long

Private Type MyUDT
   Password As String * 20
   FormBackColour As Long
   LabelBackColour As Long
   LabelForeColour As Long
End Type

Private Sub Command1_Click() 'Change some colours etc...
   Label1.Caption = "Christmas"
   Form1.BackColor = vbRed
   Label1.BackColor = vbYellow
   Label1.ForeColor = vbBlue
End Sub

Private Sub Command2_Click() 'Save the settings...
   Dim MyNewUDT As MyUDT

   MyNewUDT.Password = Label1.Caption
   MyNewUDT.FormBackColour = Form1.BackColor
   MyNewUDT.LabelBackColour = Label1.BackColor
   MyNewUDT.LabelForeColour = Label1.ForeColor
   
   Call WritePrivateProfileStruct("MySection", "MySettings", _
      MyNewUDT, Len(MyNewUDT), App.Path & "\INITest.ini")

'File contents:
'[MySection]
'MySettings=4368726973746D61732020202020202020202020FF000000FFFF00000000FF000A
End Sub

Private Sub Form_Load() 'Load `em up...
   Dim MyNewUDT As MyUDT
      
   Call GetPrivateProfileStruct("MySection", "MySettings", _
      MyNewUDT, Len(MyNewUDT), App.Path & "\INITest.ini")

   Label1.Caption = MyNewUDT.Password
   Form1.BackColor = MyNewUDT.FormBackColour
   Label1.BackColor = MyNewUDT.LabelBackColour
   Label1.ForeColor = MyNewUDT.LabelForeColour

End Sub

[BrailleSchool]

object variable or with block variable not set

Public Sub FormColorScheme(frm As Form)
    Dim Ctrl As Control
    
    If FileExists(App.Path & "\Settings.ini") Then
        Call GetPrivateProfileStruct("ColorScheme", _
                                                   "ApplicationColorScheme", _
                                                   ColorScheme, _
                                                   Len(ColorScheme), _
                                                   App.Path & "\" & "Settings.ini")
        
        frm.BackColor = ColorScheme.lngBC
    
        [hl]If TypeOf Ctrl Is Label Then[/hl]
            With Ctrl
                .BackColor = ColorScheme.lngBC
                .ForeColor = ColorScheme.lngFC
            End With
        ElseIf TypeOf Ctrl Is ListView Then
            With Ctrl
                .BackColor = ColorScheme.lngBC
                .ForeColor = ColorScheme.lngFC
            End With
        ElseIf TypeOf Ctrl Is Calendar Then
            '
        End If
    End If
End Sub

[BrailleSchool]

i forgot something in my code and was doing it by memory, duh! the below works

Public Sub FormColorScheme(frm As Form)
    Dim Ctrl As Control
    
    If FileExists(App.Path & "\Settings.ini") Then
        Call GetPrivateProfileStruct("ColorScheme", _
                                                   "ApplicationColorScheme", _
                                                   udtColorScheme, _
                                                   Len(udtColorScheme), _
                                                   App.Path & "\" & "Settings.ini")
        
        frm.BackColor = udtColorScheme.lngBC
    
        For Each Ctrl In frm.Controls
            If TypeOf Ctrl Is Label Then
                With Ctrl
                    .BackColor = udtColorScheme.lngBC
                    .ForeColor = udtColorScheme.lngFC
                End With
            ElseIf TypeOf Ctrl Is ListView Then
                With Ctrl
                    .BackColor = udtColorScheme.lngBC
                    .ForeColor = udtColorScheme.lngFC
                End With
            ElseIf TypeOf Ctrl Is Calendar Then
                '
            End If
        Next Ctrl
    End If
End Sub

[HanneSThEGreaT]

Good code schoolbusdriver!
Unfortunately I can't add to your rep...

[schoolbusdriver]

Np probs HanneSThEGreaT . Now if only BrailleSchool thinks of that...

[BrailleSchool]

Np probs HanneSThEGreaT . Now if only BrailleSchool thinks of that...

i always rep
sending rep over now
didnt have time before now