// **************************************************************************** // // ** ** // // ** Class : cPopupMenuItem ** // // ** ** // // ** Purpose : Owner-draw popup menu item ** // // ** ** // // ** Author : Ulbe Stellema ** // // ** Data Access Worldwide ** // // ** ** // // ** Date : April 1, 2000 ** // // ** ** // // **************************************************************************** // //Use LanguageText.pkg Register_Function Private.phMenu Returns Handle Register_Function Private.piOSMajor Returns Integer Register_Function Private.piOSMinor Returns Integer Use cPopupMenu.h Class cPopupMenuItem Is A Message // Procedure : Construct_Object // Purpose : Object constructor Procedure Construct_Object Forward Send Construct_Object Property String psLabel "" Property String psStatusHelp "" Property String psShadowStatusHelp "unavailable" // C_$Unavailable // Image properties Property Integer piImage -1 Property Integer piCheckedImage -1 Property Integer piUncheckedImage -1 // Style properties Property Boolean pbCheckbox False Property Boolean pbRadio False Property Boolean Private.pbSeparator False // State properties Property Boolean Private.pbChecked False Property Boolean Private.pbDefault False Property Boolean Private.pbEnabled True Property Boolean Private.pbHighlight False // Submenu properties Property Integer Private.phoMenu // Message sending properties Property Integer phmOnClick Msg_OnClick Property Integer phmMessage 0 Property Integer phoDestination 0 // Misc properties Property Integer piData // user-defined data End_Procedure // Construct_Object // Procedure : End_Construct_Object // Purpose : End object constructor Procedure End_Construct_Object Handle hoObject Forward Send End_Construct_Object // Register item in collection (parent should be a cPopupMenu) Move Self To hoObject Delegate Send Private.RegisterItem hoObject Send Private.InsertItem -1 End_Procedure // End_Construct_Object // Procedure : Destroy_Object // Purpose : Object destructor Procedure Destroy_Object // Destroy menu item and submenu(s) Send DoRemoveItem Forward Send Destroy_Object End_Procedure // Destroy_Object // Procedure : Set phoMenu // Purpose : Sets submenu Procedure Set phoMenu Handle hSubMenu Integer iResult iPosition iType String sMenuItemInfo Handle hMenu Set Private.phoMenu To hSubMenu Delegate Get Private.phMenu To hMenu Move (IndexFromObject(Self,Self)) To iPosition If (hMenu And iPosition >= 0) Begin ZeroType MENUITEMINFO To sMenuItemInfo Put MENUITEMINFO_Size To sMenuItemInfo at MENUITEMINFO.cbSize Put MIIM_SUBMENU To sMenuItemInfo at MENUITEMINFO.fMask Put hSubMenu To sMenuItemInfo at MENUITEMINFO.hSubMenu Move (SetMenuItemInfo(hMenu,iPosition,True,AddressOf(sMenuItemInfo))) To iResult If (iResult = 0) Error 500 (FormatMessage(GetLastError())) End // If (hMenu And iPosition >= 0) Begin End_Procedure // Set phoMenu // Function : phoMenu // Purpose : Returns handle to submenu Function phoMenu Returns Handle Function_Return (Private.phoMenu(Self)) End_Function // phoMenu // Procedure : Set pbSeparator // Purpose : Sets or clears MFT_SEPARATOR flag Procedure Set pbSeparator Boolean bState Integer iResult iPosition iType String sMenuItemInfo Handle hMenu Set Private.pbSeparator To bState Delegate Get Private.phMenu To hMenu Move (IndexFromObject(Self,Self)) To iPosition If (hMenu And iPosition >= 0) Begin ZeroType MENUITEMINFO To sMenuItemInfo Put MENUITEMINFO_Size To sMenuItemInfo at MENUITEMINFO.cbSize Put MIIM_TYPE To sMenuItemInfo at MENUITEMINFO.fMask Move (GetMenuItemInfo(hMenu,iPosition,True,AddressOf(sMenuItemInfo))) To iResult GetBuff From sMenuItemInfo at MENUITEMINFO.fType To iType If (bState) Move (iType iOr MFT_SEPARATOR) To iType Else Move (iType - (iType iAnd MFT_SEPARATOR)) To iType Put iType To sMenuItemInfo at MENUITEMINFO.fType Move (SetMenuItemInfo(hMenu,iPosition,True,AddressOf(sMenuItemInfo))) To iResult If (iResult = 0) Error 500 (FormatMessage(GetLastError())) End // If (hMenu And iPosition >= 0) Begin End_Procedure // Set pbSeparator // Function : pbSeparator // Purpose : Returns the MFT_SEPARATOR flag Function pbSeparator Returns Boolean Function_Return (Private.pbSeparator(Self)) End_Function // pbSeparator // Procedure : Set pbChecked // Purpose : Sets checked state of a menu item Procedure Set pbChecked Integer iState Integer iCheck iResult Handle hMenu If (iState = 0) Move (MF_BYCOMMAND iOr MF_UNCHECKED) To iCheck Else Move (MF_BYCOMMAND iOr MF_CHECKED) To iCheck Delegate Get Private.phMenu To hMenu Move (CheckMenuItem(hMenu,Self,iCheck)) To iResult Set Private.pbChecked To iState End_Procedure // Set pbChecked // Function : pbChecked // Purpose : Returns the checked state of a menu item Function pbChecked Returns Integer Function_Return (Private.pbChecked(Self)) End_Function // pbChecked // Procedure : Set pbDefault // Purpose : Sets the default menu item Procedure Set pbDefault Integer iState Integer iResult Handle hMenu Delegate Get Private.phMenu To hMenu If (hMenu) Move (SetMenuDefaultItem(hMenu,Self,0)) To iResult Set Private.pbDefault To iState End_Procedure // Set pbDefault // Function : pbDefault // Purpose : Returns the default menu item Function pbDefault Returns Integer Integer iObject Handle hMenu Function_Return (Private.pbDefault(Self)) Delegate Get Private.phMenu To hMenu Move (GetMenuDefaultItem(hMenu,0,0)) To iObject Function_Return (iObject = Self) End_Function // pbDefault // Procedure : Set pbEnabled // Purpose : Set enabled state of a menu item Procedure Set pbEnabled Integer iState Integer iEnabled iResult Handle hMenu If (iState = 0) Move (MF_BYPOSITION iOr MF_GRAYED) To iEnabled Else Move (MF_BYPOSITION iOr MF_ENABLED) To iEnabled Delegate Get Private.phMenu To hMenu If (hMenu) Move (EnableMenuItem(hMenu,IndexFromObject(Self,Self),iEnabled)) To iResult Set Private.pbEnabled To iState End_Procedure // Set pbEnabled // Function : pbEnabled // Purpose : Returns the enabled state of a menu item Function pbEnabled Returns Integer Function_Return (Private.pbEnabled(Self)) End_Function // pbEnabled // Procedure : Set pbHighlight // Purpose : Sets highlight state of a menu item Procedure Set pbHighLight Integer iState Integer iHiLite iResult Handle hMenu If (iState = 0) Move (MF_BYCOMMAND iOr MF_UNHILITE) To iHiLite Else Move (MF_BYCOMMAND iOr MF_HILITE) To iHiLite Delegate Get Private.phMenu To hMenu If (hMenu) Move (HiliteMenuItem(Window_Handle(Self),hMenu,Self,iHiLite)) To iResult Set Private.pbHighLight To iState End_Procedure // Set pbHighLight // Function : pbHighLight // Purpose : Returns the highlight state of a menu item Function pbHighLight Returns Integer Function_Return (Private.pbHighLight(Self)) End_Function // pbHighLight // Procedure : Private.InsertItem // Purpose : This (private) method inserts the menu item in the menu Procedure Private.InsertItem Integer iPosition Integer iResult iMask iType iState iCount String sMenuItemInfo sLabel Handle hMenu hSubMenu Delegate Get Private.phMenu To hMenu If (iPosition = -1) Move (GetMenuItemCount(hMenu)+1) To iPosition // Handle submenu If (phoMenu(Self)) Get Private.phMenu Of (phoMenu(Self)) To hSubMenu // Handle label If (psLabel(Self) <> "") Move (psLabel(Self)) To sLabel // The MIIM_TYPE is only supported on Win 95 and Win NT 4 If (Sysconf(sysconf_os_major_rev) = "4" And Sysconf(sysconf_os_minor_rev) = "0") Begin If hSubMenu Move (MIIM_TYPE iOr MFT_BITMAP) To iMask Else Move (MIIM_TYPE) To iMask End // If (Sysconf(sysconf_os_major_rev) = "4") And (Sysconf(sysconf_os_minor_rev) = "0") Begin Else Begin If hSubMenu Move (MIIM_FTYPE iOr MIIM_STRING iOr MIIM_BITMAP) To iMask Else Move (MIIM_FTYPE iOr MIIM_STRING) To iMask End // Else Begin Move (iMask iOr MIIM_DATA iOr MIIM_STATE iOr MIIM_ID) To iMask If (pbCheckbox(Self)) Move (iMask iOr MIIM_CHECKMARKS) To iMask If (pbRadio(Self)) Move (iMask iOr MIIM_CHECKMARKS) To iMask If hSubMenu Move (iMask iOr MIIM_SUBMENU) To iMask If (Private.pbSeparator(Self)) Move (iType iOr MFT_SEPARATOR) To iType // TODO, this doesn't work on '95 // If hSubMenu Begin // Move (iMask iOr MIIM_BITMAP) To iMask // Move (iType iOr MFT_STRING) To iType // End // If hSubMenu Begin // Else Move (iType iOr MFT_OWNERDRAW) To iType //If (hSubMenu = 0) Move (iType iOr MFT_OWNERDRAW) To iType // Set the fState member If (pbChecked(Self)) Move (iState iOr MFS_CHECKED) To iState Else Move (iState iOr MFS_UNCHECKED) To iState If (pbDefault(Self)) Move (iState iOr MFS_DEFAULT) To iState If (pbEnabled(Self)) Move (iState iOr MFS_ENABLED) To iState Else Move (iState iOr MFS_DISABLED) To iState If (pbHighlight(Self)) Move (iState iOr MFS_HILITE) To iState Else Move (iState iOr MFS_UNHILITE) To iState ZeroType MENUITEMINFO To sMenuItemInfo Put MENUITEMINFO_Size To sMenuItemInfo at MENUITEMINFO.cbSize Put iMask To sMenuItemInfo at MENUITEMINFO.fMask Put iType To sMenuItemInfo at MENUITEMINFO.fType Put iState To sMenuItemInfo at MENUITEMINFO.fState Put Self To sMenuItemInfo at MENUITEMINFO.wID Put hSubMenu To sMenuItemInfo at MENUITEMINFO.hSubMenu Put Self To sMenuItemInfo at MENUITEMINFO.dwItemData Put (AddressOf(sLabel)) To sMenuItemInfo at MENUITEMINFO.dwTypeData Put (Length(sLabel)) To sMenuItemInfo at MENUITEMINFO.cch //Put HBMMENU_CALLBACK To sMenuItemInfo at MENUITEMINFO.hbmpItem //Put -1 To sMenuItemInfo at MENUITEMINFO.hbmpItem Move (InsertMenuItem(hMenu,iPosition,True,AddressOf(sMenuItemInfo))) To iResult If (iResult = 0) Error 500 (FormatMessage(GetLastError())) End_Procedure // Private.InsertItem // Procedure : DoAppendItem // Purpose : Appends a menu item to a menu Procedure DoAppendItem Handle hoObject Send Private.InsertItem -1 // Register item in collection Move Self To hoObject Delegate Send Private.RegisterItem hoObject End_Procedure // DoAppendItem // Procedure : DoInsertItem // Purpose : Inserts a menu item to a menu Procedure DoInsertItem Integer iPosition Handle hoObject Send Private.InsertItem iPosition // Register item in collection Move Self To hoObject Delegate Send Private.RegisterItem hoObject End_Procedure // DoInsertItem // Procedure : DoRemoveItem // Purpose : Removes a menu item from a menu Procedure DoRemoveItem Handle hMenu hoObject Integer iResult Delegate Get Private.phMenu To hMenu // Destroy submenu(s), this is to prevent loss of resources when program is running If (phoMenu(Self)) Begin // If DoRemoveItem is called when closing the application the child object(s) are already destroyed If (Object_Id(phoMenu(Self))) Begin Move (DestroyMenu(Private.phMenu(phoMenu(Self)))) To iResult If (iResult = 0) Error 500 (FormatMessage(GetLastError())) End // If (Object_Id(phoMenu(Self))) Begin End // If (phoMenu(Self)) Begin // Destroy menu item Move (RemoveMenu(hMenu,Self,MF_BYCOMMAND)) To iResult If (iResult = 0) Error 500 (FormatMessage(GetLastError())) // Unregister item in collection Move Self To hoObject Delegate Send Private.UnregisterItem hoObject End_Procedure // DoRemoveItem // Procedure : OnClick // Purpose : This event is sent when the user selects the menu item Procedure OnClick End_Procedure // OnClick // Procedure : OnEntering // Purpsoe : This event is sent when the user enters the menu item Procedure OnEntering End_Procedure // OnEntering // Procedure : OnLeaving // Purpose : This event is sent when the user leaves the menu item Procedure OnLeaving End_Procedure // OnLeaving End_Class // cPopupMenuItem