modmenus.bas

Address Book implemented in VB 6,can be use for storing person information

Select Case Property
Case lv_imgImgID
    sTarget = "IMG:"
    If Len(sProp) = 0 Then
        ChangeImageSidebar = ""
        Exit Function
    End If
Case lv_imgBackColor
    If Len(sProp) = 0 Then sProp = vbButtonFace Else sProp = CStr(Val(sProp))
    sTarget = "BColor:"
Case lv_imgGradientColor
    If Len(sProp) = 0 Then sProp = vbNull Else sProp = CStr(Val(sProp))
    sTarget = "GColor:"
Case lv_imgAlignment
    sTarget = "Align:"
    Select Case sProp
    Case "1", "Top": sProp = "Top"
    Case "2", "Bot": sProp = "Bot"
    Case Else:
        sTarget = ""
        sParts(Property) = ""
    End Select
Case lv_imgTip
    sTarget = "Tip:"
    If Len(sProp) = 0 Then sParts(Property) = "": sTarget = ""
Case lv_imgWidth
    If Val(sProp) < 32 Then sProp = 32 Else sProp = CStr(Val(sProp))
    sTarget = "Width:"
Case lv_imgNoScroll, lv_imgTransparent, lv_imgDisabled
    If Len(sProp) = 0 Then sProp = "False"
    If CBool(sProp) Then
        sParts(Property) = Choose(Property - 6, "NoScroll|", "Transparent|")
    Else
        sParts(Property) = ""
    End If
    sTarget = ""
End Select
If Len(sTarget) Then
    If Len(sProp) Then sParts(Property) = sTarget & sProp & "|" Else sParts(Property) = ""
End If
wCaption = ""
For I = 1 To UBound(sParts)
    wCaption = wCaption & sParts(I)
Next
If Len(wCaption) Then wCaption = Left$(wCaption, Len(wCaption) - 1) & "}"
ChangeImageSidebar = "{Sidebar|" & sNewCaption & wCaption
Erase sParts
'Debug.Print "Passed (image) "; CaptionNow
'Debug.Print "Change (image) "; ChangeImageSidebar
End Function

Public Function CreateSepartorBar(Optional Caption As String, Optional RaisedEffect As Boolean) As String
' =====================================================================
' This function will create a separtor bar and make every option available
' =====================================================================
Dim newCaption As String
If Len(Caption) = 0 Then newCaption = "-" Else newCaption = Caption
If Left(newCaption, 1) <> "-" Then newCaption = "-" & newCaption
If RaisedEffect Then newCaption = newCaption & "{Raised}"
CreateSepartorBar = newCaption
End Function

Public Function ChangeSepartorBar(CaptionNow As String, Property As MenuSepProps, Optional newValue As Variant)
Dim sNewCaption As String, sValue As String, wCaption As String, sProp As String
' =====================================================================
' This function will add, modify or remove a specific flag/value
' =====================================================================
SeparateCaption CaptionNow, sNewCaption, wCaption
If IsMissing(newValue) Then sProp = "" Else sProp = CStr(newValue)
Select Case Property
Case lv_sCaption
    If Len(sProp) = 0 Then sProp = "-"
    If Left(sProp, 1) <> "-" Then sProp = "-" & sProp
    ReturnComponentValue wCaption, "Raised", sValue
    If Len(sValue) Then sValue = "{Raised}"
    sNewCaption = sProp & sValue
Case lv_sRaisedEffect
    If sProp = "" Then sProp = "False"
    If CBool(sProp) Then sProp = "{Raised}" Else sProp = ""
    sNewCaption = sNewCaption & sProp
End Select
ChangeSepartorBar = sNewCaption
End Function

Public Function CreateMenuCaption(Caption As String, Optional ImgType As MenuImageType, _
    Optional ImgID As String, Optional NoTransparency As Boolean, Optional HotKey As String, _
    Optional BoldText As Boolean = False, Optional Tip As String, _
    Optional ListComboType As MenuCtrlType, Optional ListComboID As String, _
    Optional ListsFiles As Boolean, Optional FilesPath As String) As String
' =====================================================================
' This function will create a typical, non-sidebar, non-separator bar caption and make all options available
' =====================================================================
Dim wCaption As String, sValue As String
' we'll add the image if any.  The order is not important
If (ImgType > lv_ImgListIndex - 1 And ImgType < lv_ImgControl + 1) And Len(ImgID) > 0 Then
    If ImgType = lv_ImgListIndex Then sValue = "IMG:i" & ImgID Else sValue = "IMG:" & ImgID
    wCaption = sValue
End If
If NoTransparency Then
    If Len(wCaption) Then sValue = "|" Else sValue = ""
    wCaption = wCaption & sValue & "ImgBkg"
End If
If Len(HotKey) Then ' add the hot key if any
    If Len(wCaption) Then sValue = "|" Else sValue = ""
    wCaption = wCaption & sValue & "HotKey:" & HotKey
End If
If BoldText = True Then ' add the Default type text (bold)
    If Len(wCaption) Then sValue = "|" Else sValue = ""
    wCaption = wCaption & sValue & "Default"
End If
If ListsFiles Then
    If Len(wCaption) Then sValue = "|" Else sValue = ""
    wCaption = wCaption & "|Files:"
    If Len(FilesPath) Then wCaption = wCaption & FilesPath Else wCaption = wCaption & "-1"
End If
If Len(Tip) Then    ' add the Tip
    If Len(wCaption) Then sValue = "|" Else sValue = ""
    wCaption = wCaption & sValue & "Tip:" & Tip
End If                  ' add the listbox/combo box control reference if any
If (ListComboType = lv_ComboBox Or ListComboType = lv_ListBox) And Len(ListComboID) > 0 Then
    If Len(wCaption) Then sValue = "|" Else sValue = ""
    If ListComboType = lv_ComboBox Then sValue = sValue & "CB:" Else sValue = sValue & "LB:"
    wCaption = wCaption & sValue & ListComboID
End If
If Len(wCaption) Then wCaption = "{" & wCaption & "}"
CreateMenuCaption = Caption & wCaption
End Function

Public Function ChangeMenuCaption(CaptionNow As String, Property As MenuCaptionProps, Optional newValue As Variant) As String
' =====================================================================
' This function will add, remove or modify a specific flag/value from a typical menu caption
' =====================================================================
Dim sNewCaption As String, sValue As String, wCaption As String, sProp As String
Dim sParts(0 To 8) As String, sTarget As String
Dim I As Integer

If IsMissing(newValue) Then sProp = "" Else sProp = CStr(newValue)
ChangeMenuCaption = CaptionNow
sNewCaption = CaptionNow
SeparateCaption CaptionNow, sNewCaption, wCaption
For I = 1 To UBound(sParts)
    sTarget = Choose(I, "IMG:", "Default", "Tip:", "LB:", "CB:", "IMGBKG", "HotKey:", "Files:")
    ReturnComponentValue wCaption, sTarget, sParts(I)
    If Len(sParts(I)) Then sParts(I) = sTarget & sParts(I) & "|"
Next
Select Case Property
Case lv_Caption:
    sTarget = ""
    sNewCaption = newValue
Case lv_ImgID
    sTarget = "IMG:"
Case lv_Bold
    sTarget = ""
    If Len(sProp) = 0 Then sProp = "False"
    If CBool(sProp) Then sParts(Property) = "Default|" Else sParts(Property) = ""
Case lv_Tip:
    sTarget = "Tip:"
Case lv_ListBoxID
    sParts(Property + 1) = ""
    sTarget = "LB:"
Case lv_ComboxID
    sParts(Property - 1) = ""
    sTarget = "CB:"
Case lv_ShowIconBkg
    sTarget = ""
    If Len(sProp) = 0 Then sProp = "False"
    If CBool(sProp) Then sParts(Property) = "ImgBkg|" Else sParts(Property) = ""
Case lv_HotKey
    sTarget = "HotKey:"
Case lv_FilesPath
    If sProp = "" Then
        sParts(Property) = ""
        sTarget = ""
    Else
        sParts(Property) = sProp
        sTarget = "Files:"
    End If
Case Else
    If Len(wCaption) Then wCaption = Left$(wCaption, Len(wCaption) - 1) & "}"
    ChangeMenuCaption = sNewCaption & wCaption
    Exit Function
End Select
If Len(sTarget) Then
    If Len(sProp) Then sParts(Property) = sTarget & sProp & "|" Else sParts(Property) = ""
End If
wCaption = ""
For I = 1 To UBound(sParts)
    wCaption = wCaption & sParts(I)
Next
If Len(wCaption) Then wCaption = "{" & Left$(wCaption, Len(wCaption) - 1) & "}"
ChangeMenuCaption = sNewCaption & wCaption
Erase sParts
End Function

Public Function CreateLvColors(CaptionNow As String, Optional UserID As String, _
    Optional CheckedColor As Long = -1) As String
' =====================================================================
' This function will create the custom menu lvColors
' =====================================================================
CreateLvColors = BuildSimpleCustomMenu(CaptionNow, "lvColors:", UserID, CStr(CheckedColor))

End Function

Public Function CreateLvDrives(CaptionNow As String, Optional UserID As String, _
    Optional CheckedDrive As String = "-1") As String
' =====================================================================
' This function will create the custom menu lvDays
' =====================================================================
CreateLvDrives = BuildSimpleCustomMenu(CaptionNow, "lvDrives:", UserID, CStr(CheckedDrive))

End Function

Public Function CreateLvDaysOfWeek(CaptionNow As String, Optional UserID As String, _
    Optional CheckedDay As Integer = -1) As String
' =====================================================================
' This function will create the custom menu lvDays
' =====================================================================
CreateLvDaysOfWeek = BuildSimpleCustomMenu(CaptionNow, "lvDays:", UserID, CStr(CheckedDay))

End Function

Public Function CreateLvStates(CaptionNow As String, Optional UserID As String, _
    Optional CheckedState As String = "-1") As String
' =====================================================================
' This function will create the custom menu lvStates
' =====================================================================
CreateLvStates = BuildSimpleCustomMenu(CaptionNow, "lvStates:", UserID, CheckedState)

End Function

Public Function CreateLvMonths(CaptionNow As String, Optional UserID As String, _
     Optional CheckedMonth As Integer = -1, Optional Grouping As CstmMonth) As String
' =====================================================================
' This function will create the custom menu lvMonths
' =====================================================================
Dim newCaption As String, wCaption As String
Dim sValue As String, sCode As String
Dim ArrayIndex As Integer, I As Integer

sCode = "lvMonths:" & CheckedMonth
Select Case Grouping
Case lv_cCalendarQuarter
    sCode = sCode & ":Group:CYQtr"
Case lv_cFiscalQuarter
    sCode = sCode & ":Group:FYQtr"
Case Else
    sCode = sCode & ":Group:Default"
End Select
If Len(UserID) Then sCode = sCode & ":ID:" & UserID
SeparateCaption CaptionNow, newCaption, wCaption
ReturnComponentValue wCaption, "lvMonths:", sValue
If Len(sValue) Then
    wCaption = Trim(Replace$(wCaption, "lvMonths:" & sValue & "|", ""))
    wCaption = Trim(Replace$(wCaption, "lvMonths:" & sValue, ""))
End If
If Len(wCaption) Then
    wCaption = Replace$(wCaption, "{", "")
    wCaption = Replace$(wCaption, "}", "")
    If Left$(wCaption, 1) <> "|" Then wCaption = "|" & wCaption
    wCaption = "{" & sCode & wCaption & "}"
Else
    wCaption = "{" & sCode & "}"
End If
CreateLvMonths = newCaption & Replace$(wCaption, "||", "|")

End Function

Public Function CreateLvDaysOfMonth(CaptionNow As String, Optional UserID As String, _
    Optional Year As Integer = 0, Optional Month As Integer = 0, _
    Optional CheckedDate As Integer = -1) As String