CodeItBetter Programming Another VB Programming Blog

'Forms - How to make a preferences Form

Option Explicit
 
'This code will show you how to make easily Preferences form, where the user can
'choose his options in Text Boxes, Check Boxes, Option Buttons and Combo Boxes.
'All the option wll be saved to INI File, and you will be able to get them easily from
'anywhere in your project. This Code is written in a way that you can easily add
'to the preferences form many options to choose from, without adding too much line codes.
'Add two forms to your project. Add 2 Command Buttons to Form1.
'Add one Check Box to Form2, a Combo Box, a Text Box And Array of Option Buttons (Option1(0), Option1(1) and so on).
'Add 2 Command Buttons and name them OKButton and CancelButton,
'Add some items to the Combo Box list.

Public INIFileName As String
'Enter here your Application name
Public Const MyAppName = "Test App Name"
'Declare here one variable for every control you have in the preferences form.
'this variable will store the control value. If the control is Option Box or Check Box
Public Option1Var As String * 3, Text1Var As String * 15, Check1Var As String * 3, Combo1Var As String * 15
Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" _
    (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, _
    ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" _
    (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, _
    ByVal lpFileName As String) As Long
 
Function ReadFromINIToVariables()
'Add here one line for each control in the preferences form. Each line code below get the
'Value from the INI file and store it in the according variable, so you will be able to get
'the Perferences values from every part of your program.
'You should add your code line like that:
'Result = GetPrivateProfileString(MyAppName, Your Control Name, 'The Default Value If No Data has Found, The Variable To store in it the control value, 'Len(The Variable), INIFileName)
    result = GetPrivateProfileString(MyAppName, "Option1", "0", Option1Var, Len(Option1Var), INIFileName)
    result = GetPrivateProfileString(MyAppName, "Text1", "", Text1Var, Len(Text1Var), INIFileName)
    result = GetPrivateProfileString(MyAppName, "Check1", "0", Check1Var, Len(Check1Var), INIFileName)
    result = GetPrivateProfileString(MyAppName, "Combo1", "", Combo1Var, Len(Combo1Var), INIFileName)
End Function
 
'Add the following code to Form1

'Press Command1 to launch the preferences from.
Private Sub Command1_Click()
'This code line will assure that all the project will be disable until the preferences
'form will be through.
    Form2.Show vbModal
End Sub
 
'Press Command2 to get the preferences values
Private Sub Command2_Click()
    MsgBox "Text1 = " & Text1Var
    MsgBox "Combo1 = " & Combo1Var
    MsgBox "Option1 = " & Option1Var
    MsgBox "Check1 = " & Check1Var
End Sub
 
'Put here your INI File Name
Private Sub Form_Load()
    INIFileName = App.path & "\" & "TestFile.ini"
    'This line store the perferences values inside the variables
    ReadFromINIToVariables
End Sub
 
'Add the following code to Form2

Function OptionStartData()
    'This will center your preferences form on the screen
    Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
    'This will place the current preferences in the controls
    ReadFromINIToControls
End Function
 
Private Sub CancelButton_Click()
    Unload Me
End Sub
 
Private Sub Form_Load()
    OptionStartData
End Sub
 
Function SaveFromControlsToINI()
    Dim Contrl As Control
    Dim TempControlName As String, TempControlValue As String
    On Error Resume Next
    For Each Contrl In Me
        If (TypeOf Contrl Is CheckBox) Or (TypeOf Contrl Is ComboBox) Then
            TempControlName = Contrl.Name
            TempControlValue = Contrl.Value
            If (TypeOf Contrl Is ComboBox) Then
                TempControlValue = Contrl.Text
                If TempControlValue = "" Then TempControlValue = 1
            End If
            result = WritePrivateProfileString(MyAppName, TempControlName, TempControlValue, INIFileName)
        End If
        If (TypeOf Contrl Is TextBox) Then
            TempControlName = Contrl.Name
            TempControlValue = Contrl.Text
            result = WritePrivateProfileString(MyAppName, TempControlName, TempControlValue, INIFileName)
        End If
        If (TypeOf Contrl Is OptionButton) Then
            TempControlValue = Contrl.Value
            If TempControlValue = True Then
                TempControlName = Contrl.Name
                TempControlValue = Contrl.Index
                result = WritePrivateProfileString(MyAppName, TempControlName, TempControlValue, INIFileName)
            End If
        End If
    Next
End Function
 
Private Sub OKButton_Click()
    SaveFromControlsToINI
    ReadFromINIToVariables
    Unload Me
End Sub
 
Function ReadFromINIToControls()
    Dim Contrl As Control
    Dim TempControlName As String * 30, TempControlValue As String * 20
    On Error Resume Next
    For Each Contrl In Me
        If (TypeOf Contrl Is CheckBox) Or (TypeOf Contrl Is ComboBox) Or (TypeOf Contrl Is OptionButton) Or (TypeOf Contrl Is TextBox) Then
            TempControlName = Contrl.Name
            If (TypeOf Contrl Is TextBox) Or (TypeOf Contrl Is ComboBox) Then
                result = GetPrivateProfileString(MyAppName, TempControlName, "", TempControlValue, Len(TempControlValue), INIFileName)
            Else
                result = GetPrivateProfileString(MyAppName, TempControlName, "0", TempControlValue, Len(TempControlValue), INIFileName)
            End If
            If (TypeOf Contrl Is OptionButton) Then
                If Contrl.Index = Val(TempControlValue) Then Contrl = True
            Else
                Contrl = TempControlValue
                If (TypeOf Contrl Is ComboBox) Then
                    If Len(Contrl.Text) = 0 Then Contrl.ListIndex = 0
                End If
            End If
        End If
    Next
End Function