modmenus.bas

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

Public Property Get DisabledTextColor_Dark() As Long
    If Not bModuleInitialized Then LoadDefaultColors
    DisabledTextColor_Dark = TextColorDisabledDark
End Property
Public Property Let DisabledTextColor_Dark(lColor As Long)
    If Not bModuleInitialized Then LoadDefaultColors
    TextColorDisabledDark = ConvertColor(lColor)
End Property
Public Property Get DisabledTextColor_Light() As Long
    If Not bModuleInitialized Then LoadDefaultColors
    DisabledTextColor_Light = TextColorDisabledLight
End Property
Public Property Let DisabledTextColor_Light(lColor As Long)
    If Not bModuleInitialized Then LoadDefaultColors
    TextColorDisabledLight = ConvertColor(lColor)
End Property
Public Property Get SeparatorBarTextColor() As Long
    If Not bModuleInitialized Then LoadDefaultColors
    SeparatorBarTextColor = TextColorSeparatorBar
End Property
Public Property Let SeparatorBarTextColor(lColor As Long)
    If Not bModuleInitialized Then LoadDefaultColors
    TextColorSeparatorBar = ConvertColor(lColor)
End Property
Public Property Get SeparatorBarColor_Dark() As Long
    If Not bModuleInitialized Then LoadDefaultColors
    SeparatorBarColor_Dark = SeparatorBarColorDark
End Property
Public Property Let SeparatorBarColor_Dark(lColor As Long)
    If Not bModuleInitialized Then LoadDefaultColors
    SeparatorBarColorDark = ConvertColor(lColor)
End Property
Public Property Get SeparatorBarColor_Light() As Long
    If Not bModuleInitialized Then LoadDefaultColors
    SeparatorBarColor_Light = SeparatorBarColorLight
End Property
Public Property Let SeparatorBarColor_Light(lColor As Long)
    If Not bModuleInitialized Then LoadDefaultColors
    SeparatorBarColorLight = ConvertColor(lColor)
End Property
Public Property Get CheckedIconBackColor() As Long
    If Not bModuleInitialized Then LoadDefaultColors
    CheckedIconBackColor = CheckedIconBColor
End Property
Public Property Let CheckedIconBackColor(lColor As Long)
    If Not bModuleInitialized Then LoadDefaultColors
    CheckedIconBColor = ConvertColor(lColor)
End Property
' =====================================================================

Public Property Let ReturnMDIkeystrokes(bYesNo As Boolean)
' =====================================================================
' This property allows MD Parents to receive Key_Up & Key_Down events
' MDI parent when there are no MDI children opened. Otherwise, you
' should use the Key_Down events within the MDI child to trap keystrokes

' IMPORTANT SIDE NOTE: WinME users will not be able to use this property.
' completely. Per MSDN: the GetKeyState function has been disabled on ME only
' This will force the Shift parameter retunred in cTips MDIKeyDown & MDIKeyUp
' events to return the value of zero for each keystroke pressed
' =====================================================================
    bReturnMDIkeystrokes = bYesNo
End Property
Public Property Get ReturnMDIkeystrokes() As Boolean
    ReturnMDIkeystrokes = bReturnMDIkeystrokes
End Property

Public Property Let HighlightDisabledMenuItems(bHiLite As Boolean)
' =====================================================================
' By default, disabled items are highlighted in the following 2 cases.
' This flag will highlight disabled items in every case."
' 1. System Menu items
' 2. Items navigated via the keyboard
' =====================================================================
    bHiLiteDisabled = bHiLite
End Property
Public Property Get HighlightDisabledMenuItems() As Boolean
    HighlightDisabledMenuItems = bHiLiteDisabled
End Property

Public Property Let ItalicizeSelectedItems(bItalics As Boolean)
' =====================================================================
' This option will italicize items when they are highlighted
' =====================================================================
If bItalics = bItalicSelected Then Exit Property
    bItalicSelected = bItalics
    ' create italic fonts if needed (2 fonts created: 1:normal, italic font, 2:bold, italic font
    If bItalics Then CreateDestroyMenuFont True, True
End Property
Public Property Get ItalicizeSelectedItems() As Boolean
ItalicizeSelectedItems = bItalicSelected
End Property

Public Property Get Win98MEoffset() As Integer
' =====================================================================
' This read-only property passes back the extra pixels if system is Win98/ME. See DetermineOS
' =====================================================================
    Win98MEoffset = ExtraOffsetX
End Property
Public Function CreateTextSidebar(Caption As String, FontName As String, FontSize As Single, _
    Optional MinFontSize As Single = 9, Optional Bold As Boolean = False, Optional Underline As Boolean = False, _
    Optional Italic As Boolean = False, Optional ForeColor As Long, Optional Backcolor As Long = -1, Optional Gradient2ndColor As Long = vbNull, _
    Optional Width As Integer = 32, Optional Alignment As AlignmentEnum = lv_BottomOfMenu, _
    Optional NoShowIfScrolls As Boolean = False, Optional Tip As String, Optional AlwaysDisabled As Boolean) As String
' =====================================================================
' Function will create a text sidebar item with every option made available
' =====================================================================
Dim wCaption As String, sValue As String
If Caption = "" Then Caption = " "
If FontName = "" Then FontName = "Arial"
Caption = "{Sidebar|Text:" & Caption & "|Font:" & FontName
If FontSize < 9 Then wCaption = "|FSize:9" Else wCaption = "|FSize:" & FontSize
If MinFontSize Then wCaption = wCaption & "|MinFSize:" & MinFontSize
If Bold Then wCaption = wCaption & "|Bold"
If Underline Then wCaption = wCaption & "|Underline"
If Italic Then wCaption = wCaption & "|Italic"
If AlwaysDisabled Then wCaption = wCaption & "|SBDisabled"
wCaption = wCaption & "|FColor:" & ForeColor
wCaption = wCaption & "|BColor:" & Backcolor
If Gradient2ndColor <> vbNull Then wCaption = wCaption & "|GColor:" & Gradient2ndColor
If Width < 16 Then Width = 16
wCaption = wCaption & "|Width:" & Width
Select Case Alignment
    Case lv_TopOfMenu: wCaption = wCaption & "|Align:Top"
    Case lv_BottomOfMenu: wCaption = wCaption & "|Align:Bot"
    Case lv_CenterOfMenu: wCaption = wCaption & "|Align:Ctr"
End Select
If NoShowIfScrolls Then wCaption = wCaption & "|NoScroll"
If Len(Tip) Then Caption = Caption & "|Tip:" & Tip
CreateTextSidebar = Caption & wCaption & "}"
End Function

Public Function ChangeTextSidebar(CaptionNow As String, Property As SidebarTextProps, Optional newValue As Variant) As String
Dim sNewCaption As String, sValue As String, wCaption As String, sProp As String
' =====================================================================
' This function will add, modify or delete a specific flag/value in the text sidebar caption
' =====================================================================
ChangeTextSidebar = CaptionNow
If IsMissing(newValue) Then sProp = "" Else sProp = CStr(newValue)
Dim sParts(1 To 15) As String, sTarget As String
Dim I As Integer
For I = 1 To UBound(sParts)
    sTarget = Choose(I, "Text:", "FColor:", "BColor:", "GColor:", "Font:", "FSize:", "MinFSize:", "Width:", "Align:", "Tip", "Bold", "Italic", "Underline", "NoScroll", "SBDisabled")
    ReturnComponentValue CaptionNow, sTarget, sValue
    If Len(sValue) Then
        sParts(I) = sTarget
        If I < 11 Then sParts(I) = sParts(I) & sValue
        sParts(I) = sParts(I) & "|"
    Else
        sParts(I) = ""
    End If
Next
Select Case Property
Case lv_txtText
    sTarget = "Text:"
    If Len(sProp) = 0 Then sProp = " "
Case lv_txtForeColor
    sTarget = "FColor:"
    sProp = CStr(Val(sProp))
Case lv_txtBackColor
    If Len(sProp) = 0 Then sProp = vbNull Else sProp = CStr(Val(sProp))
    sTarget = "BColor:"
Case lv_txtGradientColor
    If Len(sProp) = 0 Then sProp = vbNull Else sProp = CStr(Val(sProp))
    sTarget = "GColor:"
Case lv_txtFontName
    If Len(sProp) = 0 Then sProp = "Tahoma"
    sTarget = "Font:"
Case lv_txtFontSize
    If Len(sProp) = 0 Then sProp = 9 Else sProp = CStr(Val(sProp))
    sTarget = "FSize:"
Case lv_txtMinFontSize
    If Len(sProp) = 0 Then
        sTarget = ""
        sParts(Property) = ""
    Else
        sProp = CStr(Val(sProp))
        sTarget = "MinFSize:"
    End If
Case lv_txtBold, lv_txtItalic, lv_txtUnderline, lv_txtNoScroll, lv_txtDisabled
    If Len(sProp) = 0 Then sProp = "False"
    If CBool(sProp) = False Then
        sParts(Property) = ""
    Else
        sParts(Property) = Choose(Property - 10, "Bold|", "Italic|", "Underline|", "NoScroll|", "SBDisabled|")
    End If
    sTarget = ""
Case lv_txtTip
    sTarget = "Tip:"
    If Len(sProp) = 0 Then sTarget = "": sParts(Property) = ""
Case lv_txtWidth
    If Val(sProp) < 35 Then sProp = 35
    sTarget = "Width:"
Case lv_txtAlignment
    sTarget = "Align:"
    Select Case sProp
    Case "1", "Top": sProp = "Top"
    Case "2", "Bot": sProp = "Bot"
    Case Else:
        sTarget = ""
        sParts(Property) = ""
    End Select
Case Else
    ChangeTextSidebar = CaptionNow
    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) & "}"
ChangeTextSidebar = "{Sidebar|" & wCaption
Erase sParts
'Debug.Print "Passed "; CaptionNow
'Debug.Print "Change "; ChangeTextSidebar
End Function

Public Function CreateImageSidebar(ImgType As MenuImageType, ImgID As String, _
    Optional Transparent As Boolean = False, Optional Backcolor As Long = -1, Optional Gradient2ndColor As Long = vbNull, _
    Optional Width As Integer = 32, Optional Alignment As AlignmentEnum, Optional NoShowIfScrolls As Boolean = False, _
    Optional Tip As String) As String
' =====================================================================
' This function will create a image sidebar and make every option available
' =====================================================================
Dim Caption As String, sValue As String
' we'll add the image.  The order is not important
If Len(ImgID) = 0 Then Exit Function
If (ImgType > lv_ImgListIndex - 1 And ImgType < lv_ImgControl + 1) Then
    If ImgType = lv_ImgListIndex Then sValue = "IMG:i" & ImgID Else sValue = "IMG:" & ImgID
    Caption = sValue
Else
    Exit Function
End If
If Transparent Then Caption = Caption & "|Transparent"
Caption = Caption & "|BColor:" & Backcolor
If Gradient2ndColor <> vbNull Then Caption = Caption & "|GColor:" & Gradient2ndColor
If Width < 32 Then Width = 32
Caption = Caption & "|Width:" & Width
Select Case Alignment
    Case 1: Caption = Caption & "|Align:Top"
    Case 2: Caption = Caption & "|Align:Bot"
    Case Else
End Select
If NoShowIfScrolls Then Caption = Caption & "|NoScroll"
If Len(Tip) Then Caption = Caption & "|Tip:" & Tip
CreateImageSidebar = "{Sidebar|" & Caption & "}"
End Function

Public Function ChangeImageSidebar(CaptionNow As String, Property As SidebarImgProps, Optional newValue As Variant) As String
Dim sNewCaption As String, sValue As String, wCaption As String, sProp As String
' =====================================================================
' This option will add, remove or modify a specific flag/value
' =====================================================================
ChangeImageSidebar = CaptionNow
If IsMissing(newValue) Then sProp = "" Else sProp = CStr(newValue)

Dim sParts(0 To 9) As String, sTarget As String
Dim I As Integer
For I = 1 To UBound(sParts)
    sTarget = Choose(I, "IMG:", "BColor", "GColor", "Width:", "Align:", "Tip:", "NoScroll", "Transparent", "SBDisabled")
    ReturnComponentValue CaptionNow, sTarget, sValue
    If Len(sValue) Then
        sParts(I) = sTarget
        If I < 7 Then sParts(I) = sParts(I) & sValue
        sParts(I) = sParts(I) & "|"
    Else
        sParts(I) = ""
    End If
Next