DefInt A-Z

'Window API Function Declarations
'
Declare Function GetMenu% Lib "user" (ByVal hwnd%)
Declare Function GetSubMenu% Lib "user" (ByVal hMenu%, ByVal nPos%)
Declare Function GetMenuItemID% Lib "user" (ByVal hMenu%, ByVal nPos%)
Declare Function ModifyMenu% Lib "user" (ByVal hMenu%, ByVal nPosition%, ByVal wFlags%, ByVal wIDNewItem%, ByVal lpNewItem&)
Declare Function SetMenuItemBitmaps% Lib "user" (ByVal hMenu%, ByVal nPosition%, ByVal wFlags%, ByVal hBitmapUnchecked%, ByVal hBitmapChecked%)
Declare Function TrackPopupMenu Lib "user" (ByVal hMenu, ByVal r1, ByVal X, ByVal Y, ByVal r2, ByVal hwnd, ByVal r3&)
Declare Function GetSystemMenu Lib "user" (ByVal hwnd%, ByVal revert%) As Integer
Const MF_BITMAP = &H4

Const CLR_MENUBAR = &H80000004

Const TRUE = -1, FALSE = 0

Dim TextItems$(4), LastSelection%, CurrentText%, hMenu%

Sub Form_Load ()

'* Obtain handle to the Forms top level menu

hMenu% = GetMenu(hwnd)

Static_Bitmaps_To_Menus

'* Initial String with text displayed when menus are selected.
'* (Just so something happens when a menu is selected.)

TextItems$(0) = "Writing Tools"
TextItems$(1) = "Fonts"
TextItems$(2) = "Books/Notes"
TextItems$(3) = "Printers"
TextItems$(4) = "Computers"

'* Set "Dynamic" menus submenus initial Menu text values
'* to Fontname + Fontsize of each menu item

For I% = 0 To 4
MSubMenu(I%).Caption = picture3(I%).FontName + Str$(picture3(I%).FontSize) + " Pnt"
Next I%

End Sub

Sub SubMenu_Click (Index As Integer)

Static LastSelection%

'* Set text to that of selected menu item and
'* display the new text

CurrentText% = Index
Form_Paint

'* Uncheck last selected item and check seledted item

SubMenu(LastSelection%).Checked = FALSE 'Check selected menu
SubMenu(Index).Checked = TRUE 'UnCheck last selected menu

LastSelection% = Index 'Save current selection

End Sub

Sub MSubMenu_Click (Index As Integer)

Static LastSelection%

'* Reset forms FontSize to selected fontsize
'* and redisplay current text

FontSize = picture3(Index).FontSize
Form_Paint

'* Uncheck last selected item and check selected item

MSubMenu(LastSelection%).Checked = FALSE
MSubMenu(Index).Checked = TRUE

LastSelection% = Index

End Sub

Sub Create_Dynamic_Menu_Bitmaps ()

For I% = 0 To 4

'* Set the width and height of the Picture controls
'* based on their corresponding Menu items caption,
'* and the Picture controls Font and FontSize.
'* DoEvents() is neccessary to make new dimension
'* values to take affect prior to exiting this Sub.

picture3(I%).Width = picture3(I%).TextWidth(MSubMenu(I%).Caption)
picture3(I%).Height = picture3(I%).TextHeight(MSubMenu(I%).Caption)
X% = DoEvents()

'* Set Backcolor of Picture control to that of the
'* current system Menu Bar color, so Dynamic bitmaps
'* will appear as normal menu items when menu bar
'* color is changed via the control panel

picture3(I%).BackColor = CLR_MENUBAR

'* Print Text onto Picture control. This text will
'* become the bitmap.

picture3(I%).Print MSubMenu(I%).Caption

Next I%

'* Obtain handle Second submenu

hSubMenu% = GetSubMenu(hMenu%, 1)

'* - Set picture controls backgroup picture (Bitmap) to its Image.
'* Can't use the Image bitmap directly for some reason.
'* - Get ID of sub menu
'* - Replace menu text with bitmap from corresponding picture control
'* - Replace bitmap for menu check mark with custom check mark bitmap

For I% = 0 To 4
picture3(I%).Picture = picture3(I%).Image
menuId% = GetMenuItemID(hSubMenu%, I%)
X% = ModifyMenu(hMenu%, menuId%, MF_BITMAP, menuId%, CLng(picture3(I%).Picture))
X% = SetMenuItemBitmaps(hMenu%, menuId%, 0, 0, CLng(picture2.Picture))
Next I%

End Sub

Sub Form_Paint ()
Cls
Print TextItems$(CurrentText%)
End Sub

Sub CreateDynamic_Click ()
CreateDynamic.enabled = FALSE
Create_Dynamic_Menu_Bitmaps
End Sub

Sub Static_Bitmaps_To_Menus ()

'* Obtain handle to first submenu

hSubMenu% = GetSubMenu(hMenu%, 0)

'* - Get ID of each sub menu
'* - Replace menu text with bitmap from corresponding picture control
'* - Replace bitmap for menu check mark with custom check mark bitmap

For I% = 0 To 4
menuId% = GetMenuItemID(hSubMenu%, I%)
X% = ModifyMenu(hMenu%, menuId%, MF_BITMAP, menuId%, CLng(picture1(I%).Picture))
X% = SetMenuItemBitmaps(hMenu%, menuId%, 0, 0, CLng(picture2.Picture))
Next I%

SubMenu(1).enabled = 0
hMenu% = GetSystemMenu(hwnd, 0)
menuId% = &HF120
X% = ModifyMenu(hMenu%, menuId%, MF_BITMAP, menuId%, CLng(picture3(0).Picture))

End Sub

Sub Form_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)

ScaleMode = 3
InPixels = ScaleWidth
ScaleMode = 1
IX = (X + Left) \ (ScaleWidth \ InPixels)
IY = (Y + (Top + (Height - ScaleHeight - (Width - ScaleWidth)))) \ (ScaleWidth \ InPixels)
R = TrackPopupMenu(GetSubMenu(hMenu%, Button - 1), 0, IX, IY, 0, hwnd, 0)

End Sub