modmenus.bas

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

    lv_txtForeColor = 2
    lv_txtBackColor = 3
    lv_txtGradientColor = 4
    lv_txtFontName = 5
    lv_txtFontSize = 6
    lv_txtMinFontSize = 7
    lv_txtWidth = 8
    lv_txtAlignment = 9
    lv_txtTip = 10
    lv_txtBold = 11
    lv_txtItalic = 12
    lv_txtUnderline = 13
    lv_txtNoScroll = 14
    lv_txtDisabled = 15
End Enum
Public Enum SidebarImgProps
    lv_imgImgID = 1
    lv_imgBackColor = 2
    lv_imgGradientColor = 3
    lv_imgWidth = 4
    lv_imgAlignment = 5
    lv_imgTip = 6
    lv_imgNoScroll = 7
    lv_imgTransparent = 8
    lv_imgDisabled = 9
End Enum
Public Enum MenuSepProps
    lv_sCaption = 0
    lv_sRaisedEffect = 1
End Enum
Public Enum FontTypeEnum
    lv_fAllFonts = 0
    lv_fTrueType = 1
    lv_fNonTrueType = 2
End Enum
Public Enum AlignmentEnum
    lv_TopOfMenu = 1
    lv_BottomOfMenu = 2
    lv_CenterOfMenu = 0
End Enum
Public Enum CstmMonth
    lv_cDefault = 0
    lv_cCalendarQuarter = 1
    lv_cFiscalQuarter = 2
End Enum
' ////////////// Used to set/reset HDC objects \\\\\\\\\\\\\\
Public Enum ColorObjects
    cObj_Brush = 0
    cObj_Pen = 1
    cObj_Text = 2
End Enum
' ////////////// Used when calling SetMenu \\\\\\\\\\\\\\
Public Enum SubClassContainers
    lv_NonMDIform = 0                               ' typical SDI form, no children
    lv_MDIform_ChildrenHaveMenus = 0       ' typical MDI form if children have their own menus (Default for MDI forms)
    lv_MDIform_ChildrenMenuless = 5          ' typical MDI form when no child forms have menus...
    ' note: all child forms subclassed automatically will have their property set to lv_MDIchildForm_NoMenus
    lv_VB_Toolbar = 1                                 ' typical standard toolbar
    lv_MDIchildForm_NoMenus = 4              ' MDI child form has no menus see above note
    lv_MDIchildForm_WithMenus = 3           ' MDI child form has menus (default for MDI child forms)
End Enum
    
' ///////////////// PROJECT-WIDE VARIABLES \\\\\\\\\\\\\\
Public DefaultIcon As Long ' used by associated user control
'======================================================================
' following variable will restore menu items back to their original status
' after subclassing has been terminated. Don't set this during runtime
' as it will unnecessarily reset menus when a form closes
Public AmInIDE As Boolean  ' used by associated user control
'======================================================================
'                              IMPORTANT
' Somewhere in your primary form, declare following variable to
' True or False
' Set the following constant to TRUE if you need to debug your code
' When set to true, forms are not subclassed
' When set to False, stopping your code will crash VB
'======================================================================
Public bAmDebugging As Boolean

' Types used to retrieve current menu item information from the
' cMenuItems class and returned to DoMeausreItem & DoDrawItem
Public XferMenuData As MenuComponentData
Public XferPanelData As PanelData
' for Win98/ME--they seem to add extra pixels to menus & we account for the difference
Private ExtraOffsetX As Integer
' storage of the 7 fonts used for menus. See: CreateDestroyMenuFont
Private m_Font(0 To 7)
' collection of subclassed forms
Private colMenuItems As Collection
' collection of displayed menu panels. Prevents reprocessing of items
Private OpenMenus As Collection
' used only for the custom font menu in cMenuItems class to retrieve font names
Private vFonts() As String
' handle to form which owns menu being displayed
Private hWndRedirect As String
' used for popups to positively identify owner of the popup menu
Private tempRedirect As Long    ' see: SetPopupParentForm
' used to determine highlighting of disabled items if selected by keyboard vs mouse
Private bKeyBoardSelect As Boolean
'////////////////////// Public Properties \\\\\\\\\\\\\\\\\
Private bHiLiteDisabled As Boolean  'see HighlightDisabledMenuItems
Private bItalicSelected As Boolean  'see ItalicizeSelectedItems
Private bGradientSelect As Boolean  'see HighlightGradient
Private mFontName As String         'see MenuFontName
Private mFontSize As Single         'see MenuFontSize
Private vMenuListBox As Long        'see MenuCaptionListBox
Private bReturnMDIkeystrokes As Boolean ' see ReturnMDIkeystrokes
Private bRaisedIcons As Boolean     'see RaisedIconOnSelect
Private bXPcheckmarks As Boolean  ' XP/Win2K style checks
    '/////////////////////// color options \\\\\\\\\\\\\\\\\\\\\\\\\
    Private bModuleInitialized As Boolean       '
    Private lSelectBColor As Long       'see SelectedItemBackColor
    Private TextColorNormal As Long
    Private TextColorSelected As Long
    Private TextColorDisabledDark As Long
    Private TextColorDisabledLight As Long
    Private TextColorSeparatorBar As Long
    Private SeparatorBarColorDark As Long
    Private SeparatorBarColorLight As Long
    Private CheckedIconBColor As Long
' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Private FloppyIcon As Long          'see GetFloppyIcon
Private tbarClass() As String       'see AddToolbarClass
' some menus could take time to display--the font custom menu, the drives
' custom menu if network drives exist, and file list menus where icon is
' retrieved from file's associated executable. So the user doesn't think
' their computer is slow or somethin' we will add an hourglass to these
' menu types and any menu that has 50 or more items. The hourglass will
' be reset once the menu has been displayed or the menu loop terminates
Private bUseHourglass As Boolean

Public Property Let MenuFontName(sFontName As String)
' =====================================================================
' by default, menu items have the system menu font name
' This property can change the font name to anything. Suggest setting this property in the first form that
' is displayed as each call to change the font name or font size will force the program to restore
' all menu items to non-owner drawn status which forces the program to remeasure each menu item again
' =====================================================================
    If Len(sFontName) > 0 And sFontName <> mFontName Then
        mFontName = sFontName
        ' here we destroy the previous memory fonts & recreate them using new font name
        CreateDestroyMenuFont False, False
        CreateDestroyMenuFont True, False
        If bItalicSelected Then CreateDestroyMenuFont True, True
        ' now we need to destroy our collection of processed menu items so they
        ' can be reprocessed and menu panels remeasured. Easier to delete the
        ' class but then we lose a bunch of variables we want to keep
        If Not colMenuItems Is Nothing Then
            Dim I As Integer
            For I = colMenuItems.Count To 1 Step -1
                colMenuItems(I).RestoreMenus
            Next
        End If
    End If
End Property

Public Property Get MenuFontName() As String
If mFontName = "" Then
    ' in order to set the font, we must first determine what it is
    Dim ncm As NONCLIENTMETRICS, I As Integer
    ncm.cbSize = Len(ncm)
    ' this will return the system menu font info
    SystemParametersInfo 41, 0, ncm, 0
    I = InStr(ncm.lfMenuFont.lfFaceName, Chr$(0))
    If I = 0 Then I = Len(ncm.lfMenuFont.lfFaceName) + 1
    mFontName = Left$(ncm.lfMenuFont.lfFaceName, I - 1)
    If mFontSize = 0 Then mFontSize = Abs(ncm.lfMenuFont.lfHeight) * 0.72
End If
MenuFontName = mFontName
End Property

Public Property Let MenuFontSize(NewSize As Single)
' =====================================================================
' by default, menu items have the system menu font size
' This property can change the font size to anything. Suggest setting this property in the first form that
' is displayed as each call to change the font name or font size will force the program to restore
' all menu items to non-owner drawn status which forces the program to remeasure each menu item again
' =====================================================================
    If NewSize <> mFontSize And NewSize > 0 Then
        mFontSize = NewSize
        ' here we destroy the previous memory fonts & recreate them using new font size
        CreateDestroyMenuFont False, False
        CreateDestroyMenuFont True, False
        If bItalicSelected Then CreateDestroyMenuFont True, True
        ' now we need to destroy our collection of processed menu items so they
        ' can be reprocessed and menu panels remeasured. Easier to destroy the
        ' class but then we lose a bunch of values we want to keep
        If Not colMenuItems Is Nothing Then
            Dim I As Integer
            For I = colMenuItems.Count To 1 Step -1
                colMenuItems(I).RestoreMenus
            Next
        End If
    End If
End Property
Public Property Get MenuFontSize() As Single
    MenuFontSize = mFontSize
End Property

Public Property Let MenuCaptionListBox(hWnd As Long)
' =====================================================================
' If menu captions are stored in a list box, that list box must be made
' available at all times. This property can be set ONLY ONCE. This is
' done to prevent using multiple listboxes which would inevitably lead
' to the wrong listbox being set at the wrong time and then the wrong
' captions being placed on a menu. If you tweak this, be very careful!
'
' One exception. If the original menu caption list box that was set
' previously is now closed 'cause its form is closed, it can be reset
' =====================================================================
If vMenuListBox Then
    If IsWindow(vMenuListBox) = 0 Then vMenuListBox = 0
End If
If Not vMenuListBox Then vMenuListBox = hWnd
End Property
Public Property Get MenuCaptionListBox() As Long
            MenuCaptionListBox = vMenuListBox
End Property

Public Property Let HighlightGradient(bGradient As Boolean)
' =====================================================================
' by default, menu items being highlighted are done so with a solid back color (system defined)
' This property can change it to highight with a gradient effect.
' The gradient is from "system back highlight" color to "menu backcolor" color (both are system defined)
' =====================================================================
    bGradientSelect = bGradient
End Property
Public Property Get HighlightGradient() As Boolean
    HighlightGradient = bGradientSelect
End Property

' =====================================================================
' All properties between these ======= symbos are menu item properties and are explained
' in more detail in the readme.html file

Public Property Get RaisedIconOnSelect() As Boolean
    RaisedIconOnSelect = bRaisedIcons
End Property
Public Property Let RaisedIconOnSelect(bYesNo As Boolean)
    bRaisedIcons = bYesNo
End Property
Public Property Get CheckMarksXPstyle() As Boolean
    CheckMarksXPstyle = bXPcheckmarks
End Property
Public Property Let CheckMarksXPstyle(bYesNo As Boolean)
    bXPcheckmarks = bYesNo
End Property

Public Property Get SelectedItemBackColor() As Long
    If Not bModuleInitialized Then LoadDefaultColors
    SelectedItemBackColor = lSelectBColor
End Property
Public Property Let SelectedItemBackColor(lColor As Long)
    If Not bModuleInitialized Then LoadDefaultColors
    lSelectBColor = ConvertColor(lColor)
End Property
Public Property Get SelectedItemTextColor() As Long
    If Not bModuleInitialized Then LoadDefaultColors
    SelectedItemTextColor = TextColorSelected
End Property
Public Property Let SelectedItemTextColor(lColor As Long)
    If Not bModuleInitialized Then LoadDefaultColors
    TextColorSelected = ConvertColor(lColor)
End Property
Public Property Get MenuItemTextColor() As Long
    If Not bModuleInitialized Then LoadDefaultColors
    MenuItemTextColor = TextColorNormal
End Property
Public Property Let MenuItemTextColor(lColor As Long)
    If Not bModuleInitialized Then LoadDefaultColors
    TextColorNormal = ConvertColor(lColor)
End Property