Inside lqt_window.prg I have these lines
Code: Select all
DATA oMainMenu INIT NIL // need this to store menu: local action on Menu class, harbour trick
and
Code: Select all
/*..............................................................................
SetUpMenu
..............................................................................*/
METHOD SetUpMenu( oValue ) CLASS LQTWINDOW
IF PCOUNT() == 1 .AND. VALTYPE( oValue ) == "O"
::oMainMenu:= oValue
ENDIF
RETURN SELF
See below my lqt_menu.prg and SetUpMenu. I think to remove DATA SHARED and use internal data. I create the real menu within Create() method, like HMG4 do
Code: Select all
/*==============================================================================
LQTMENU class
==============================================================================*/
#include "hbqtgui.ch"
#include "hbclass.ch"
#include "common.ch"
#include "lqt-include.ch"
#define MNU_QBAR 0
#define MNU_QACT 1
#define MNU_QMNU 2
#define MNU_QSEP 3
CLASS LQTMENU FROM LQTDATASHARED,LQTDATABASIC,LQTMETHSTD
// shared data
CLASS VAR lMainMenu INIT .F. SHARED // need this to know when start a new barmenu
CLASS VAR nMnuObjCounter INIT 0 SHARED // simple counter, used to create internal varname (eg mnuvar_1, mnuvar_2, etc.)
CLASS VAR aPopUpMenu INIT {} SHARED // to store popup men level, used to go forward and backward and retrieve parent
CLASS VAR oCurrMnuParent INIT NIL SHARED // current popup menu parent for item or new popup
CLASS VAR oSuMnuParent INIT NIL SHARED // super parent: mainmenu it's always the same
DATA cClassName INIT "LQTMENU"
// data: please preserve alfabetic order.
DATA bAction INIT NIL PROTECTED
DATA cCaption INIT NIL PROTECTED
DATA lChecked INIT NIL PROTECTED
DATA lEnabled INIT NIL PROTECTED
DATA cImage INIT NIL PROTECTED
DATA nMnuType INIT NIL PROTECTED
DATA cName INIT NIL PROTECTED
DATA cTitle INIT NIL PROTECTED
DATA lVisible INIT NIL PROTECTED
// method: please preserve alfabetic order. New and Create must be the first
METHOD New
METHOD Create
METHOD Action SETGET
METHOD Caption SETGET
METHOD Checked SETGET
METHOD ChildList INLINE ::aControls
METHOD Enabled SETGET
METHOD FontSize SETGET // overwrite basic method
METHOD Image SETGET
METHOD MnuType SETGET
METHOD Title SETGET
METHOD Visible SETGET
ENDCLASS
/*..............................................................................
New
..............................................................................*/
METHOD New( cName ) CLASS LQTMENU
// set-up a default name
::cName := IIF( VALTYPE( cName) == "C", cName, "LQTMNU_" + hb_ntos( ::nMnuObjCounter++ ) )
RETURN Self
/*..............................................................................
Create
..............................................................................*/
METHOD Create() CLASS LQTMENU
LOCAL nX
::lCreated := .T.
IF ::nMnuType == MNU_QBAR
// ::oParent:oMainMenu := ::oSuMnuParent
::oParent:SetUpMenu( ::oSuMnuParent )
::oQtObject := QMenuBar( ::oParent:oQtObject )
::oQtFont := ::oParent:oQtObject:Font()
IF VALTYPE( ::nFontSize ) <> 'U'
IF ::oQtFont:PointSize == -1; ::oQtFont:setPixelSize( ::nFontSize ); ELSE; ::oQtFont:setPointSize( ::nFontSize ); ENDIF
::FontSetUp( ::oQtFont )
ENDIF
ENDIF
IF ::nMnuType == MNU_QMNU
::oQtObject := QMenu( ::oParent:oQtObject )
::oQtFont := ::oParent:oQtObject:Font()
::oQtObject:setTitle( ::cTitle )
IF hb_ischar( ::cImage ) == .T.
::oQtObject:setIcon( ::cImage )
ENDIF
ENDIF
IF ::nMnuType == MNU_QACT
::oQtObject := QAction( ::oParent:oQtObject )
::oQtFont := ::oParent:oQtObject:Font()
::oQtObject:setText( ::cCaption )
IF hb_ischar( ::cImage ) == .T.
::oQtObject:setIcon( ::cImage )
ENDIF
IF hb_islogical( ::lChecked ) == .T.
::oQtObject:setCheckable( .T. )
::oQtObject:setChecked( ::lChecked )
ENDIF
IF hb_islogical( ::lEnabled ) == .T.
::oQtObject:setEnabled( ::lEnabled )
ENDIF
IF hb_islogical( ::lVisible ) == .T.
::oQtObject:setVisible( ::lVisible )
ENDIF
IF hb_isblock( ::bAction ) == .T.
::oQtObject:connect( "triggered(bool)", ::bAction )
ENDIF
ENDIF
IF ::nMnuType == MNU_QSEP
::oQtObject := QAction( ::oParent:oQtObject )
::oQtFont := ::oParent:oQtObject:Font()
::oQtObject:setText( ::cCaption )
::oQtObject:setSeparator( .T. )
ENDIF
::oQTObject:SetFont( ::oQtFont )
FOR nX := 1 TO LEN( ::aControls )
IF __objHasMethod( ::aControls[nX], "create" ) == .T.
::aControls[nX]:Create()
ENDIF
NEXT nX
IF ::nMnuType == MNU_QBAR
::oParent:oQtObject:setMenuBar( ::oQtObject )
ENDIF
IF ::nMnuType == MNU_QMNU
::oParent:oQtObject:addmenu( ::oQtObject )
ENDIF
IF ::nMnuType == MNU_QACT
::oParent:oQtObject:addaction( ::oQtObject )
ENDIF
IF ::nMnuType == MNU_QSEP
::oParent:oQtObject:addaction( ::oQtObject )
ENDIF
RETURN Self
/*..............................................................................
Action
..............................................................................*/
METHOD Action( bAction ) CLASS LQTMENU
IF PCOUNT() == 0
RETURN ::bAction
ELSEIF hb_isblock( bAction ) == .T.
::bAction := bAction
ENDIF
RETURN Self
/*..............................................................................
Caption
..............................................................................*/
METHOD Caption( cCaption ) CLASS LQTMENU
IF PCOUNT() == 0
RETURN ::cCaption
ELSEIF hb_ischar( cCaption ) == .T.
::cCaption := cCaption
ENDIF
RETURN NIL
/*..............................................................................
Checked
..............................................................................*/
METHOD Checked( lChecked ) CLASS LQTMENU
IF PCOUNT() == 0
RETURN ::lChecked
ELSEIF hb_islogical( lChecked ) == .T.
::lChecked := lChecked
ENDIF
RETURN NIL
/*..............................................................................
Enabled
..............................................................................*/
METHOD Enabled( lEnabled ) CLASS LQTMENU
IF PCOUNT() == 0
RETURN ::lEnabled
ELSEIF hb_islogical( lEnabled ) == .T.
::lEnabled := lEnabled
ENDIF
RETURN NIL
/*..............................................................................
FontSize
..............................................................................*/
METHOD FontSize( nFontSize ) CLASS LQTMENU
IF PCOUNT() == 0
RETURN ::nFontSize
ELSEIF VALTYPE( nFontSize ) == "N"
::nFontSize := nFontSize
ENDIF
RETURN Self
/*..............................................................................
Image
..............................................................................*/
METHOD Image( cImage ) CLASS LQTMENU
IF PCOUNT() == 0
RETURN ::cImage
ELSEIF hb_ischar( cImage ) == .T.
::cImage := cImage
ENDIF
RETURN NIL
/*..............................................................................
MnuType
..............................................................................*/
METHOD MnuType( nMnuType ) CLASS LQTMENU
IF PCOUNT() == 0
RETURN ::nMnuType
ELSEIF hb_isnumeric( nMnuType ) == .T.
::nMnuType := nMnuType
ENDIF
RETURN NIL
/*..............................................................................
Title
..............................................................................*/
METHOD Title( cTitle ) CLASS LQTMENU
IF PCOUNT() == 0
RETURN ::cTitle
ELSEIF hb_ischar( cTitle ) == .T.
::cTitle := cTitle
ENDIF
RETURN NIL
/*..............................................................................
Visible
..............................................................................*/
METHOD Visible( lVisible ) CLASS LQTMENU
IF PCOUNT() == 0
RETURN ::lVisible
ELSEIF hb_islogical( lVisible ) == .T.
::lVisible := lVisible
ENDIF
RETURN NIL
/*==============================================================================
LQTMENUBAR class
==============================================================================*/
CLASS LQTMENUBAR FROM LQTMENU
// method: please preserve alfabetic order. New and Create must be the first
METHOD New
METHOD AddMnuItem
METHOD AddMnuPopUp
METHOD AddMnuSeparator
METHOD EndMnuMain
METHOD EndMnuPopUp
ENDCLASS
/*..............................................................................
New
..............................................................................*/
METHOD New( cName, oParent ) CLASS LQTMENUBAR
IF ::lMainMenu == .F.
::lMainMenu := .T.
::aPopUpMenu := {}
// Menu object counter: 0 is always main menu
::nMnuObjCounter := 0
::cName := IIF( VALTYPE( cName) == "C", cName, "LQTMNU_" + hb_ntos( ::nMnuObjCounter ) )
::oSuMnuParent := Self
::oCurrMnuParent := Self
::nMnuType := MNU_QBAR
IF hb_isnumeric( oParent ) .AND. oParent = 0 // If numeric 0 ( zero ) force no parent.
::oParent := NIL
ELSEIF hb_isobject( oParent ) // If parent object is passed explicitly, use it.
::oParent := oParent
ELSEIF hb_isobject( oParent := hb_qwith() )
::oParent := oParent
ELSE
::oParent := ::s_oDefaultParent
ENDIF
// add HmgObject to its parent
::oParent:AddToParent( Self )
::oParent:AddData( ::cName , Self )
ENDIF
RETURN Self
/*..............................................................................
AddMnuItem
..............................................................................*/
METHOD AddMnuItem( cName, cCaption, bAction, cImage, lChecked, lEnabled, lVisible ) CLASS LQTMENUBAR
LOCAL oNewObject, cNewObjectName
// create an internal varname: don't move ::nMnuObjCounter++ inside hb_ntos. It's fails and I want count every element
::nMnuObjCounter++
cNewObjectName := IIF( VALTYPE( cName) == "C", cName, "LQTMNU_" + hb_ntos( ::nMnuObjCounter ) )
cCaption := IF( hb_ischar( cCaption ) == .T., cCaption, cNewObjectName )
// create a new object with internal name
oNewObject := LQTMENU():New( cNewObjectName )
// add created object to its parent
__objAddData( ::oCurrMnuParent, cNewObjectName )
::oCurrMnuParent:&cNewObjectName := oNewObject
AADD( ::oCurrMnuParent:aControls, oNewObject )
// setup HMG object
::oCurrMnuParent:&cNewObjectName:MnuType := MNU_QACT
::oCurrMnuParent:&cNewObjectName:oParent := ::oCurrMnuParent
::oCurrMnuParent:&cNewObjectName:Caption := cCaption
::oCurrMnuParent:&cNewObjectName:Action := bAction
::oCurrMnuParent:&cNewObjectName:Image := cImage
::oCurrMnuParent:&cNewObjectName:Checked := lChecked
::oCurrMnuParent:&cNewObjectName:Enabled := lEnabled
::oCurrMnuParent:&cNewObjectName:Visible := lVisible
RETURN NIL
/*..............................................................................
AddMnuPopUp
..............................................................................*/
METHOD AddMnuPopUp( cName, cTitle, cImage ) CLASS LQTMENUBAR
LOCAL oNewObject, cNewObjectName
// create an internal varname: don't move ::nMnuObjCounter++ inside hb_ntos. It's fails and I want count every element
::nMnuObjCounter++
cNewObjectName := IIF( VALTYPE( cName) == "C", cName, "LQTMNU_" + hb_ntos( ::nMnuObjCounter ) )
cTitle := IF( hb_ischar( cTitle ) == .T., cTitle, cNewObjectName )
// create a new object with internal name
oNewObject := LQTMENU():New( cNewObjectName )
// add created object to its parent
__objAddData( ::oCurrMnuParent, cNewObjectName )
::oCurrMnuParent:&cNewObjectName := oNewObject
AADD( ::oCurrMnuParent:aControls, oNewObject )
// setup HMG object
::oCurrMnuParent:&cNewObjectName:MnuType := MNU_QMNU
::oCurrMnuParent:&cNewObjectName:oParent := ::oCurrMnuParent
::oCurrMnuParent:&cNewObjectName:Title := cTitle
::oCurrMnuParent:&cNewObjectName:Image := cImage
// create a new popup level
::oCurrMnuParent := ::oCurrMnuParent:&cNewObjectName
AADD( ::aPopUpMenu, ::oCurrMnuParent )
RETURN NIL
/*..............................................................................
AddMnuSeparator
..............................................................................*/
METHOD AddMnuSeparator(cName, cCaption ) CLASS LQTMENUBAR
LOCAL oNewObject, cNewObjectName
// create an internal varname: don't move ::nMnuObjCounter++ inside hb_ntos. It's fails and I want count every element
::nMnuObjCounter++
cNewObjectName := IIF( VALTYPE( cName) == "C", cName, "LQTMNU_" + hb_ntos( ::nMnuObjCounter ) )
cCaption := IF( hb_ischar( cCaption ) == .T., cCaption, cNewObjectName )
// create a new object with internal name
oNewObject := LQTMENU():New( cNewObjectName )
// add created object to its parent
__objAddData( ::oCurrMnuParent, cNewObjectName )
::oCurrMnuParent:&cNewObjectName := oNewObject
AADD( ::oCurrMnuParent:aControls, oNewObject )
// setup HMG object
::oCurrMnuParent:&cNewObjectName:MnuType := MNU_QSEP
::oCurrMnuParent:&cNewObjectName:oParent := ::oCurrMnuParent
::oCurrMnuParent:&cNewObjectName:Caption := cCaption
RETURN NIL
/*..............................................................................
EndMnuMain
..............................................................................*/
METHOD EndMnuMain() CLASS LQTMENUBAR
::oCurrMnuParent := ::oSuMnuParent
::lMainMenu := .F.
RETURN NIL
/*..............................................................................
EndMnuPopUp
..............................................................................*/
METHOD EndMnuPopUp() CLASS LQTMENUBAR
LOCAL nLast := LEN( ::aPopUpMenu )
IF nLast > 0
::aPopUpMenu := hb_adel( ::aPopUpMenu, nLast, .T. ) // resize param
nLast := LEN( ::aPopUpMenu )
ENDIF
::oCurrMnuParent := IIF( nLast > 0, ::aPopUpMenu[nLast], ::oSuMnuParent )
RETURN NIL