cmenuitems.cls

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

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cMenuItems"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' ========================================================================
'  CLASS WHICH CREATES OWNER-DRAWN MENUS  AND STORES ALL ATTRIBUTES
' ========================================================================
'
' PROJECT NOT COMPATIBLE WITH WinNT 3.x
'___________________________________________________________________________________
' /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\
'
' Author:  Keith Fox, aka LaVolpe   [e-mail]
' Written the hard way -- line by line !
' Couldn't have done it without 100's of visits to MSDN and lots of crashes :)
' ------------- history of current version
' 10 Feb. Complete rewrite of project
' 15 Feb. Added 7 ready-to-use custom menus (CreateSubMenuCustom)
' 17 Feb. Added properties to modMenus:
'       -- MenuFontName to change submenu font
'       -- MenuFontSize to change submenu font size
'       -- HighlightGradient to offer a gradient highlighting scheme for selected menu items
'       -- HighlightDisabledMenuItems to always highlight selected disabled menu items
'       -- ItalicizeSelectedItems to italicize highlighted menu items
' 19 Feb. Added call to color dialog for custom menus lvColors
' 23 Feb. Added 7 custom menu creation functions
'       -- Added PopupMenuCustom function to allow custom menus as popups
'       -- Added CACHE flag
' 2 Mar. Bug found by me. GetMenuMetrix does not constantly test for the image
'       handle ref'd by the menu item caption. This causes problems because
'       the ImageList ExtractIcon function replaces existing handle with a new
'       one & program fails to draw menu icon 'cause it no longer exists.
'       Additionally, if user using a picBox, Image control, etc and changes
'       the contents of that control, this program will never know. The
'       fix is to test the menu icon every single time.
' 3 Mar. Bug found by me. ExtractIconEx(filename,0,smallimg,1) was returning a 32x32 icon
'       if found in filename. Documentation I read said if 0 was passed above, no icon
'       would be returned. Fix, replace 0 with variable and destroy the icon if returned
' 6 Mar. Bug found by Zhu Jinyong. Menu items, if only one on a multi-column menu
'       didn't display properly. This was fixed in the GetPanelMetrix routine
' 7 Mar. Bug found by George Aslanis. When MDI children had no menus, the menus on the
'       parent form would disappear if they were previously displayed in a popup. After further testing,
'       found that system menus were affected also. The bottom line is that the program could not
'       identify if child forms have menus. Per MSDN the GetMenuItemCount function is meaningless
'       for child forms; therefore I needed to force user to identify whether or not MDI children had menus
'       or not. This is now added as an optional parameter in the SetMenu function. See the Enumerator
'       declaration for ContainerType in modMenus for a description of the flags to use
' 10 Mar. Ongoing battle with owner-drawn separator bars not being remeasured by Windows
'       A final solution of sorts: kill all menu items & rebuild them when a user changes
'       menu font/size during runtime. Function RestoreMenus rewritten
'       - Related problem with Sidebars. Was storing widest menu item so separator bars would
'         be measured indirectly. Screwed up menus when toggling sidebar visibility on
'         scrolling menus. This related error also corrected: GetPanelMetrix
'       - hWndRedirect was not being reset in SetMenu if form was already subclassed.
'         This could cause errors when subclassing a mix-match of MDI child & non-MDI child forms
'       - Changed the way icons are extracted for custom menus containing files list.
'         Icons now displayed are exactly what Explorer would display: DrawMenuIcon
'         -- RaisedIconOnSelect gives icons a 3D look
'         -- SelectedItemBackColor allows custom back color selection for menu items
'         -- ReturnMDIkeystrokes gives MDI parents without loaded child forms a KeyUp & KeyDown event
'       - Added following function
'         -- SetMinMaxInfo to allow forms using SetMenu to restrict sizing of the form (bonus routine)
' 11 Mar. Tweaked routines to allow sidebars to be the 1st item in a list/combo box if desired. These
'           can also retain the check value if needed
'           -- Added another flag for sidebars: SBDisabled to force a sidebar to be disabled as disabling a
'              sidebar if in the list/combo box is not possible
'       - Exposed the following menu properties as new modMenus properties
'           -- CheckMarksXPstyle replaces Win95 checkmarks with WinXP/2K style
'           -- MenuItemTextColor is menu item forecolor when not selected
'           -- SelectedItemTextColor is menu item forecolor when selected
'           -- DisabledTextColor_Dark is disabled menu item shadow color
'           -- DisabledTextColor_Light is disabled menu item highlight color
'           -- SeparatorBarTextColor is text forecolor for sidebars with text
'           -- SeparatorBarColor_Dark is separator bar shadow color
'           -- SeparatorBarColor_Light is separator bar highlight color
'           -- CheckedIconBackColor is the rectangle background color for icons used as checkmarks
'12 Mar. Bug identified by Robert Greig. WinNT won't process accelerator keys. Fix is to process the
'           WM_MenuChar message. MenuMessages updated to process this message, and
'           GetPanelMetrix modified to track accelerator keys and new functions created to assist:
'           modMenus.IdentifyAccelerator & this class's ReturnAcceleratorKey
' Last Remarked/Updated: 11 Mar 03. Readme.html last updated 11 Mar 03
'___________________________________________________________________________________
' \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/

Option Explicit
Option Compare Text  ' we don't want to mess with case sensitivity

Private imgList As Control             ' handle to image list. Cached to pass to child classes, if any
Private PrevProc As Long               ' previous window procedure
Private TipCallBackProc As Long        ' whether or not tips will be displayed (set to false if not needed)
Private PrevTipCallBack As Long        ' allows user to toggle between two form's Tips class
Private hSysMenu As Long               ' System menu for this form
Private hMDIclient As Long             ' MDI Client window if parent is MDI
Private bMDI As Boolean                 ' class belongs to a MDI client window
Private bNoChildMenus As Boolean   ' child menus have no menus/MDI parent handles all menus
Private uMinMax As MINMAXINFO

' see Class Initialize routine for brief description
Private vItems() As MenuComponentData
Private vPanels() As PanelData
Private cItems As Collection
Private cPanels As Collection
Private gMenus As Collection

' //////// Constants & Types used only in this Class \\\\\\\\\\\
Private Const LB_GETTEXT         As Long = &H189
Private Const LB_GETTEXTLEN      As Long = &H18A
Private Type CHOOSECOLORSTRUCT      ' for the color dialog box
   lStructSize     As Long
   hwndOwner       As Long
   hInstance       As Long
   rgbResult       As Long
   lpCustColors    As Long
   Flags           As Long
   lCustData       As Long
   lpfnHook        As Long
   lpTemplateName  As String
End Type
Private Type MENUITEMINFO_string    ' save menu items as string vs byte arrays
     cbSize As Long
     fMask As Long
     fType As Long
     fState As Long
     wID As Long
     hSubMenu As Long
     hbmpChecked As Long
     hbmpUnchecked As Long
     dwItemData As Long
     dwTypeData As String
     cch As Long
End Type
' =====================================================================
' COMDLG32.DLL Function Calls << used for the lvColors custom menu
' =====================================================================
Private Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (lpcc As CHOOSECOLORSTRUCT) As Long
' =====================================================================
' MPR.DLL Function Calls << used for the lvDrives custom menu
' =====================================================================
Private Declare Function WNetGetConnection Lib "mpr.dll" Alias "WNetGetConnectionA" (ByVal lpszLocalName As String, ByVal lpszRemoteName As String, cbRemoteName As Long) As Long
' =====================================================================
' KERNEL32.DLL Function Calls << used for the lvDrives custom menu
' =====================================================================
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetLocaleInfoA Lib "kernel32" (ByVal lLCID As Long, ByVal lLCTYPE As Long, ByVal strLCData As String, ByVal lDataLen As Long) As Long
Private Declare Function GetUserDefaultLCID Lib "kernel32" () As Long
Private Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Private Declare Sub lstrcpyn Lib "kernel32" (ByVal strDest As String, ByVal strSrc As Any, ByVal lBytes As Long)
' =====================================================================
' VERSION.DLL Function Calls << used for the FILES: flag
' =====================================================================
Private Declare Function GetFileVersionInfo Lib "Version.dll" Alias "GetFileVersionInfoA" (ByVal sFile As String, ByVal lpIgnored As Long, ByVal lpSize As Long, ByVal lpBuf As Long) As Long
Private Declare Function GetFileVersionInfoSize Lib "Version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
Private Declare Function VerQueryValue Lib "Version.dll" Alias "VerQueryValueA" (ByVal lpBuf As Long, ByVal szReceive As String, lpBufPtr As Long, lLen As Long) As Long


Private FormHwnd As Long      ' form's handle. Cached for FormIndex routine
Private tipDefault As String  ' gMenu default tip from parent submenu

Public Sub InitializeSubMenu(hForm As Long, Optional oImgList As Control, _
                                            Optional CallBacks As Long, _
                                            Optional bNoSysMenu As Boolean, _
                                            Optional TimeConsumingMenu As Long = 0, _
                                            Optional DefaultTip As String, Optional Flags As Long = 0)
' ========================================================================
' Called when a form is being subclassed or a gMenu child class is being initialized
' ========================================================================
Dim sysMenu As Long
FormHwnd = hForm                                ' cache
' rerouting of cTips classes
If CallBacks Then
    ' cTips is being rerouted or intialized
    If CallBacks <> PrevTipCallBack Then
        ' we set the previous cTips reference, if any
        PrevTipCallBack = TipCallBackProc
        ' we set the current cTips reference
        TipCallBackProc = CallBacks                 ' cache
    End If
Else
    ' cTips is being routed back from a previous reRoute call
    TipCallBackProc = PrevTipCallBack
End If
If Not oImgList Is Nothing Then Set imgList = oImgList  ' imagelist to use, if any
' process the system menu if bNoSysMenu = False & not already processed
If hSysMenu = 0 And bNoSysMenu = False Then
    hSysMenu = GetSystemMenu(hForm, 0)
    If hSysMenu Then IsWindowList hSysMenu, True
End If
If TimeConsumingMenu Then
    ' some menus may take extra time to display like those that display the sample font or those that
    ' retrieve an icon from the file name or its associated application. If so, we'll add an hourglass
    ' icon when those submenus are about to be displayed.
    Dim mPanel As PanelData
    mPanel.Hourglass = True
    ReDim vPanels(0 To 1)
    vPanels(1) = mPanel
    cPanels.Add 1, "p" & TimeConsumingMenu
End If
' Except for the lvDrives custom menu, custom menus do not have tips. Therefore
' we supply the tip from the menu item displaying the custom menu
tipDefault = DefaultTip
' Note: Although changes incurred in this routine seem like it should effect any chlid classes, we don't have
' to be concerned because exisiting child classes are destroyed and re-created as needed.
'Debug.Print hForm; " initialzed with tips callback as "; Format(CallBacks, "True/False"); " toolbar="; IsToolbar
End Sub

Public Property Get MDIClient() As Long
' ========================================================================
' Returns/Sets of whether this form is a MDI Parent and hWnd of its Client
' ========================================================================
    MDIClient = hMDIclient
End Property
Public Property Let MDIClient(hWnd As Long)
    hMDIclient = hWnd
End Property

Public Property Get IsMDIclient() As Boolean
' ========================================================================
' Returns/Sets of whether this form is the MDI Parent's Client window
' ========================================================================
    IsMDIclient = bMDI
End Property
Public Property Let IsMDIclient(bYesNo As Boolean)
    bMDI = bYesNo
End Property

Public Property Get IsMenuLess() As Boolean
' ========================================================================
' Returns/Sets of whether this form is the MDI Parent's Client window
' ========================================================================
    IsMenuLess = bNoChildMenus
End Property
Public Property Let IsMenuLess(bYesNo As Boolean)
    bNoChildMenus = bYesNo
End Property