Attribute VB_Name = "modInit"
Option Explicit
Option Compare Text

Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpSectionName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpSectionName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long

'
'   Purpose: Saves any Form's position in a private ini called <ProgramName>.ini in the program's application path/folder
'   Assumes: Form size limits (Min/Max) are coded in the main program's Form_Resize events, and Normal 'windowstate' at save time
'   Usage:   (a) DoIniForm Form1        RESTORES Form's size/position, place in Form_Load event
'   Usage:   (b) DoIniForm Form1, True  SAVES Form's size/position, place in Form_UnLoad event)
'
Public Sub DoIniForm(ByRef frm As Form, Optional ByVal WriteMode As Boolean = False)
    Dim s As String, arr As Variant, KeyName As String, ret As Long
    On Error Resume Next
    
    Err.Clear                                       ' Ensure we don't croak on any pre-existing error
    KeyName = "Pos" & frm.Name                      ' Use the incoming form name to create a unique KeyName
    If WriteMode Then                               ' If 'writing' the Form position to ini, is easy.
        If frm.WindowState = 0 Then                 ' Check we are saving a 'Normal' form position
            s = frm.Left & "," & frm.Top & "," & frm.Width & "," & frm.Height
            ret = WritePrivateProfileString("Default", KeyName, s, (LCase(App.Path & "\" & App.EXEName) & ".ini"))
        End If
    Else
        s = String(256, Chr(0))                     ' Define buffer and read the ini file entry into it.
        ret = GetPrivateProfileString("Default", KeyName, "", s, 256, (LCase(App.Path & "\" & App.EXEName) & ".ini"))
        s = Trim(Left$(s, ret))                     ' Remove trailing nulls and any spaces from the entry.
        If UBound(Split(s, ",")) <> 3 Then          ' Check string contains 4 'comma separated' items, if it
            s = Screen.Width * 0.1 & ","            ' doesn't, the entry is null (first time used) or corrupt.
            s = s & Screen.Height * 0.1 & ","       ' So make up a first time startup size of approx 80% of
            s = s & Screen.Width * 0.8 & ","        ' The current machines screen resolution
            s = s & Screen.Height * 0.8
        End If
        arr = Split(s, ",")                         ' Split the entry into an array (Left, Top, Width, Height)
        If frm.WindowState = 0 Then                 ' If form state currently normal, apply the size/position data
            If frm.BorderStyle = 1 Then             ' If a fixed size form then
                frm.Left = Val(arr(0))              ' only move the window to the saved position
                frm.Top = Val(arr(1))               ' (we do not resize width/height)
            Else                                    ' otherwise execute the normal 'move' to restore the forms size/position
                frm.Move arr(0), arr(1), arr(2), arr(3)
            End If
        End If
    End If
    If Err Then                                     ' Ensure we know about it if we ever get an error
        MsgBox "Error " & Str(Err) & " in DoIniForm()" & vbCrLf & Error, vbCritical, " Error"
    End If
    DoEvents
    
End Sub


'   Purpose: Simple Saving/Restoring values for variables OR Control values in a 'one section' [Default] private ini file.
'   myKey (keyname) can be empty for controls, a keyname will be deduced from the control's name, (accepts control arrays).
'   myValue (KeyValue) is value of variable or name of the passed control, the value (and keyname if myKey not passed) will be deduced.
'   WriteMode is optionally set to (default) False to 'Read' the ini file. Set to True to 'Write' the myValue to the ini file
'   DefVal is optionally passed for 'reading' (WriteMode=False) as the required 'default value' when the ini entry is empty.
'
'   Example usage with 'Controls' (Optionally, keyName is declared a name or "". If its "" then a unique keyName is deduced
'
'   DoIni "", mnSettings(3)                     ' Restore a Menu.checked value, using 'derived' keyname (Default will be False)
'   DoIni "", mnSettings(3), False, True        ' Restore a Menu.checked value, using 'derived' keyname declaring Default=True
'   DoIni "", txtPort, False, "25"              ' Restore a TextBox.Text value, using 'derived' keyname and Default="25"
'   DoIni "", chkOnTop, True                    ' Save a CheckBox.value, let Sub 'derive' a unique keyname
'   DoIni "", txtCompanyName, True              ' Save a TextBox value, and let 'derive' the keyname
'
'   Example usage with 'Variables' -
'
'   DoIni "FormHeight", sHeight                 ' Restore a Variables value, using 'defined' keyname
'   DoIni "FormHeight", sHeight, False, "15"    ' Restore a Variables value, using 'defined' keyname and Default=15
'   DoIni "FormHeight", SHeight, True           ' Save a Variables value, using 'defined' keyname
'
'   Note. (a) Name of ini file is the programs exe name, (b) all entries written under [Default] section
'
'
Public Sub DoIni(ByVal myKey As String, ByRef myValue, Optional ByVal WriteMode As Boolean = False, Optional ByRef DefVal As Variant)
    Dim buf As String, iniFileName As String, ln As Long, tmp As Variant, Key$, KeyParam, ct As Byte
    Err.Clear                                           ' We are using on error resume so kill any existing errors
    On Error Resume Next                                ' Set error trapping method to Resume Next
    iniFileName = App.Path & "\" & App.EXEName & ".ini" ' Define the ini file to use <ProgramName>.ini
    Key = myValue.Name                                  ' Test if the 'value' passed 'has a name'
    If Err Then                                         ' If it doesn't, its a variable
        If Err = 424 Then Err.Clear                     ' clear the error and continue
    Else                                                ' If is had a name, set ct to identify control type
        If TypeOf myValue Is Menu Then                  ' where 0=Var 1=Menu, 2=Checkbox, 3=textbox, 4=Caption
            ct = 1                                      ' Its a menu
        ElseIf TypeOf myValue Is CheckBox Then          '
            ct = 2                                      ' Its a CheckBox
        ElseIf TypeOf myValue Is TextBox Then           '
            ct = 3                                      ' Its a TextBox
        ElseIf TypeOf myValue Is Label Then             '
            ct = 4                                      ' Its a Label
        End If
        KeyParam = CStr(myValue.Index)                  ' Attempt to get an index
        If Err Then                                     ' If its an error, its a
            If Err = 343 Then Err.Clear                 ' Control so clear error
        End If                                          ' else its a 'Control Array', & KeyParam contains the Index
        If myKey = "" Then myKey = Key & KeyParam       ' If myKey not passed, set to the 'deduced' name
    End If
'
'   At this point, we now have the 'logical' KeyName to use (whether it was 'passed' or 'deduced'),
'   the 'value' to 'save' when writing, or the 'var' or 'control name' to assign the value to if 'reading'
'
    If WriteMode Then                                   ' If we are 'Saving (writing) the values,
        Select Case ct                                  ' then if its a control,
            Case 1: myValue = myValue.Checked           ' use the Checked property for Menus
            Case 2: myValue = myValue.Value             ' use the Value property for Checkboxes, otherwise
        End Select                                      ' use the var, or control's 'default property' value
        If IsNull(myValue) Then                         ' Translate any incoming Null
            buf = ""                                    ' character to a 'Null String'
        ElseIf CStr(myValue) = "False" Then             ' Translate any Boolean variant
            buf = "0"                                   ' from False to zero
        ElseIf CStr(myValue) = "True" Then              ' and translate any True
            buf = "-1"                                  ' value to -1
        Else                                            ' Otherwise just save the
            buf = CStr(myValue)                         ' text value we have.
        End If
        
        ln = WritePrivateProfileString("Default", _
                    myKey, buf, iniFileName)            ' Write the buffer value to 'keyName'
        
    Else
    
        buf = String(8192, Chr(0))                      ' Create a big 8192 byte buffer
        ln = GetPrivateProfileString("Default", _
                myKey, "", buf, 8192, iniFileName)      ' Get value using keyName
        tmp = Left$(buf, ln)                            ' Remove any nulls
        If Len(tmp) = 0 Then                            ' If the returned value is empty
            If Not IsMissing(DefVal) Then               ' use any 'Default value'
                tmp = DefVal                            ' that was passed, otherwise use a
            Else                                        ' suitable default based on control type
                tmp = Choose(ct + 1, "", False, 0, "", "", "")
            End If
        End If
        Select Case ct                                  ' Use 'ct' to apply value to correct property
            Case 1: myValue.Checked = tmp               ' Menu
            Case 2: myValue.Value = tmp                 ' Checkbox
            Case 3: myValue.Text = tmp                  ' Textbox
            Case 4: myValue.Caption = tmp               ' Label
            Case Else: myValue = tmp                    ' Vars (and other controls)
        End Select
    End If

    If Err Then                                         ' Issue an Error message if a problem occurred
        MsgBox "Error in DoIni() - Name was " & _
                myKey & " Deduced name was " & _
                Key & KeyParam & "  Error was: " & _
                Error, vbCritical, " Error"
        Err.Clear
    End If

    DoEvents                                            ' Give windows time, this function will be called successively

End Sub




