/'
   This is GUI menu unit in FreeBasic
   is suitable for windows operating system,
   but can be easely translated for Linux systems
   copyright (c)2021 vasile eodor nastasa
   http://www.rqwork.ro
   http://www.rqwork.de
   nastasa.eodor@gmail.com
   this version is number 11, is a stable release(GUI_V11)
'/

#define T_PopupMenu(__ptr__) *cast(PPopupMenu,__ptr__)
#define T_MainMenu(__ptr__) *cast(PMainMenu,__ptr__)

common shared as integer MenuID

declare function AllocateMenuUniqueID as integer

type PMenu as QMenu ptr
type PMainMenu as QMainMenu ptr
type PPopupMenu as QPopupMenu ptr

type QMenu extends QComponent
    protected:
    as hmenu fhandle
    as integer fcount,fcommand,findex
    as string fcaption
    as PMenu ptr fitems
    as PMenu fparent
    as boolean fchecked,fenabled,fvisible,fradioitem
    as integer fCheck(2),fEnable(2)
    private:
    declare sub TraverseMenu(as hmenu)
    public:
    declare sub LoadFromResourceName(as string)
    declare function IndexOf(as PMenu) as integer
    declare sub Add(as PMenu)
    declare sub Remove(as PMenu)
    declare property Count as integer
    declare property CommandID as integer
    declare property CommandID (as integer)
    declare property Parent byref as QMenu
    declare property Parent(byref as QMenu)
    declare property Item(as integer) byref as QMenu
    declare property Item (as integer,byref as QMenu)
    declare property Handle as hmenu
    declare property Handle(as hmenu)
    declare property Caption as string
    declare property Caption(as string)
    declare property Checked as boolean
    declare property Checked(Value as boolean)
    declare property RadioItem as boolean
    declare property RadioItem(Value as boolean)
    declare property Enabled as boolean
    declare property Enabled(Value as boolean)
    declare property Visible as boolean
    declare property Visible(Value as boolean)
    declare operator cast as const string
    declare operator cast as any ptr
    declare constructor
    declare destructor
    #ifdef rtl
    declare virtual function GetProperty(as string) as zstring ptr
    declare virtual function SetProperty(as string,as zstring ptr) as boolean
    declare virtual function GetProperties as zstring ptr
    declare virtual function GetPropertyInfo(as string) as PELPropInfo
    #endif
end type

type QMainMenu extends QMenu
    public:
    declare sub Refresh(as hwnd)
    declare operator cast as const string
    declare operator cast as any ptr
    declare operator cast as hmenu
    declare constructor
    declare destructor
end type

type QPopupMenu extends QMenu
    public:
    declare operator cast as const string
    declare operator cast as any ptr
    declare operator cast as hmenu
    declare constructor
    declare destructor
end type

/'Register to ide'/
namespace menus
    function RegisterComponents as zstring ptr export
        dim as string s="Standards=QMainMenu,QPopupMenu"+chr(0)
        dim as zstring ptr result=callocate(len(s))
        *result=s
        return result
    end function
end namespace

/' Global '/
function AllocateMenuUniqueID as integer
    MenuID+=1
    return MenuID
end function

/' QMenu '/
property QMenu.CommandID as integer
    dim as menuiteminfo mif
    mif.cbsize=sizeof(mif)
    mif.fmask=miim_id
    dim as hmenu p=iif(fparent,parent.handle,0)
    if ismenu(p) then
       if GetMenuItemInfo(parent.handle,fcommand,false,@mif) then fcommand=mif.wid
    end if
    return fcommand
end property

property QMenu.CommandID (v as integer)
    fcommand=v
    dim as menuiteminfo mif
    mif.cbsize=sizeof(mif)
    mif.fmask=miim_id
    dim as hmenu p=iif(fparent,parent.handle,0)
    if ismenu(p) then
       if GetMenuItemInfo(parent.handle,fcommand,false,@mif) then
          mif.wid=fcommand
          SetMenuItemInfo(parent.handle,fcommand,false,@mif)
       end if
    end if
end property

property QMenu.Parent byref as QMenu
    return *(fparent)
end property

property QMenu.Parent (byref v as QMenu)
    fparent=v
    fparent->add this
end property

property QMenu.Handle as hmenu
    return fhandle
end property

property QMenu.Handle(v as hmenu)
    fhandle=v
end property

property QMenu.Caption as string
    return FCaption
end property

property QMenu.Caption(v as string)
    fCaption=v
    if fParent then
       if Handle then
          ModifyMenu(fParent->fHandle,cint(fHandle),MF_POPUP,cint(fHandle),fCaption)
       else
          if v="-" then
             ModifyMenu(fParent->fHandle,fCommand,MF_BYCOMMAND or MF_SEPARATOR,fCommand,fCaption)
          else
             ModifyMenu(fParent->fHandle,fCommand,MF_BYCOMMAND,fCommand,fCaption)
          end if
       end if
    end if
end property

property QMenu.Checked as boolean
    return FChecked
end property

property QMenu.Checked(v as boolean)
    fChecked=v
    if fParent then
       if fHandle then
          CheckMenuItem(fParent->fHandle,cint(fHandle),MF_POPUP OR fCheck(fChecked))
       else
          CheckMenuItem(fParent->fHandle,fCommand,MF_BYCOMMAND OR fCheck(fChecked))
       end if
    end if
end property

property QMenu.RadioItem as Boolean
    return FRadioItem
end property

property QMenu.RadioItem(Value as Boolean)
    FRadioItem = Value
    Dim as Integer First,Last
    if fParent then
       First = fParent->fItems[0]->fCommand
       Last  = fParent->fItems[fParent->fCount -1]->fCommand
       CheckMenuRadioItem fParent->fHandle,First,Last,fCommand,MF_BYCOMMAND
    end if
end property

property QMenu.Enabled as Boolean
    return FEnabled
end property

property QMenu.Enabled(Value as Boolean)
    FEnabled = Value
    if fParent then
       if fHandle then
          EnableMenuItem(fParent->fHandle,cint(fHandle),MF_POPUP OR FEnable(FEnabled))
       else
          EnableMenuItem(fParent->fHandle,fCommand,MF_BYCOMMAND OR FEnable(FEnabled))
       end if
    end if
end property

property QMenu.Visible as Boolean
    return FVisible
end property

property QMenu.Visible(Value as Boolean)
    FVisible = Value
    if fVisible = False then
       if fParent then
          RemoveMenu fParent->fHandle,fCommand,MF_BYCOMMAND
       end if
    else
       if fParent then
          if fHandle then
             InsertMenu fParent->fHandle,fIndex,MF_BYPOSITION OR MF_POPUP OR MF_STRING,cint(fHandle),FCaption
          else
             if FCaption = "-" then
                InsertMenu fParent->fHandle,fIndex,MF_BYPOSITION OR MF_SEPARATOR,cint(fIndex),FCaption
             else
                InsertMenu fParent->fHandle,fIndex,MF_BYPOSITION OR MF_STRING OR fCheck(fChecked) OR fEnable(fEnabled),cint(fCommand),fCaption
             end if
          end if
       else
          InsertMenu fParent->fHandle,fIndex,MF_BYPOSITION OR MF_POPUP OR MF_STRING,cint(fHandle),fCaption
       end if
    end if
end property

property QMenu.Count as integer
    return fcount
end property

property QMenu.Item(i as integer)byref as QMenu
    if i>-1 and i<fcount then return *fitems[i]
    return *cast(PMenu,0)
end property

property QMenu.Item (i as integer,byref v as QMenu)
    if i>-1 and i<fcount then fitems[i]=v
end property

function QMenu.IndexOf(v as PMenu) as integer
    for i as integer=0 to fcount-1
        if v=fitems[i] then return i
    next
    return -1
end function

sub QMenu.TraverseMenu(v as hmenu)
    dim as MENUITEMINFOA mif
    mif.cbsize=sizeof(mif)
    mif.fmask=miim_data or miim_id
    for i as integer=0 to GetMenuItemCount(v)-1
        GetMenuItemInfoA(v,i,true,@mif)
        mif.dwitemdata=cint(@this)
        SetMenuItemInfoA(v,i,true,@mif)
        v=GetSubMenu(v,i)
        TraverseMenu(v)
    next
end sub

sub QMenu.LoadFromResourceName(v as string)
    if v="" then exit sub
    if FindResource(instance,v,rt_menu)>0 then
       fhandle=LoadMenu(instance,v)
       if isMenu(fhandle) then
           for i as integer=0 to GetMenuItemCount(fhandle)-1
               dim as MENUITEMINFOA mif
               mif.cbsize=sizeof(mif)
               mif.fmask=miim_data or miim_id
               GetMenuItemInfo(GetSubMenu(fhandle,i),i,true,@mif)
               mif.dwitemdata=cint(@this)
               SetMenuItemInfoA(GetSubMenu(fhandle,i),i,true,@mif)
               TraverseMenu(GetSubMenu(fhandle,i))
           next
       end if
    end if
end sub

sub QMenu.Add(v as PMenu)
    if indexOf(v)=-1 then
       fcount+=1
       fItems=reallocate(fitems,fcount*sizeof(PMenu))
       fitems[fcount-1]=v
       v->fparent=this
       if fcount then if fhandle=0 then fhandle=CreatePopupMenu
       for i as integer=0 to fcount-1
           fitems[i]->findex=i
           fitems[i]->fparent=this
       next
       AppendMenu(fhandle,iif(v->fhandle,mf_popup,iif(v->fcaption="-",mf_separator,mf_string or mf_bycommand)),iif(v->fhandle,cint(v->fhandle),v->fcommand),v->fcaption)
       dim as MENUITEMINFOA mif
       mif.cbsize=sizeof(mif)
       mif.fmask=miim_data or miim_id
       mif.dwitemdata=cint(v)
       mif.wid=iif(v->fcaption="-",-1,AllocateMenuUniqueID)
       SetMenuItemInfo(fhandle,GetMenuItemCount(fhandle)-1,true,@mif)
    end if
end sub

sub QMenu.Remove(v as PMenu)
    dim as integer w=indexOf(v)
    if w>-1 then
       for i as integer=w+1 to fcount-1
           fitems[i-1]=fitems[i]
       next i
       fcount+=1
       fItems=reallocate(fitems,fcount*sizeof(PMenu))
       if isMenu(v->fhandle) then DestroyMenu(v->fhandle)
    end if
end sub

operator QMenu.cast as any ptr
    return @this
end operator

operator QMenu.cast as const string
    return "QMenu"
end operator

constructor QMenu
    fcaption=" "
    fEnabled = 1
    fChecked = 0
    fCheck(0)  = MF_UNCHECKED
    fCheck(1)  = MF_CHECKED
    fEnable(0) = MF_DISABLED OR MF_GRAYED
    fEnable(1) = MF_ENABLED
end constructor

destructor QMenu
    if isMenu(fhandle) then destroymenu(fhandle)
end destructor

function QMenu.GetProperties as zstring ptr '''published properties
    dim as string s="Caption"+LF+"Checked"+LF+"RadioItem"+LF+"Enabled"+LF+"Visible"+LF+"Parent"+lf+"CommandID",u=*Base.GetProperties
    dim as zstring ptr zs=callocate(len(s+u)+1)
    *zs=u+lf+s+chr(0)
    return zs
end function

function QMenu.GetPropertyInfo(n as string) as PELPropInfo
    if n="" then return 0
    dim as PELPropInfo PropInfo=0
    if PropInfo=0 then PropInfo=new QELPropInfo
    select case lcase(n)
    case "checked","radioitem","enabled","visible"
         propinfo->name=callocate(len(n)+1)
         *propinfo->name=n
         propinfo->typekind=tkBool
         return propinfo
    case "caption"
         propinfo->name=callocate(len(n)+1)
         *propinfo->name=n
         propinfo->typekind=tkString
         return propinfo
    case "commandid"
         propinfo->name=callocate(len(n)+1)
         *propinfo->name=n
         propinfo->typekind=tkInteger
         return propinfo
    case "parent"
         propinfo->name=callocate(len(n)+1)
         *propinfo->name=n
         dim as string s=str(cint(fparent))
         propinfo->value=callocate(len(s)+1)
         *propinfo->value=s
         propinfo->typekind=tkType
         return propinfo
    case else
         return Base.GetPropertyInfo(n)
    end select
end function

function QMenu.SetProperty(p as string,v as zstring ptr) as boolean
    if p="" then return 0
    select case lcase(p)
    case "parent"
         dim as integer i=val(*v)
         parent=*cast(pmenu,i)
         return parent.handle>0
    case "checked"
         dim as string s=str(fchecked)
         dim as integer vl=valint(*v)
         checked=vl
         return fchecked
    case "radioitem"
         dim as string s=str(fradioitem)
         dim as integer vl=valint(*v)
         radioitem=vl
         return fradioitem
    case "enabled"
         dim as string s=str(fenabled)
         dim as integer vl=valint(*v)
         enabled=vl
         return fenabled
    case "visible"
         dim as string s=str(fvisible)
         dim as integer vl=valint(*v)
         visible=vl
         return fvisible
    case "caption"
         dim as string s=fcaption
         caption=*v
         return s<>""
    case "commandid"
         dim as string s=str(fcommand)
         dim as integer vl=valint(*v)
         commandid=vl
         return fcommand>0
    case else
       return Base.SetProperty(p,v)
    end select
end function

function QMenu.GetProperty(p as string) as zstring ptr
    if p="" then return 0
    select case lcase(p)
    case "parent"
       dim as integer i=cint(fparent)
       dim as string s=str(i)
       dim as zstring ptr zs=callocate(len(s)+1)
       *zs=s+chr(0)
       return zs
    case "commandid"
       dim as integer i=commandid
       dim as string s=str(i)
       dim as zstring ptr zs=callocate(len(s)+1)
       *zs=s+chr(0)
       return zs
    case "checked"
       dim as integer i=checked
       dim as string s=str(i)
       dim as zstring ptr zs=callocate(len(s)+1)
       *zs=s+chr(0)
       return zs
    case "radioitem"
       dim as boolean i=radioitem
       dim as string s=str(i)
       dim as zstring ptr zs=callocate(len(s)+1)
       *zs=s+chr(0)
       return zs
    case "enabled"
       dim as boolean i=enabled
       dim as string s=str(i)
       dim as zstring ptr zs=callocate(len(s)+1)
       *zs=s+chr(0)
       return zs
    case "visible"
       dim as boolean i=visible
       dim as string s=str(i)
       dim as zstring ptr zs=callocate(len(s)+1)
       *zs=s+chr(0)
       return zs
    case "caption"
       dim as string s=caption
       dim as zstring ptr zs=callocate(len(s)+1)
       *zs=s+chr(0)
       return zs
    case else
       return Base.GetProperty(p)
    end select
end function

/' QMainMenu '/
sub QMainMenu.Refresh(v as hwnd)
    if isWindow(v) then
       setmenu(v,fhandle)
       drawmenubar(v)
    end if
end sub

operator QMainMenu.cast as const string
    return "QMainMenu"
end operator

operator QMainMenu.cast as any ptr
    return @this
end operator

operator QMainMenu.cast as hmenu
    return fhandle
end operator

constructor QMainMenu
    this.fhandle=CreateMenu
end constructor

destructor QMainMenu
    if isMenu(this.fhandle) then destroymenu this.fhandle
end destructor

/' QPopupMenu '/
operator QPopupMenu.cast as const string
    return "QPopupMenu"
end operator

operator QPopupMenu.cast as any ptr
    return @this
end operator

operator QPopupMenu.cast as hmenu
    return fhandle
end operator

constructor QPopupMenu
    this.fhandle=CreatePopupMenu
end constructor

destructor QPopupMenu
    if isMenu(this.fhandle) then destroymenu this.fhandle
end destructor

sub GUI11_Menus_Initialization constructor
    MenuID=0'100 'or a valaue which you desire...but be carefull to mdi menu
end sub

sub GUI11_Menus_Finalization destructor
end sub
