modmenus.bas

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

Attribute VB_Name = "modMenus"
Option Explicit
Option Compare Text
'
' PROJECT NOT COMPATIBLE WITH WinNT 3.x
'
' Read the HowTo files provided. This is a quick summary.
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
'  HIGHLIGHTS / IMPROVEMENTS
' - Icons/bitmaps can be displayed on each menu item, even submenus of submenus
' - Sidebars can display text or images and are now clickable if enabled
' - Sidebars can be hidden if a menu scrolls (see how scrolling menus affect sidebars in the HowTo files
' - Sidebar images that are bitmaps can be made transparent
' - Sidebar gradient backgrounds now more flexible and can be applied to image sidebars also
' - 3 properties added to modMenus:
'   -- 1. Highlight menu items with a gradient back color
'   -- 2. Always highlight disabled items
'   -- 3. Change highlighted menu item's font to italics
' - Contents of listboxes/comboboxes can be dynamically included in menus
'   -- selecting one of these menu items will update the listbox/combobox control
'   -- these can be referenced by handle or control name
'   -- owner-drawn listbox/combobox controls not supported at this time
' - Separator bars can have text and can be displayed with a sunken/raised effect
' - All images can be referenced by control name, image list index, or image handle
' - Menu help tips now imitate tooltips
' - All known memory leaks tracked down and put to death
' - 6 ready-to-use custom menus provided: Fonts,Days of Week,Days of Month,Months of Year,Colors,U.S. States
' - OPTIONAL user control provided to permit viewing of graphical menus in designed mode (IDE)
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
' To use the graphical menus, two types of forms need to be subclassed.
' 1. SDI Forms (non-MDI forms)
' 2. MDI Parent forms only; their children are automatically subclassed when parent is
'  One function call does it all:  SetMenu form.hwnd, [ImageList], [Tips Options]  -- see that function
'  Popups should always call the SetPopupParentForm routine before calling any popup commands
'  see that routine for more information or read the notes below.
'  Forms automatically un-subclassed when form closes
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
' How my mind works....
' I wanted to keep it kinda simple while making it relatively resource efficient, and at the same time,
' giving a user lots of options. Some of those options included referring to a menu items picture by a
' picture handle, image list index, or control (Image1, Picture1, etc).
' To keep it simple, each form has a class created to store menu item information. This seems simple in
' theory, until you play with MDI forms. Each MDI child passes/receives its menu commands from the
' parent therefore referring to MDI child form's menu data in it's own form class was difficult. Didn't want a
' menu item trying to load the parent's control vs the child's control if a control name was encoded in the
' caption. I got around the problem by positively identifying which form currently was active and
' redirecting menu processing to that form's class
' Ok, that problem solved, now came the problem with popups. Since any form can call any other form's
' menu as a popup, tracking the owner of the popup proved difficult. To get around that, the user should
' identify which form owns the popup before calling the popup. To do this, simply call the
' SetPopupParentForm routine and pass the owner's hWnd immediatley before calling the poup.

' That's basically the floor plan for this project.  Store each form's menus in a class for that form.
' I like this approach for two reasons.
' 1. Once processed, menus don't need to get fully processed ever again while the form is open. So we get
'     graphical menus displayed pretty darn quick after they have been displayed once.
' 2. Clean-up is a snap. When a form closes, clean out its class which removes all memory objects.
'     The only true downside is that sidebar images are maintained in memory until the form closes; as also
'     are the few arrays and collections.
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

' Now this routine has several Public subs & functions. Don't use just 'cause
' they're public--only use the ones described in the Readme file which are the
' same ones listed below. The other public routines are either for the optional
' usercontrol or the cMenuItems class. Feel free to preview remarks in these
' routines

' CreateImageSidebar, ChangeImageSidebar
' CreateTextSidebar, ChangeTextSidebar
' CreateMenuCaption, ChangeMenuCaption
' CreateSepartorBar, ChangeSepartorBar
' SetMenu
' RerouteTips
' SetPopupParentForm
' PopupMenuCustom

' The following routines Public or not could be referenced in your programs
' if you choose to. If so, some you may need to make public. But changing any
' of the routines' contents will have undesired effects

' ConvertColor , LoadFontMenu, ExchangeVBcolor, HiWord, LoWord, ShellSort
' and any of the drawing routines as long as you pass the correct parameters
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

' =====================================================================
' Only known issue: If a VB PopupMenu command is activated with a right
' click and the form right-clicked on does not have the focus, the menus
' may not be drawn -- all tags will be seen. The fix is easy.
' Prior to any VB PopupMenu command, add a SetFocus command. i.e...
'               SetFocus
'               PopupMenu mnuMain
' =====================================================================
' You were provided with a ReadMe file which is a detailed help
' file for using this project with all of its options. If you lost the
' file, you can email me at [e-mail] for a replacement.
' =====================================================================

'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
' Following are broken down into several sections.
' Those that are PUBLIC are also referenced within the class cMenuItems
' 1. Section for each DLL referenced. cMenuItems class refs 3 additional DLLs
' 2. Section of standard and custom Type declarations
' 3. Section of standard and custom Constants
' 4. Last section contains private/public variables used throughout application
' =====================================================================
' GDI32 Function Calls
' =====================================================================
' Blt functions
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function PatBlt Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As Long
Public Declare Function StretchBlt Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
' DC manipulation
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Integer
Private Declare Function GetMapMode Lib "gdi32" (ByVal hDC As Long) As Long
Public Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function SetMapMode Lib "gdi32" (ByVal hDC As Long, ByVal nMapMode As Long) As Long
Private Declare Function SetGraphicsMode Lib "gdi32" (ByVal hDC As Long, ByVal iMode As Long) As Long
' Other drawing functions
Private Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Public Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function EnumFontFamilies Lib "gdi32" Alias "EnumFontFamiliesA" (ByVal hDC As Long, ByVal lpszFamily As String, ByVal lpEnumFontFamProc As Long, lParam As Any) As Long
Private Declare Function GetBkColor Lib "gdi32" (ByVal hDC As Long) As Long
Public Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
Public Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function GetTextColor Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, lpPoint As POINTAPI) As Long
Private Declare Function RealizePalette Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SelectPalette Lib "gdi32" (ByVal hDC As Long, ByVal hPalette As Long, ByVal bForceBackground As Long) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
Public Declare Function SetBkMode Lib "gdi32" (ByVal hDC As Long, ByVal nBkMode As Long) As Long
Public Declare Function SetTextColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
' =====================================================================
' KERNEL32 Function Calls
' =====================================================================
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal ByteLen As Long)
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (LpVersionInformation As OSVERSIONINFO) As Long
' =====================================================================
' SHELL32 Function Calls
' =====================================================================
Private Declare Function ExtractAssociatedIcon Lib "shell32.dll" Alias "ExtractAssociatedIconA" ( _
    ByVal hInst As Long, ByVal lpIconPath As String, lpiIcon As Long) As Long
Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long
' =====================================================================
' USER32 Function Calls
' =====================================================================
' General Windows related functions
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function CopyImage Lib "user32" (ByVal handle As Long, ByVal imageType As Long, ByVal newWidth As Long, ByVal newHeight As Long, ByVal lFlags As Long) As Long
Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
Public Declare Function DrawIconEx Lib "user32" (ByVal hDC As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long
Public Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hDC As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function GetIconInfo Lib "user32" (ByVal hIcon As Long, piconinfo As ICONINFO) As Long
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Public Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Public Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function IsWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function OffsetRect Lib "user32" (lpRect As RECT, ByVal X As Long, ByVal Y As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
' Menu related functions
Public Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Public Declare Function CreatePopupMenu Lib "user32" () As Long
Private Declare Function DrawState Lib "user32" Alias "DrawStateA" (ByVal hDC As Long, ByVal hBrush As Long, ByVal lpDrawStateProc As Long, ByVal lParam As Long, ByVal wParam As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal Flags As Long) As Long
Public Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Public Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function GetMenu Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Public Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal uItem As Long, ByVal byPosition As Long, lpMenuItemInfo As MENUITEMINFO) As Boolean
Public Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Public Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
Public Declare Function IsMenu Lib "user32" (ByVal hMenu As Long) As Long
Public Declare Function InsertMenuItem Lib "user32.dll" Alias "InsertMenuItemA" (ByVal hMenu As Long, ByVal uItem As Long, ByVal fByPosition As Long, lpmii As Any) As Long
Public Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Public Declare Function SetMenuItemInfo Lib "user32" Alias "SetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal bool As Boolean, lpcMenuItemInfo As Any) As Long
Private Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal X As Long, ByVal Y As Long, ByVal nReserved As Long, ByVal hWnd As Long, lprc As RECT) As Long
' =====================================================================
' Standard TYPE Declarations used
' =====================================================================
Public Type POINTAPI                ' general use. Typically used for cursor location
    X As Long
    Y As Long
End Type
Public Type RECT                    ' used to set/ref boundaries of a rectangle
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type
Public Type BITMAP                  ' used to determine if an image is a bitmap
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type
Private Type DRAWITEMSTRUCT         ' used when owner drawn items are painted
     CtlType As Long
     CtlID As Long
     ItemID As Long
     itemAction As Long
     itemState As Long
     hWndItem As Long
     hDC As Long
     rcItem As RECT
     ItemData As Long
End Type
Public Type ICONINFO                ' used to determine if image is an icon
    fIcon As Long
    xHotSpot As Long
    yHotSpot As Long
    hbmMask As Long
    hbmColor As Long
End Type
Public Type LOGFONT               ' used to create fonts
  lfHeight As Long
  lfWidth As Long
  lfEscapement As Long
  lfOrientation As Long
  lfWeight As Long
  lfItalic As Byte
  lfUnderline As Byte
  lfStrikeOut As Byte
  lfCharSet As Byte
  lfOutPrecision As Byte
  lfClipPrecision As Byte
  lfQuality As Byte
  lfPitchAndFamily As Byte
  lfFaceName As String * 32
End Type
Private Type NEWTEXTMETRIC      ' used by Font Enumerator routines
   tmHeight As Long
   tmAscent As Long
   tmDescent As Long
   tmInternalLeading As Long
   tmExternalLeading As Long
   tmAveCharWidth As Long
   tmMaxCharWidth As Long
   tmWeight As Long
   tmOverhang As Long
   tmDigitizedAspectX As Long
   tmDigitizedAspectY As Long
   tmFirstChar As Byte
   tmLastChar As Byte
   tmDefaultChar As Byte
   tmBreakChar As Byte
   tmItalic As Byte
   tmUnderlined As Byte
   tmStruckOut As Byte
   tmPitchAndFamily As Byte
   tmCharSet As Byte
   ntmFlags As Long
   ntmSizeEM As Long
   ntmCellHeight As Long