GFRecentString/GFRecentStringmod.bas

Attribute VB_Name = "GFRecentStringmod"
Option Explicit
'(c)2001 by Louis. Use to save strings related to a combo box in registry
'to avoid that the user has to re‑entering recent strings.
'
'NOTE: the strings of a control are stored in one GFRecentStringControlStructVar.
'But not only the strings but also a related frequency is stored.
'The frequency is initialized to 16 when a new string is added.
'Every time ? the frequency is decreased by one. If a string frequency is 0
'then the string will never appear in the control anymore.
'If the string is added again, its frequency is increased by one.
'
'GFRecentStringControlStruct[From/To]Reg() load/saved one single
'GFRecentStringControlStructVar.
'
'GFRecentStringControlStruct_Load() verifies a special
'GFRecentStringControlStructVar is currently located within the global array.
'
'GFRecentStringControlStruct_Sort() sorts the recent strings of one
'GFRecentStringControlStructVar so that the most frequent one appears first in the array.
'
'GFRecentStringStruct ‑ general information
Private Type GFRecentStringStruct
    RegMainKey As Long
    RegRootKey As String
    RecentStringNumberMax As Integer
End Type
Dim GFRecentStringStructVar As GFRecentStringStruct
'GFRecentStringControlStruct ‑ stored strings of one control
Private Type GFRecentStringControlStruct
    ControlName As String
    ControlStringNumber As Integer
    ControlStringArray() As String
    ControlStringFrequencyArray() As Integer
End Type
Dim GFRecentStringControlStructNumber As Integer
Dim GFRecentStringControlStructArray() As GFRecentStringControlStruct

Public Sub GFRecentString_Initialize(ByVal RegMainKey As Long, ByVal RegRootKey As String, ByVal RecentStringNumberMax As Integer)
    'on error resume next
    'verify
    If Not (Right$(RegRootKey, 1) = "\") Then RegRootKey = RegRootKey + "\"
    Select Case RecentStringNumberMax
    Case Is < 1
        RecentStringNumberMax = 1
    Case Is > 32766
        RecentStringNumberMax = 32766
    End Select
    'begin
    GFRecentStringStructVar.RegMainKey = RegMainKey
    GFRecentStringStructVar.RegRootKey = RegRootKey + "GFRecentString\"
    GFRecentStringStructVar.RecentStringNumberMax = RecentStringNumberMax
End Sub

Public Sub GFRecentString_ReceiveString(ByVal ControlName As String, ByVal ControlString As String)
    'on error resume next
    Dim StructIndex As Integer
    Dim StringLoop As Integer
    'preset
    Call GFRecentStringControlStruct_Load(ControlName)
    StructIndex = GetGFRecentStringControlStructIndex(ControlName)
    If StructIndex = 0 Then 'verify
        If Not (GFRecentStringControlStructNumber = 32766) Then 'verify
            GFRecentStringControlStructNumber = GFRecentStringControlStructNumber + 1
            ReDim Preserve GFRecentStringControlStructArray(1 To GFRecentStringControlStructNumber) As GFRecentStringControlStruct
            StructIndex = GFRecentStringControlStructNumber
        Else
            MsgBox "internal error in GFRecentString_ReceiveString(): overflow !", vbOKOnly + vbExclamation
            Exit Sub
        End If
    End If
    'begin
    For StringLoop = 1 To GFRecentStringControlStructArray(StructIndex).ControlStringNumber
        If GFRecentStringControlStructArray(StructIndex).ControlStringArray(StringLoop) = ControlString Then
            GoTo Jump:
        End If
    Next StringLoop
    GFRecentStringControlStructArray(StructIndex).ControlStringNumber = GFRecentStringControlStructArray(StructIndex).ControlStringNumber + 1
    StringLoop = GFRecentStringControlStructArray(StructIndex).ControlStringNumber
    ReDim Preserve GFRecentStringControlStructArray(StructIndex).ControlStringArray(1 To GFRecentStringControlStructArray(StructIndex).ControlStringNumber) As String
    ReDim Preserve GFRecentStringControlStructArray(StructIndex).ControlStringFrequencyArray(1 To GFRecentStringControlStructArray(StructIndex).ControlStringNumber) As Integer
    GFRecentStringControlStructArray(StructIndex).ControlStringArray(StringLoop) = ControlString
    GFRecentStringControlStructArray(StructIndex).ControlStringFrequencyArray(StringLoop) = 16 'avoid new entry appears at list end
Jump:
    GFRecentStringControlStructArray(StructIndex).ControlStringFrequencyArray(StringLoop) = _
        GFRecentStringControlStructArray(StructIndex).ControlStringFrequencyArray(StringLoop) + 1
    Call GFRecentStringControlStruct_Save(ControlName)
End Sub

Public Sub GFRecentString_UpdateComboBox(ByVal ControlName As String, ByRef ControlObject As ComboBox)
    'on error resume next
    Dim ControlObjectTextUnchanged As String
    Dim StructIndex As Integer
    Dim StringLoop As Integer
    'preset
    Call GFRecentStringControlStruct_Load(ControlName)
    Call GFRecentStringControlStruct_Sort(ControlName)
    StructIndex = GetGFRecentStringControlStructIndex(ControlName)
    If StructIndex = 0 Then
        ControlObjectTextUnchanged = ControlObject.TEXT
        ControlObject.Clear 'clear combo box list
        ControlObject.TEXT = ControlObjectTextUnchanged
        Exit Sub 'error
    End If
    'reset
    ControlObjectTextUnchanged = ControlObject.TEXT
    ControlObject.Clear
    'begin
    For StringLoop = 1 To GFRecentStringControlStructArray(StructIndex).ControlStringNumber
        ControlObject.List(StringLoop ‑ 1) = GFRecentStringControlStructArray(StructIndex).ControlStringArray(StringLoop)
    Next StringLoop
    ControlObject.TEXT = ControlObjectTextUnchanged
End Sub

Public Sub GFRecentString_Reset(ByVal ControlName As String)
    'on error resume next
    '
    'NOTE: the TargetProject can call GFRecentString_UpdateComboBox()
    'to display the changes immediately.
    '
    Call GFRecentStringControlStruct_Remove(ControlName)
    Call Rmod.RegDeleteKey(GFRecentStringStructVar.RegMainKey, GFRecentStringStructVar.RegRootKey + ControlName) 'to hell with it!
End Sub

Private Sub GFRecentStringControlStruct_Load(ByVal ControlName As String)
    'on error resume next
    Dim StructIndex As Integer
    Dim StringLoop As Integer
    Dim TempGFRecentStringControlStruct As GFRecentStringControlStruct
    'preset
    StructIndex = GetGFRecentStringControlStructIndex(ControlName)
    If (StructIndex) Then Exit Sub 'nothing to do
    'begin
    TempGFRecentStringControlStruct = GFRecentStringControlStructFromReg(ControlName)
    If Not (GFRecentStringControlStructNumber = 32766) Then 'verify
        GFRecentStringControlStructNumber = GFRecentStringControlStructNumber + 1
    Else
        MsgBox "internal error in GFRecentStringControlStruct_Load(): overflow !", vbOKOnly + vbExclamation
        Exit Sub 'error
    End If
    ReDim Preserve GFRecentStringControlStructArray(1 To GFRecentStringControlStructNumber) As GFRecentStringControlStruct
    GFRecentStringControlStructArray(GFRecentStringControlStructNumber) = TempGFRecentStringControlStruct
End Sub

Private Sub GFRecentStringControlStruct_Remove(ByVal ControlName As String)
    'on error resume next
    Dim StructIndex As Integer
    Dim StructLoop As Integer
    'preset
    StructIndex = GetGFRecentStringControlStructIndex(ControlName)
    If (StructIndex) Then Exit Sub 'nothing to do
    'begin
    For StructLoop = StructIndex To GFRecentStringControlStructNumber
        If Not (StructLoop = GFRecentStringControlStructNumber) Then
            GFRecentStringControlStructArray(StructLoop) = GFRecentStringControlStructArray(StructLoop + 1)
        Else
            GFRecentStringControlStructNumber = GFRecentStringControlStructNumber ‑ 1
            StructLoop = GFRecentStringControlStructNumber
            If StructLoop < 1 Then StructLoop = 1 'verify
            ReDim Preserve GFRecentStringControlStructArray(1 To StructLoop) As GFRecentStringControlStruct
            Exit For 'important
        End If
    Next StructLoop
End Sub

Private Sub GFRecentStringControlStruct_Sort(ByVal ControlName As String)
    'on error resume next
    Dim StructIndex As Integer
    Dim RecentStringFrequencyMax As Integer
    Dim Loop1 As Integer
    Dim Loop2 As Integer
    Dim Temp As Long
    Dim Tempstr$
    'preset
    StructIndex = GetGFRecentStringControlStructIndex(ControlName)
    If StructIndex = 0 Then Exit Sub 'nothing to do
    'begin
    Loop2 = 1 'preset
    Do
        RecentStringFrequencyMax = 0 'reset
        If Loop2 > GFRecentStringControlStructArray(StructIndex).ControlStringNumber Then Exit Do
        For Loop1 = Loop2 To GFRecentStringControlStructArray(StructIndex).ControlStringNumber
            If GFRecentStringControlStructArray(StructIndex).ControlStringFrequencyArray(Loop1) > RecentStringFrequencyMax Then
                RecentStringFrequencyMax = GFRecentStringControlStructArray(StructIndex).ControlStringFrequencyArray(Loop1)
            End If
        Next Loop1
        For Loop1 = Loop2 To GFRecentStringControlStructArray(StructIndex).ControlStringNumber
            If GFRecentStringControlStructArray(StructIndex).ControlStringFrequencyArray(Loop1) = RecentStringFrequencyMax Then
                If Not (Loop1 = Loop2) Then 'verify there's s.th. to exchange
                    Tempstr$ = GFRecentStringControlStructArray(StructIndex).ControlStringArray(Loop1)
                    Temp = GFRecentStringControlStructArray(StructIndex).ControlStringFrequencyArray(Loop1)
                    GFRecentStringControlStructArray(StructIndex).ControlStringArray(Loop1) = GFRecentStringControlStructArray(StructIndex).ControlStringArray(Loop2)
                    GFRecentStringControlStructArray(StructIndex).ControlStringFrequencyArray(Loop1) = GFRecentStringControlStructArray(StructIndex).ControlStringFrequencyArray(Loop2)
                    GFRecentStringControlStructArray(StructIndex).ControlStringArray(Loop2) = Tempstr$
                    GFRecentStringControlStructArray(StructIndex).ControlStringFrequencyArray(Loop2) = Temp
                End If
                Loop2 = Loop2 + 1
                Exit For
            End If
        Next Loop1
    Loop
    If GFRecentStringControlStructArray(StructIndex).ControlStringNumber > GFRecentStringStructVar.RecentStringNumberMax Then
        'kick away surplus strings that were never used
        GFRecentStringControlStructArray(StructIndex).ControlStringNumber = GFRecentStringStructVar.RecentStringNumberMax
        ReDim Preserve GFRecentStringControlStructArray(StructIndex).ControlStringArray(1 To GFRecentStringStructVar.RecentStringNumberMax) As String
        ReDim Preserve GFRecentStringControlStructArray(StructIndex).ControlStringFrequencyArray(1 To GFRecentStringStructVar.RecentStringNumberMax) As Integer
    End If
End Sub

Private Sub GFRecentStringControlStruct_Save(ByVal ControlName As String)
    'on error resume next
    Dim StructIndex As Integer
    Dim TempGFRecentStringControlStruct As GFRecentStringControlStruct
    'preset
    StructIndex = GetGFRecentStringControlStructIndex(ControlName)
    If StructIndex = 0 Then Exit Sub 'nothing to do
    'begin
    Call GFRecentStringControlStructToReg(GFRecentStringControlStructArray(StructIndex))
End Sub

Private Sub GFRecentStringControlStructToReg(ByRef GFRecentStringControlStructVar As GFRecentStringControlStruct)
    'on error resume next
    Dim RegMainKey As Long
    Dim RegRootKey As String
    Dim Temp As Long
    'preset
    RegMainKey = GFRecentStringStructVar.RegMainKey
    RegRootKey = GFRecentStringStructVar.RegRootKey
    Call Rmod.RegDeleteSubKey(RegMainKey, RegRootKey + GFRecentStringControlStructVar.ControlName)
    Call Rmod.RegCreateSubKey(RegMainKey, RegRootKey + GFRecentStringControlStructVar.ControlName)
    'begin
    Call Rmod.RegSetKeyValue(RegMainKey, RegRootKey + GFRecentStringControlStructVar.ControlName, "control name", CVar(GFRecentStringControlStructVar.ControlName), REG_SZ)
    For Temp = 1 To GFRecentStringControlStructVar.ControlStringNumber
        Call Rmod.RegSetKeyValue(RegMainKey, RegRootKey + GFRecentStringControlStructVar.ControlName, "control string " + LTrim$(Str$(Temp)), CVar(GFRecentStringControlStructVar.ControlStringArray(Temp)), REG_SZ)
        Call Rmod.RegSetKeyValue(RegMainKey, RegRootKey + GFRecentStringControlStructVar.ControlName, "control string frequency " + LTrim$(Str$(Temp)), CVar(GFRecentStringControlStructVar.ControlStringFrequencyArray(Temp)), REG_SZ)
    Next Temp
End Sub

Private Function GFRecentStringControlStructFromReg(ByVal ControlName As String) As GFRecentStringControlStruct
    'on error resume next 'if no data has been saved for the passed control then .RecentStringNumber will be 0
    Dim RecentString As String
    Dim RecentStringFrequency As Integer
    Dim Temp As Long
    'begin
    GFRecentStringControlStructFromReg.ControlName = ControlName
    For Temp = 1 To 32766
        '
        Rmod.RegGetKeyValueErrorFlag = False 'reset
        RecentString = Rmod.RegGetKeyValue(GFRecentStringStructVar.RegMainKey, GFRecentStringStructVar.RegRootKey + ControlName, "control string " + LTrim$(Str$(Temp)))
        If Rmod.RegGetKeyValueErrorFlag = True Then Exit For 'verify
        Rmod.RegGetKeyValueErrorFlag = False 'reset
        RecentStringFrequency = Val(Rmod.RegGetKeyValue(GFRecentStringStructVar.RegMainKey, GFRecentStringStructVar.RegRootKey + ControlName, "control string frequency " + LTrim$(Str$(Temp))))
        If Rmod.RegGetKeyValueErrorFlag = True Then Exit For 'verify
        '
        GFRecentStringControlStructFromReg.ControlStringNumber = GFRecentStringControlStructFromReg.ControlStringNumber + 1
        ReDim Preserve GFRecentStringControlStructFromReg.ControlStringArray(1 To GFRecentStringControlStructFromReg.ControlStringNumber) As String
        ReDim Preserve GFRecentStringControlStructFromReg.ControlStringFrequencyArray(1 To GFRecentStringControlStructFromReg.ControlStringNumber) As Integer
        '
        GFRecentStringControlStructFromReg.ControlStringArray(GFRecentStringControlStructFromReg.ControlStringNumber) = RecentString
        GFRecentStringControlStructFromReg.ControlStringFrequencyArray(GFRecentStringControlStructFromReg.ControlStringNumber) = RecentStringFrequency
        '
    Next Temp
End Function

Private Function GetGFRecentStringControlStructIndex(ByVal ControlName As String) As Integer
    'on error resume next 'returns index or 0 for error
    Dim StructLoop As Integer
    'begin
    For StructLoop = 1 To GFRecentStringControlStructNumber
        If GFRecentStringControlStructArray(StructLoop).ControlName = ControlName Then
            GetGFRecentStringControlStructIndex = StructLoop 'ok
            Exit Function
        End If
    Next StructLoop
    GetGFRecentStringControlStructIndex = 0 'error
    Exit Function
End Function


[END OF FILE]