| |
 |
Visual Basic 5.0 Sample Coding/Documentation Style |
| |
Sample of a utility class used throughout the project. |
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "Strings"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Description = "This class implements a list of String, ID pairs"
Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
Attribute VB_Ext_KEY = "Collection" ,"IDString"
Attribute VB_Ext_KEY = "Member0" ,"IDString"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
'==========================================================================
' Strings.cls
'
' This class implements an array of string, ID pairs. It serves as a
' general purpose string array class
'
' You can construct an entire collection from a single string using
' the methods which add with delimiters.
'
' This is similar to a Dictionary which VB6 supports but is highly customized.
'
' astr.AddStrID "23{the string}43{string two}54{string3}"
' This adds 3 entries to the collection:
' ID=23 string=the string
' ID=43 string=string two
' ID=54 string=string3
' astr.Item(2).Str -> gets 'string two'
'
' astr.AddStrID "key1>23{the string}key2>43{string two}key3>54{string3}", True
' This adds 3 keyed entries to the collection:
' ID=23 key=key1 string=the string
' ID=43 key=key2 string=string two
' ID=54 key=key3 string=string3
' astr.Item("key3").Str -> gets 'string3'
'
' By Brent S.A. Cowgill
'==========================================================================
Rem INCLUDE IDString.cls
Rem INCLUDE vb_debug.bas
Rem INCLUDE vb_debug_pub.bas
Rem INCLUDE comctl32.ocx (Microsoft Windows Common Controls 5.0 SP2)
Rem INCLUDE vb_tools.bas
Rem INCLUDE vb_strings_pub.bas
Rem INCLUDE vb_strings.bas
Rem INCLUDE vb_str_pub.bas
Rem INCLUDE vb_str.bas
Rem INCLUDE vb_listbox.bas
Rem INCLUDE vb_listbox_pub.bas
Rem INCLUDE WinAPI_pub.bas
Rem INCLUDE vb_tools.bas
Rem INCLUDE vb_strings_pub.bas
Rem INCLUDE vb_strings.bas
Rem INCLUDE vb_str_pub.bas
Rem INCLUDE vb_str.bas
'=-------------------------------------------------------------------------
' Some Module Definitions
'--------------------------------------------------------------------------
Option Explicit
'==========================================================================
' Public Constants:
'==========================================================================
'==========================================================================
' Public Variables:
'==========================================================================
Public Key As String ' The Key string when a string list is part
of a colleciton
'==========================================================================
' Private Constants:
'==========================================================================
' Delimiter characters for creating a Strings collection from a single string
Const sz_cCommaDelimiter As String = "," ' T_()
Const sz_cDelimiter As String = "}" ' T_()
Const sz_cKeyDelimiter As String = ">" ' T_()
'==========================================================================
' Private Variables:
'==========================================================================
'local variable to hold collection
Private mCol As Collection
Private id_mDebug As Long ' Provide Storage for the DebugID
'==========================================================================
' Public Property Methods:
'==========================================================================
'--------------------------------------------------------------------------
' Public Property Get DebugID() As Long
'
' DebugID property for global collection of objects
'--------------------------------------------------------------------------
Public Property Get DebugID() As Long
DebugID = id_mDebug
End Property ' DebugID()
'--------------------------------------------------------------------------
' Public Property Get Delimiter() As String
'
' Returns the default delimiter character for the AddStrID() method
'--------------------------------------------------------------------------
Public Property Get Delimiter() As String
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print xx.Delimiter
Delimiter = sz_cDelimiter
End Property ' Delimiter()
'--------------------------------------------------------------------------
' Public Property Get KeyDelimiter() As String
'
' Returns the default Key delimiter character for the AddStrID() method
'--------------------------------------------------------------------------
Public Property Get KeyDelimiter() As String
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print xx.Delimiter
KeyDelimiter = sz_cKeyDelimiter
End Property ' KeyDelimiter()
'==========================================================================
' Public Methods:
'==========================================================================
'--------------------------------------------------------------------------
' Public Function Add(Key As String, szString As String, idItem As Long,
Optional sKey As String) As IDString' Public Sub DoIt()
'
' Add an IDString to the collection. You can add it to the end of the
collection
' or give it an index name with sKey
'
' Entry:
' szString The string to add to the collection
' idItem The ID to associate with the string
' sKey Optional key name for finding the item
'
' Exit:
' Returns the IDString that was added to the collection
'--------------------------------------------------------------------------
Public Function Add(ByVal szString As String, ByVal idItem As Long, Optional
ByVal sKey As String) As IDString
'create a new object
Dim objNewMember As IDString
Set objNewMember = New IDString
'set the properties passed into the method
objNewMember.Key = sKey
objNewMember.Str = szString
objNewMember.ID = idItem
On Error Resume Next
If Len(sKey) = 0 Then
mCol.Add objNewMember
Else
mCol.Add objNewMember, sKey
End If
On Error GoTo 0
If Err.Number <> 0 Then
Err.Raise Err.Number
End If
' return the object created
Set Add = objNewMember
Set objNewMember = Nothing
End Function ' Add()
'--------------------------------------------------------------------------
' Public Function AddIDS(ByRef ids As IDString, Optional ByVal sKey As String)
'
' Add an existing IDString to the collection.
' You can add it to the end of the collection
' or give it an index name with sKey
'
' Entry:
' ids The IDString to add to the collection
' sKey Optional key name for finding the item
'--------------------------------------------------------------------------
Public Function AddIDS(ByRef ids As IDString, Optional ByVal sKey As String)
ids.Key = sKey
On Error Resume Next
If Len(sKey) = 0 Then
mCol.Add ids
Else
mCol.Add ids, sKey
End If
On Error GoTo 0
If Err.Number <> 0 Then
Err.Raise Err.Number
End If
End Function ' AddIDS()
'--------------------------------------------------------------------------
' Public Function AddItem(ByVal szString As String, _
'
' Add a single IDString to the collection from a string.
' The string is made up of a key, ID number and string separated by
' delimiter characters. The key and Id is optional and assume default
' values if omitted.
' The default format of a Key, ID, String sequence is:
' Key>ID{String
'
' Entry:
' szString The string to parse and add to the collection
' bKeyed Flag set if key is present in szString. Default is false
' bTrim Flag set to trim white space around string before adding
' to the collection. Default true. If false then spaces are
' preserved
' szKeyDel The delimiter which marks the end of the key string
' if omitted then '>' is used
' szIDDel The delimiter that marks the end of the ID number.
' If omitted then the default for IDString is used '{'
' Exit:
' Returns a reference to the new IDString created and added to the collection
' Examples:
' astr.AddItem "23{the string"
' This adds one entry to the collection: ID=23 string=the string
'
' astr.AddItem "key1>23{the string", True
' This adds one entry to the collection: ID=23 key=key1 string=the string
' astr.Item("key1").Str -> gets 'the string'
'--------------------------------------------------------------------------
Public Function AddItem(ByVal szString As String, _
Optional bKeyed As Boolean = False, _
Optional bTrim As Boolean = True, _
Optional ByVal szKeyDel As String = sz_cKeyDelimiter, _
Optional ByVal szIDDel As String) As IDString
Dim szKey As String
Dim ids As New IDString
' If there's a key in the string, strip it off first
If bKeyed Then
If Len(szKeyDel) = 0 Then szKeyDel = sz_cKeyDelimiter
szKey = TakeToken(szString, szKeyDel)
End If
ids.SetStrID szString, bTrim, szIDDel
On Error Resume Next
AddIDS ids, szKey
On Error GoTo 0
If Err.Number <> 0 Then
Err.Raise Err.Number
End If
Set AddItem = ids
Set ids = Nothing
End Function ' AddItem()
'--------------------------------------------------------------------------
' Public Function AddStrID(ByVal szString As String, _
'
' Add a number of IDStrings to the collection from a string.
' The string is made up of keys, ID numbers and strings separated by
' delimiter characters. The keys and Id's are optional and assume default
' values if omitted.
' The default format of a Key, ID, String sequence is:
' Key>ID{String}
'
' Entry:
' szString The string to parse and add to the collection
' bKeyed Flag set if keys are present in szString. Default is false
' bTrim Flag set to trim white space around each string before adding
' to the collection. Default true. If false then spaces are
' preserved
' szDel The delimiter which marks the end of a Key, ID, String
' sequence in szString. If omitted, then '}' is used
' szKeyDel The delimiter which marks the end of the key string
' if omitted then '>' is used
' szIDDel The delimiter that marks the end of the ID number.
' If omitted then the default for IDString is used '{'
' Exit:
' Returns a count of the number of IDStrings that were added to the collection
' Examples:
' astr.AddStrID "23{the string}43{string two}54{string3}"
' This adds 3 entries to the collection:
' ID=23 string=the string
' ID=43 string=string two
' ID=54 string=string3
' astr.Item(2).Str -> gets 'string two'
'
' astr.AddStrID "key1>23{the string}key2>43{string two}key3>54{string3}", True,
True
' This adds 3 keyed entries to the collection:
' ID=23 key=key1 string=the string
' ID=43 key=key2 string=string two
' ID=54 key=key3 string=string3
' astr.Item("key3").Str -> gets 'string3'
'--------------------------------------------------------------------------
Public Function AddStrID(ByVal szString As String, _
Optional bKeyed As Boolean = False, _
Optional bTrim As Boolean = True, _
Optional ByVal szDel As String = sz_cDelimiter, _
Optional ByVal szKeyDel As String = sz_cKeyDelimiter, _
Optional ByVal szIDDel As String) As Long
Dim nc As Long
Dim sz As String
If Len(szDel) = 0 Then szDel = sz_cDelimiter
On Error Resume Next
Do While Len(szString)
' Get the first Key, ID, String sequence from the string
sz = TakeToken(szString, szDel)
' Add the Key, ID and String item to the collection
AddItem sz, bKeyed, bTrim, szKeyDel, szIDDel
If Err.Number = 0 Then
nc = nc + 1
Err.Number = 0
End If
Loop
AddStrID = nc ' return count of items added to collection
End Function ' AddStrID()
'--------------------------------------------------------------------------
' Public Property Get Item(vntIndexKey As Variant) As IDString
'
' Access to individual items in the collection. You can retrieve items
' by index number or by string Key
'
' Entry:
' vntIndexKey The index of an item or the key string that was used
' to add the item to the collection.
' Exit:
' Returns the IDString from the collection
'--------------------------------------------------------------------------
Public Property Get Item(vntIndexKey As Variant) As IDString
Attribute Item.VB_UserMemId = 0
'used when referencing an element in the collection
'vntIndexKey contains either the Index or Key to the collection,
'this is why it is declared as a Variant
'Syntax: Set foo = xx.Item(xyz) or Set foo = xx.Item(5)
On Error Resume Next
Set Item = mCol(vntIndexKey)
On Error GoTo 0
If Err.Number <> 0 Then
' Throw the error out of the function so the caller can handle it
Err.Raise Err.Number
End If
End Property ' Item()
'--------------------------------------------------------------------------
' Public Function Find(ByVal szItem As String) As IDString
'
' Find an entry in the list by looping through all entries.
'
' Entry:
' szItem The item to find in the list
' Exit:
' ids Returns a reference to the item within the list
'--------------------------------------------------------------------------
Public Function Find(ByVal szItem As String) As IDString
Dim ids As IDString
For Each ids In Me
If szItem = ids.Str Then
Set Find = ids
Exit Function
End If
Next
Set ids = Nothing
Set Find = ids
End Function ' Find()
'--------------------------------------------------------------------------
' Public Function FindIndex(ByVal szItem As String) As Long
'
' Find an entry in the list by looping through all entries. And return
' the Index of the entry found
'
' Entry:
' szItem The item to find in the list
' Exit:
' Returns the list index where the entry is located or a negative number
' if the item is not in the list
'--------------------------------------------------------------------------
Public Function FindIndex(ByVal szItem As String) As Long
Dim ids As IDString
Dim nix As Long
nix = 1 ' List indexing begins at one
For Each ids In Me
If szItem = ids.Str Then
FindIndex = nix
Exit Function
End If
nix = nix + 1
Next
Set ids = Nothing
FindIndex = -1
End Function ' FindIndex()
'--------------------------------------------------------------------------
' Public Function FindID(ByVal idItem As Long) As IDString
'
' Find an entry in the list with a matching ID by looping through all entries.
'
' Entry:
' idItem The ID to find in the list
' Exit:
' ids Returns a reference to the item within the list with a matching ID
'--------------------------------------------------------------------------
Public Function FindID(ByVal idItem As Long) As IDString
Dim ids As IDString
For Each ids In Me
If idItem = ids.ID Then
Set FindID = ids
Exit Function
End If
Next
Set ids = Nothing
Set FindID = ids
End Function ' FindID()
'--------------------------------------------------------------------------
' Public Function IsMember(vntIndexKey As Variant) As IDString
'
' Check if an index or Key can be used to retrieve a member of the list
'
' Entry:
' vntIndexKey The index of an item or the key string that was used
' to add the item to the collection.
' Exit:
' Returns a reference to the item matching the index or key or
' returns Nothing if there is nothing in the list matching
'--------------------------------------------------------------------------
Public Function IsMember(vntIndexKey As Variant) As IDString
On Error GoTo Handler
Set IsMember = mCol(vntIndexKey)
Exit Function
Handler:
Set IsMember = Nothing
End Function ' IsMember()
'--------------------------------------------------------------------------
' Public Function MinID() As long
'
' Find the minimum ID value in the string list by examining the whole list
'
' Exit:
' Returns the minimum ID value that an IDString member of the list has
'--------------------------------------------------------------------------
Public Function MinID() As Long
Dim ids As IDString
Dim idMin As Long
For Each ids In Me
idMin = Min(idMin, ids.ID)
Next
MinID = idMin
End Function ' MinID()
'--------------------------------------------------------------------------
' Public Function MaxID() As long
'
' Find the Maximum ID value in the string list by examining the whole list
'
' Exit:
' Returns the Maximum ID value that an IDString member of the list has
'--------------------------------------------------------------------------
Public Function MaxID() As Long
Dim ids As IDString
Dim idMax As Long
For Each ids In Me
idMax = Max(idMax, ids.ID)
Next
MaxID = idMax
End Function ' MaxID()
'--------------------------------------------------------------------------
' Public Property Get Count() As Long
'
' Get the count of items in the collection
'--------------------------------------------------------------------------
Public Property Get Count() As Long
'used when retrieving the number of elements in the
'collection. Syntax: Debug.Print xx.Count
Count = mCol.Count
End Property ' Count()
'--------------------------------------------------------------------------
' Public Sub Remove(vntIndexKey As Variant)
'
' Remove an item from the string collection
'
' Entry:
' vntIndexKey The index of an item or the key string that was used
' to add the item to the collection.
' Exit:
' The specified item is removed from the collection
'--------------------------------------------------------------------------
Public Sub Remove(vntIndexKey As Variant)
'used when removing an element from the collection
'vntIndexKey contains either the Index or Key, which is why
'it is declared as a Variant
'Syntax: xx.Remove(xyz)
mCol.Remove vntIndexKey
End Sub ' Remove()
'--------------------------------------------------------------------------
' Public Sub RemoveAll()
'
' Remove all items from the collection
'--------------------------------------------------------------------------
Public Sub RemoveAll()
Dim nix As Long
For nix = mCol.Count To 1 Step -1
Remove nix
Next nix
End Sub ' RemoveAll()
'--------------------------------------------------------------------------
' Public Sub RemoveFrom(ByRef lstsz As Strings, ByVal nRemove As Long)
'
' Remove some entries from another list and add them to my list
'
' Entry:
' lstsz The string list to remove entries from
' nRemove The number of entries to remove from the other list
'--------------------------------------------------------------------------
Public Sub RemoveFrom(ByRef lstsz As Strings, ByVal nRemove As Long)
Dim ids As IDString
If Not lstsz Is Nothing Then
For Each ids In lstsz
If nRemove > 0 Then
Me.Add ids.Str, ids.ID, ids.Key
lstsz.Remove ids.Key
nRemove = nRemove - 1
Else
Exit Sub
End If
Next
End If
End Sub ' RemoveFrom()
'--------------------------------------------------------------------------
' Public Sub Copy(ByRef lstsz As Strings)
'
' Make a complete copy of another string list
'
' Entry:
' lstsz The string list to make a copy of
' Exit:
' The entire contents of lstsz is added to the current string list
'--------------------------------------------------------------------------
Public Sub Copy(ByRef lstsz As Strings)
Dim ids As IDString
If Not lstsz Is Nothing Then
For Each ids In lstsz
Me.Add ids.Str, ids.ID, ids.Key
Next
End If
End Sub ' Copy()
'--------------------------------------------------------------------------
' Public Property Get NewEnum() As IUnknown
'
' This property is called behind the scenes when you issue a For each ... Next
' statement.
'
' Entry:
' Exit:
' Notes:
' Dim astr as New Strings
' ... add strings to collection
' Dim ids as IDString
' For Each ids In astr
' Next
'--------------------------------------------------------------------------
Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
'this property allows you to enumerate
'this collection with the For...Each syntax
Set NewEnum = mCol.[_NewEnum]
End Property ' NewEnum()
'--------------------------------------------------------------------------
' Public Function ToIDStr(ByRef ids As IDString, Optional ByVal bKeyed As
Boolean = False, Optional ByVal szKeyDel, Optional ByVal szIDDel, Optional ByVal
bIDs As Boolean = True) As String
'
' Assemble an IDString into a Key, ID and String for subsequent unpacking by
AddItem
'
' Entry:
' ids The IDString to pack into a string
' bKeyed Flag set if keys should be added to the string. Default is false
' bIDs Flag set if ID should be added to the string. Default is true
' szKeyDel The delimiter which marks the end of the key string
' if omitted then '>' is used
' szIDDel The delimiter that marks the end of the ID number.
' If omitted then the default for IDString is used '{'
' Exit:
' Returns a single string containing the Key, ID and String separated by
' the delimiter characters
'--------------------------------------------------------------------------
Public Function ToIDStr(ByRef ids As IDString, _
Optional ByVal bKeyed As Boolean = False, _
Optional ByVal bIDs As Boolean = True, _
Optional ByVal szKeyDel, _
Optional ByVal szIDDel) As String
ToIDStr = IIf(bIDs, ids.ToStr(szIDDel), ids.Str)
If bKeyed Then
If Len(szKeyDel) = 0 Then szKeyDel = sz_cKeyDelimiter
' User specified a delimiter that is present in the string, that's a problem
Debug.Assert InStr(ids.Str, szKeyDel) = 0
Debug.Assert InStr(ids.Key, szKeyDel) = 0
Debug.Assert InStr(CStr(ids.ID), szKeyDel) = 0
ToIDStr = ids.Key & szKeyDel & ToIDStr
End If
End Function ' ToIDStr()
'--------------------------------------------------------------------------
' Public Function ToStr(Optional ByVal szDelimiter = sz_cDelimiter) As String
'
' Assemble a IDString into a string for subsequent unpacking by SetStrID
'
' Entry:
' bKeyed Flag set if keys should be added to the string. Default is false
' bIDs Flag set if ID should be added to the string. Default is true
' szDel The delimiter which marks the end of the string
' szKeyDel The delimiter which marks the end of the key string
' if omitted then '>' is used
' szIDDel The delimiter that marks the end of the ID number.
' If omitted then the default for IDString is used '{'
' bFinalDelimiter Flag set true if szDel should be appended to the end
' of the string once complete
' Exit:
' Returns a single string containing the ID and string separated by
' the delimiter character
'--------------------------------------------------------------------------
Public Function ToStr(Optional ByVal bKeyed As Boolean = False, _
Optional ByVal bIDs As Boolean = True, _
Optional ByVal szDel As String = sz_cDelimiter, _
Optional ByVal szKeyDel As String = sz_cKeyDelimiter, _
Optional ByVal szIDDel As String, _
Optional ByVal bFinalDelimiter As Boolean = True) As String
Dim ids As IDString
For Each ids In mCol
If Len(ToStr) Then ToStr = ToStr & szDel ' Add an end of string delimiter
Dim sz As String
sz = Me.ToIDStr(ids, bKeyed, bIDs, szKeyDel, szIDDel)
' User specified a delimiter that is present in the string, key or ID number,
that's a problem
Debug.Assert InStr(sz, szDel) = 0
ToStr = ToStr & sz
Next
If Len(ToStr) And bFinalDelimiter Then ToStr = ToStr & szDel ' Add an end of
string delimiter
End Function ' ToStr()
'--------------------------------------------------------------------------
' Public Function KeysToStr(Optional ByVal szDel As String = sz_cDelimiter) As
String
'
' Assemble all the Keys in a string list into a delimited string
'
' Entry:
' szDel The delimiter which separates each Key in the string
' if none is provided then a comma is used by default
' Exit:
' Returns a single string containing the Key for each IDString in the
' list separated by the delimiter character
'--------------------------------------------------------------------------
Public Function KeysToStr(Optional ByVal szDel As String = sz_cCommaDelimiter)
As String
Dim ids As IDString
For Each ids In mCol
If Len(KeysToStr) Then KeysToStr = KeysToStr & szDel ' Add a delimiter
KeysToStr = KeysToStr & ids.Key
Next
End Function ' KeysToStr()
'--------------------------------------------------------------------------
' Public Function IDsToStr(Optional ByVal szDel As String = sz_cDelimiter) As
String
'
' Assemble all the IDs in a string list into a delimited string
'
' Entry:
' szDel The delimiter which separates each ID in the string
' if none is provided then a comma is used by default
' Exit:
' Returns a single string containing the ID for each IDString in the
' list separated by the delimiter character
'--------------------------------------------------------------------------
Public Function IDsToStr(Optional ByVal szDel As String = sz_cCommaDelimiter) As
String
Dim ids As IDString
For Each ids In mCol
If Len(IDsToStr) Then IDsToStr = IDsToStr & szDel ' Add a delimiter
IDsToStr = IDsToStr & ids.ID
Next
End Function ' IDsToStr()
'--------------------------------------------------------------------------
' Public Function GetSettings(ByVal szAppName As String, _
'
' This function adds IDStrings to the collection from a Registry string setting.
'
' Entry:
' See GetSetting in VB help for a description of these parameters:
' szAppName The application name
' szSection The registry section
' szKey The registry key to get the string array from
' See Strings.AddStrID for a description of the remaining parameters
' Exit:
' Returns the number of IDStrings added to the collection from the registry
' key specified
'--------------------------------------------------------------------------
Public Function GetSettings(ByVal szAppName As String, _
ByVal szSection As String, _
ByVal szKey As String, _
Optional bKeyed As Boolean = False, _
Optional bTrim As Boolean = True, _
Optional ByVal szDel As String = sz_cDelimiter, _
Optional ByVal szKeyDel As String = sz_cKeyDelimiter, _
Optional ByVal szIDDel As String) As Long
GetSettings = Me.AddStrID(GetSetting(szAppName, szSection, szKey), _
bKeyed, bTrim, szDel, szKeyDel, szIDDel)
End Function ' GetSettings()
'--------------------------------------------------------------------------
' Public Sub SaveSettings(ByVal szAppName As String, _
'
' This function saves the entire collection to a Registry string setting
'
' Entry:
' See SaveSetting in VB help for a description of these parameters:
' szAppName The application name
' szSection The registry section
' szKey The registry key to save the string array to
' See Strings.ToStr for a description of the remaining parameters
' Exit:
' The entire collection is saved as a string in the registry
'--------------------------------------------------------------------------
Public Sub SaveSettings(ByVal szAppName As String, _
ByVal szSection As String, _
ByVal szKey As String, _
Optional bKeyed As Boolean = False, _
Optional ByVal szDel As String = sz_cDelimiter, _
Optional ByVal szKeyDel As String = sz_cKeyDelimiter, _
Optional ByVal szIDDel As String)
Dim sz As String
Const bIDs As Boolean = True
sz = Me.ToStr(bKeyed, bIDs, szDel, szKeyDel, szIDDel)
SaveSetting szAppName, szSection, szKey, sz
End Sub ' SaveSettings()
'--------------------------------------------------------------------------
' Public Function LoadResStrings(ByVal idStart As Integer, _
'
' This function adds IDStrings to the collection from a sequence of resource ID'
s
'
' Entry:
' See LoadResString in VB help for a description of the ID parameters
' idStart The first ID to load into the String List
' idEnd Optional last ID to load. All intervening String IDs
' are loaded into the string list.
' See Strings.AddStrID for a description of the remaining parameters
' Exit:
' Returns the number of IDStrings added to the collection from the resource
' ID's specified
'--------------------------------------------------------------------------
Public Function LoadResStrings(ByVal idStart As Integer, _
Optional ByVal idEnd As Integer, _
Optional bKeyed As Boolean = False, _
Optional bTrim As Boolean = True, _
Optional ByVal szDel As String = sz_cDelimiter, _
Optional ByVal szKeyDel As String = sz_cKeyDelimiter, _
Optional ByVal szIDDel As String) As Long
If idEnd = 0 Then idEnd = idStart
Dim nc As Long
For idStart = idStart To idEnd
nc = nc + Me.AddStrID(LoadResString(idStart), _
bKeyed, bTrim, szDel, szKeyDel, szIDDel)
Next idStart
End Function ' LoadResStrings()
'--------------------------------------------------------------------------
' Public Sub CacheToDisk(ByVal szFileName As String, _
'
' Save the string list to a disk file for later restoration
'
' Entry:
' szFileName The file to store the string list in
' szComment A comment to appear in the file to describe its data
' szDescription A multi-line description to appear in the file for more
detail
' See Strings.ToStr for a description of the remaining parameters
' Notes:
' The current file contents will be cleared and will then contain
' the comment string on the first line and the string list items
' on the second line separated by the delimiters provided.
' After the second line the description will appear and can be multiple lines
'--------------------------------------------------------------------------
Public Sub CacheToDisk(ByVal szFileName As String, _
Optional ByVal szComment As String, _
Optional ByVal szDescription As String, _
Optional bKeyed As Boolean = False, _
Optional ByVal szDel As String = sz_cDelimiter, _
Optional ByVal szKeyDel As String = sz_cKeyDelimiter, _
Optional ByVal szIDDel As String)
Dim sz As String
Const bIDs As Boolean = True
sz = Me.ToStr(bKeyed, bIDs, szDel, szKeyDel, szIDDel)
' The string items shouldn't have any newline in them for proper operation
Debug.Assert Not bContainsAny(sz, vbCrLf)
On Error GoTo ErrorHandler
Dim idFile As Integer
idFile = FreeFile
Open szFileName For Output Access Write Lock Write As #idFile
Print #idFile, szComment
Print #idFile, sz
Print #idFile, szDescription
Close #idFile
ErrorHandler:
End Sub ' CacheToDisk()
'--------------------------------------------------------------------------
' Public Function CacheFromDisk(ByVal szFileName As String, _
'
' Load items into the string list from a disk file
'
' Entry:
' szFileName The File to load items from
' See Strings.AddStrID for a description of the remaining parameters
' Exit:
' Returns the number of IDStrings added to the collection from the file
' specified
'--------------------------------------------------------------------------
Public Function CacheFromDisk(ByVal szFileName As String, _
Optional bKeyed As Boolean = False, _
Optional bTrim As Boolean = True, _
Optional ByVal szDel As String = sz_cDelimiter, _
Optional ByVal szKeyDel As String = sz_cKeyDelimiter, _
Optional ByVal szIDDel As String) As Long
Dim szLine As String
On Error GoTo ErrorHandler
Dim idFile As Integer
idFile = FreeFile
Open szFileName For Input Access Read As #idFile
' The first line is a comment -- ignore it
Line Input #idFile, szLine
Debug.Print T_DBG("Loading String List from disk cache: " & szFileName & vbCrLf
& _
"Comment: " & szLine)
Line Input #idFile, szLine
CacheFromDisk = Me.AddStrID(szLine, bKeyed, bTrim, szDel, szKeyDel, szIDDel)
Close #idFile
ErrorHandler:
End Function ' CacheFromDisk()
'--------------------------------------------------------------------------
' Public Sub Dump(Optional ByVal szName As String, Optional ByVal bDetails As
Boolean = False, Optional ByVal szIndent As String)
'
' Dump a string collection to the immediate window
'
' Entry:
' szName The name of the string collection variable
' bDetails Set flag to show details about each string in the collection
' Defaults to false and shows each string on a single line
' szIndent The indent to preceed each line with
' Notes:
' Dump "astr"
'--------------------------------------------------------------------------
Public Sub Dump(Optional ByVal szName As String, Optional ByVal bDetails As
Boolean = False, Optional ByVal szIndent As String)
Dim ids As IDString
Dim szI As String
Dim nix As Long
Dim nTotal As Long
szI = szIndent & sz_gI
If Len(szName) = 0 Then szName = T_DBG("a Strings Collection")
Debug.Print szIndent & szName & T_DBG(" := { a Strings Collection")
DumpString T_DBG("Key"), Key, False, szI
DumpNum T_DBG("Count"), Count, szI
For Each ids In mCol
nix = nix + 1 ' Collection index starts at 1
If bDetails Then
ids.Dump nix, True, szI
Else
ids.DumpLine nix, szI
End If
If nix > 50 Then
Debug.Print T_DBG(szIndent & "And many more...")
Exit For
End If
Next
Debug.Print szIndent & T_DBG("} end Strings")
End Sub ' Dump()
'--------------------------------------------------------------------------
' Public Sub GetDiffs(ByRef lstszOld As Strings, _
'
' This method compares the Strings list against a previous saved copy
' and generates two lists containing the new and removed items.
'
' Entry:
' lstszOld A previous copy of the string list.
' Exit:
' lstszAdded This list will be filled with items currently in Me but
' not in lstszOld
' lstszRemoved This list will be filled with items in lstszOld but not
' currently in Me
'--------------------------------------------------------------------------
Public Sub GetDiffs(ByRef lstszOld As Strings, _
ByRef lstszAdded As Strings, _
ByRef lstszRemoved As Strings)
Dim ids As IDString
For Each ids In mCol
If lstszOld.IsMember(ids.Key) Is Nothing Then
lstszAdded.Add ids.Str, ids.ID, ids.Key
End If
Next
For Each ids In lstszOld
If Me.IsMember(ids.Key) Is Nothing Then
lstszRemoved.Add ids.Str, ids.ID, ids.Key
End If
Next
End Sub ' GetDiffs()
'--------------------------------------------------------------------------
' Public Sub LBMakeItem(ByRef szSelection As String, _
'
' Find a selection in the list and prepare it for addition to a list box
'
' Entry:
' szSelection The key or item from the list to add to a list box
' bKey Flag set true to put the IDString's key in the list's item
data
' The default is false which puts the IDString's ID into the
item data
' Note, if used, the Key string must be a number
' bIdx Flag set true to put the list index into the item data instead
of the
' IDString's ID or key, use this for Keys which are strings
' bShowID Flag set true to display the Key or ID in the list along with
' the string
' bReturnID Flag set true to interpret the szSelection as a Key or ID
instead
' of as the item string
' Exit:
' szSelection Will contain the string to put into the list box
' nix Will be filled with the ItemData to place in the list box
'--------------------------------------------------------------------------
Public Sub LBMakeItem(ByRef szSelection As String, _
ByRef nix As Long, _
Optional ByVal bKey As Boolean = False, _
Optional ByVal bIdx As Boolean = False, _
Optional ByVal bShowId As Boolean = False, _
Optional ByVal bReturnID As Boolean = False)
' Find the item in the list
Dim ids As IDString
nix = 0
If bReturnID Then
' If szSelection is a Key or ID
If bKey Then
' Search by Key name
Set ids = mCol.Item(szSelection)
ElseIf bIdx Then
' Search by List Item Index
nix = ToLong(szSelection)
Set ids = mCol.Item(nix)
Else
' Find the string with a matching ID value
Set ids = FindID(ToLong(szSelection))
End If
Else
' Else szSelection is the item string
Set ids = Find(szSelection)
End If
If ids Is Nothing Then
szSelection = Empty
Else
ids.LBMakeItem szSelection, nix, bKey, bIdx, bShowId
End If
End Sub ' LBMakeItem()
'--------------------------------------------------------------------------
' Public Sub LBFill(ByRef lb As Object, _
'
' This takes a string list and puts it into a combo box or list box.
'
' Entry:
' lb The list box to fill (or combo box)
' bKey Flag set true to put the IDString's key in the list's item data
' The default is false which puts the IDString's ID into the item
data
' Note, if used, the Key string must be a number
' bIdx Flag set true to put the list index into the item data instead of
the
' IDString's ID or key, use this for Keys which are strings
' bSelect Flag set true to select the first item in the list once its full
' bShowID Flag set true to display the Key or ID in the list along with
' the string
' bClear Flag set true to clear the list box before adding items
' bUnique Flag set true to ensure no duplicate entries are added to the
listbox
' Notes:
' OLBSelFill() is almost a clone of this function, if there's
' a bug here, there's probably one there too.
'--------------------------------------------------------------------------
Public Sub LBFill(ByRef lb As Object, _
Optional ByVal bKey As Boolean = False, _
Optional ByVal bIdx As Boolean = False, _
Optional ByVal bSelect As Boolean = True, _
Optional ByVal bShowId As Boolean = False, _
Optional ByVal bClear As Boolean = True, _
Optional ByVal bUnique As Boolean = False)
Dim ids As IDString
Dim idItem As Long
Dim nix As Long
Dim szItem As String
If bClear Then lb.Clear
For Each ids In mCol
nix = nix + 1 ' List is indexed starting at 1
idItem = nix
' Figure out what string to put into the list, adding the ID or Key if necessary
ids.LBMakeItem szItem, idItem, bKey, bIdx, bShowId
If bUnique Then
LBAddUnique lb, szItem, idItem
Else
lb.AddItem szItem
lb.ItemData(lb.NewIndex) = idItem
End If
Next
If bSelect And lb.ListCount > 0 Then
lb.ListIndex = 0
End If
End Sub ' LBFill()
'--------------------------------------------------------------------------
' Public Sub OLBSelFill(ByRef lb As Object, _
'
' This takes a string list and puts it into the selection list of an
' OrdListBox
'
' Entry:
' lb The list box to fill (or combo box)
' bKey Flag set true to put the IDString's key in the list's item data
' The default is false which puts the IDString's ID into the item
data
' Note, if used, the Key string must be a number
' bIdx Flag set true to put the list index into the item data instead of
the
' IDString's ID or key, use this for Keys which are strings
' bSelect Flag set true to select the first item in the list once its full
' bShowID Flag set true to display the Key or ID in the list along with
' the string
' bClear Flag set true to clear the list box before adding items
' bUnique Flag set true to ensure no duplicate entries are added to the
listbox
' Notes:
' LBFill() is almost a clone of this function, if there's
' a bug here, there's probably one there too.
'--------------------------------------------------------------------------
Public Sub OLBSelFill(ByRef lb As Object, _
Optional ByVal bKey As Boolean, _
Optional ByVal bIdx As Boolean = False, _
Optional ByVal bSelect As Boolean = True, _
Optional ByVal bShowId As Boolean = False, _
Optional ByVal bClear As Boolean = True, _
Optional ByVal bUnique As Boolean = False)
Dim ids As IDString
Dim idItem As Long
Dim nix As Long
Dim szItem As String
If bClear Then lb.SelClear
For Each ids In mCol
nix = nix + 1 ' List is indexed starting at 1
idItem = nix
' Figure out what string to put into the list, adding the ID or Key if necessary
ids.LBMakeItem szItem, idItem, bKey, bIdx, bShowId
If bUnique Then
OLBSelAddUnique lb, szItem, idItem
Else
lb.SelAddItem szItem
lb.SelItemData(lb.SelNewIndex) = idItem
End If
Next
If bSelect And lb.SelListCount > 0 Then
lb.SelListIndex = 0
End If
End Sub ' OLBSelFill()
'--------------------------------------------------------------------------
' Public Sub LBSelect(ByRef lb As Object, _
'
' This takes a lookup list and selects all corresponding items in the
' combo box or list box.
'
' Entry:
' lb The list box to select items in (or combo box)
' bItem Flag set true to locate items by string name false to search
' by ItemData
' bKey Flag set true to find ItemData by the IDString's key
' The default is false which finds ItemData using the IDString's ID
' Note, if used, the Key string must be a number
' bShow Flag set true to bring selected items into view as well as select
'--------------------------------------------------------------------------
Public Sub LBSelect(ByRef lb As Object, _
Optional ByVal bItem As Boolean = True, _
Optional ByVal bKey As Boolean = False, _
Optional ByVal bShow As Boolean = True)
Dim ids As IDString
Dim szItem As String
For Each ids In mCol
If bItem Then
szItem = ids.Str
Else
If bKey Then
szItem = ids.Key
Else
szItem = ids.ID
End If
End If
LBSelectItemOrData lb, szItem, bItem, bShow
Next
End Sub ' LBSelect()
'--------------------------------------------------------------------------
' Public Sub LBGetSelected(ByRef lb As Object, _
'
' This takes combo box or list box and adds all the selected entries
' or all the entries and adds them to the string list
'
' Entry:
' lb The list box to get items from (or combo box)
' bID Flag set true to put the ItemData in the ID
' bKey Flag set true to put the ItemData in the Key
' bAll Flag set true to get all items in the list, not just the
' selected items
' bStripTab Flag set true if the list entries consist of an ID, tab,
' then the string and thus need the tab removed
' Notes:
' OLBItemGetSelected() is almost a clone of this function, if there's
' a bug here, there's probably one there too.
'--------------------------------------------------------------------------
Public Sub LBGetSelected(ByRef lb As Object, _
Optional ByVal bID As Boolean = True, _
Optional ByVal bKey As Boolean = False, _
Optional ByVal bAll As Boolean = False, _
Optional ByVal bStripTab As Boolean = False)
With lb
Dim nix As Long
Dim idItem As Long
Dim szKey As String
Dim szItem As String
For nix = 0 To .ListCount - 1
If .Selected(nix) Or bAll Then
idItem = IIf(bID, .ItemData(nix), 0)
szKey = IIf(bKey, CStr(.ItemData(nix)), Empty)
szItem = .List(nix)
If bStripTab Then
TakeToken szItem, vbTab
End If
If bKey Then
Add szItem, idItem, szKey
Else
Add szItem, idItem
End If
End If
Next nix
End With
End Sub ' LBGetSelected()
'--------------------------------------------------------------------------
' Public Sub OLBItemGetSelected(ByRef lb As Object, _
'
' This takes an OrdListBox and adds all the selected entries in the item
' list or all the entries and adds them to the string list
'
' Entry:
' lb The OrdListBox to get items from
' bID Flag set true to put the ItemData in the ID
' bKey Flag set true to put the ItemData in the Key
' bAll Flag set true to get all items in the list, not just the
' selected items
' bStripTab Flag set true if the list entries consist of an ID, tab,
' then the string and thus need the tab removed
' Notes:
' LBGetSelected() is almost a clone of this function, if there's
' a bug here, there's probably one there too.
'--------------------------------------------------------------------------
Public Sub OLBItemGetSelected(ByRef lb As Object, _
Optional ByVal bID As Boolean = True, _
Optional ByVal bKey As Boolean = False, _
Optional ByVal bAll As Boolean = False, _
Optional ByVal bStripTab As Boolean = False)
With lb
Dim nix As Long
Dim idItem As Long
Dim szKey As String
Dim szItem As String
For nix = 0 To .ItemListCount - 1
If .ItemSelected(nix) Or bAll Then
idItem = IIf(bID, .ItemItemData(nix), 0)
szKey = IIf(bKey, CStr(.ItemItemData(nix)), Empty)
szItem = .ItemList(nix)
If bStripTab Then
TakeToken szItem, vbTab
End If
If bKey Then
Add szItem, idItem, szKey
Else
Add szItem, idItem
End If
End If
Next nix
End With
End Sub ' OLBItemGetSelected()
'==========================================================================
' Private Methods:
'==========================================================================
'--------------------------------------------------------------------------
' Private Sub Class_Initialize()
'
' Class constructor
'--------------------------------------------------------------------------
Private Sub Class_Initialize()
Class_Initialize:
' Register myself in the global collection of objects
id_mDebug = DebugIDRegister(T_VB("Strings"))
' Handle class initialization here
Debug.Print T_DBG("Strings.Initialize()")
'creates the collection when this class is created
Set mCol = New Collection
End Sub ' Class_Initialize()
'--------------------------------------------------------------------------
' Private Sub Class_Terminate()
'
' Class destructor
'--------------------------------------------------------------------------
Private Sub Class_Terminate()
Class_Terminate:
' We can't let any errors propagate out or the app will terminate hard!
On Error GoTo ErrorHandler
' Handle class termination here
Debug.Print T_DBG("Strings.Terminate()")
'destroys collection when this class is terminated
Set mCol = Nothing
ErrorHandler:
On Error Resume Next
' Remove myself from the global collection of objects
DebugIDUnRegister id_mDebug
End Sub ' Class_Terminate()
|
