Making a Menu with Bitmaps in GFA Basic 32

This example demonstrates the the coding of a menu containing a

bitmap in GFA Basic 32.

If you refer back to the first example formwindow a menu was created

for the form using the internal Gfa Basic MENU() array. This is coded

in an older traditional method for creating menus in Gfa Basic and is

backward compatible to prior versions. This example introduces a

Win32 API menu example with the extended possibility of bitmaps

and other features. It is actually somewhat easier to manage larger

and dynamic menus this way.

Note: you will need to download the example MakeMenu.g32 with

the option.bmp bitmap file for the example to work properly and it

uses a form created with the IDE Form Editor.

Click here to download makemenu_gb32.zip

'MakeMenu

'menu api for free use with gfa basic 32

'uses form ocx message events and bitmap

'neotreksoftware.com

Global hbmp%

Global hWnd As Handle

LoadForm frm1

hWnd = frm1.hWnd

@CreateDynamicMenu(hWnd)

@SetMenuBmp(hWnd)

Do : Sleep : Until Me Is Nothing

Procedure CreateDynamicMenu(hWnd As Handle)

'call once until the form is closed or a new

'menu for the form is created.

'handles to menu headings

Global hMainMenu As Int, hFileMenu As Int

Global hExitMenu As Int, hHelpMenu As Int

Global hSettingsMenu As Int

'Declare a set of 32bit integer constants using Enum

Global Enum IDM_FILE = 101, IDM_LOAD=111, IDM_SP1=121, IDM_SAVE=131

Global Enum IDM_EXIT = 201, IDM_EXIT2 = 211

Global Enum IDM_SETTINGS = 301

Global Enum IDM_HELP = 401

hMainMenu = CreateMenu()

hFileMenu = CreatePopupMenu()

hExitMenu = CreatePopupMenu()

hSettingsMenu = CreatePopupMenu()

hHelpMenu = CreatePopupMenu()

'headings

~AppendMenu(hMainMenu, MF_POPUP, hFileMenu, "File")

~AppendMenu(hMainMenu, MF_POPUP, hExitMenu, "Exit")

~AppendMenu(hMainMenu, MF_POPUP , hSettingsMenu, "Settings")

~AppendMenu(hMainMenu, MF_HELP, hHelpMenu, "Help")

'menu items

~AppendMenu(hFileMenu, MF_STRING, IDM_LOAD, "Load")

~AppendMenu(hFileMenu, MF_SEPARATOR, IDM_SP1, "")

~AppendMenu(hFileMenu, MF_CHECKED, IDM_SAVE, "Save")

~AppendMenu(hExitMenu, MF_GRAYED, IDM_EXIT2, "Exit")

~AppendMenu(hSettingsMenu, MF_STRING, IDM_SETTINGS, "Settings")

'handle of the form to set the menu

~SetMenu(hWnd, hMainMenu)

'place default check in the exit submenu

'already in the MF_GRAYED state

~CheckMenuItem(hExitMenu, IDM_EXIT2, MF_CHECKED)

'pre-select and hilite "Save"

~HiliteMenuItem(hWnd, hFileMenu, 2, MF_BYPOSITION | MF_HILITE)

'uncheck

'~CheckMenuItem(hExitMenu, IDM_EXIT, MF_UNCHECKED)

'enabled and restored from a grayed state

'~EnableMenuItem((hExitMenu), IDM_EXIT, MF_ENABLED)

'disabled, but not grayed

'~EnableMenuItem((hExitMenu), IDM_EXIT, MF_DISABLED)

'disabled and grayed

'~EnableMenuItem(hExitMenu, IDM_EXIT, MF_GRAYED)

Return

Sub frm1_MenuEvent(Idx%)

'Idx% was declared using the Sub parameter list

'if in a MF_DISABLED or MF_GRAYED state the message is ignored

'Menu headings are ignored

Switch Idx%

Case IDM_LOAD

MsgBox "IDM_LOAD"

Case IDM_SAVE

MsgBox "IDM_SAVE"

Case IDM_EXIT2

MsgBox "IDM_EXIT2"

Case IDM_SETTINGS

MsgBox "IDM_SETTINGS"

EndSwitch

EndSub

Procedure SetMenuBmp(hWnd As Handle)

Local hMenu As Long, hSubMenu As Long

'get the handle of the menu

hMenu = GetMenu(hWnd)

'check if there's a menu

If hMenu = 0 Then

MsgBox "This form doesn't have a menu."

Exit Proc

EndIf

'get the handle to place bitmap in 3rd submenu

hSubMenu = GetSubMenu(hMenu, 2)

'check if there's a submenu in the main form

If hSubMenu = 0 Then

MsgBox "This form doesn't have a submenu."

Exit Proc

EndIf

'load a bitmap from file obtaining the handle

hbmp% = LoadImage(0, App.Path + "\option.bmp", IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)

'set the menu bitmap

~SetMenuItemBitmaps(hSubMenu, 0, MF_BYPOSITION , hbmp%, hbmp%)

Return

Procedure CloseDynamicMenu(hWnd As Handle)

'on exit or if changing the menu use the following metheods

'before creating a new menu for the form

~DestroyMenu(hMainMenu)

~DestroyMenu(hFileMenu)

~DestroyMenu(hExitMenu)

~DestroyMenu(hHelpMenu)

FreeBmp(hbmp%) 'remember to free the bitmap

Return

Sub frm1_Close(Cancel?)

@CloseDynamicMenu(hWnd)

EndSub