Menu pop_up

' programmation d'un MENU POP_UP

' --------------programmation minimum de départ--------------------
dim s_menu%            :  s_menu%=10              :' défini le 1er objet qui FORM pour menu pop_up donc ici de 10 à 16
label ini_menu_pop_up  :  gosub ini_menu_pop_up  :' initialise l'ensemble des outils
' ---------- retour de l'initialisation ------------
' initialisation du programme général
width 0,600:height 0,350 :top 0,100 :left 0,100

' création d'un objet sur lequel on teste un clic_droit pour ouvrir un menu pop_up
list    1 :left 1,30:top 1,10 :width 1,250 : height 1,50 : hint 1,"clic droit:menu"
          item_add 1, "texte possédant un menu pop-up"  : item_add 1, "les objets colorés sont cliquable clic droit"
picture 2 :top 2,180 :width 2,200                        : hint 2,"clic droit:menu"
memo    3 :top 3,60:height 3,100                        :' affiche les variables permettant de programmer
                                                          ' le retour des clic
color 1,247,251,198:color 2,247,251,198

' ---------------------------------------------------------------------------------
' faire les tables des menus pop_up selon les objets
  gosub s_menu_miseEnForme  :rem " programmation des menus pop_up pour les objets "
' ---------------------------------------------------------------------------------
end

' ==============================================================================
' ==============================================================================
s_menu_miseEnForme:
  s_menu_objet%=0:' s'incrémentera en voyant "{"
  rem "***********************************************************************************************************"
  rem " NE FONCTIONNE PAS pour les objets: EDIT et MEMO possédant un menu_pop_up d'office et bloque le programme  "
  rem "***********************************************************************************************************"

    ' OBLIGATOIRE DE COMMENCER PAR { une accolade ouverte (défini le menu pour nouvel objet)
  rem "{" sous_menu pour un autre objet
  rem "|" pour le niveau 2 du sou_menu

  rem "Niveau 1  "  N1=niveau 1  N2=niveau 2
  ' ____________________________________________________________
  rem " &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& "
  rem " &&  menu pop_up  pour objet LIST 1  && "
  rem " &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& "
  objet_s_menu%(1)=1  :' menu pop_up de l'objet 1 qui est LIST 1 }"il faut définir le tableau poir l'objet"
  '    { l'accolade ouverte est obligatoire pour commencer le menu d'un nouvel objet ( "}"  est optionnel pour fermer l'objet
                ' pour programmer:  lire
                '                  fermer  avec: fiche |programme
                '                  édition avec: copier|coller
                '                  rouspéter
  rem        " N1  "
  s_menu_a$= "{lire"                        : gosub s_menu_define
  '          _______________________
  rem        "N1    |N2  |N2      "
  s_menu_a$= "fermer>|fiche|programme"      : gosub s_menu_define
  '          _____________________________
  rem        "N1      |N2    |N2    |N2    "
  s_menu_a$= "édition>|couper|copier|coller" : gosub s_menu_define
  '                  ^__ pour mettre la flêche à droite de l'élément

  rem        "N1      "
  s_menu_a$= "rouspéter"                    : gosub s_menu_define
  ' _____________________________________________________________
  rem " &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& "
  rem " &&  menu pop_up pour objet PICTURE  && "
  rem " &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& "
  objet_s_menu%(2)=2                        :' N° de l'objet

  s_menu_a$="{nouveau objet>|soulever|laver" : gosub s_menu_define
  '                        ^__ idem

  '      N1          N2      N3      N3    N2    N3      N3
  ' la ligne suivante n'est pas obligatoire  (seulement pour mettre un objet en accolade) si on veut
  s_menu_a$="}"                              :gosub s_menu_define :' termine l'objet ' DOIT ÊTRE SEUL

  rem "***********************************************************************"
  rem "****                FIN DES DÉFINITIONS A PROGRAMMER              ****"
  rem " **********************************************************************"

  ' STOP  STOP  STOP  STOP  STOP  STOP  STOP  STOP  STOP  STOP  STOP  STOP '
  ' ______________________________________________________________________

            rem "maintenant programmation
    ' --------------------------------------------------------------
    on_error_goto erreur

    clear s_menu%+1:clear s_menu%+4
    for s_menu_objet% =1 to s_menu_fin%
      for s_menu_a%=1 to 10
        if s_menu$(s_menu_objet%,s_menu_a%)<>""
            item_add s_menu%+1,s_menu$(s_menu_objet%,s_menu_a%)
            for s_menu_b%=1 to 10
              if left$(s_menu$(s_menu_objet%,s_menu_a%),1)=left$(s_menu1$(s_menu_objet%,s_menu_b%),1)
                  if s_menu1$(s_menu_objet%,s_menu_b%)<>""
                    item_add s_menu%+4,s_menu1$(s_menu_objet%,s_menu_b%)
                  end_if
              end_if
            next s_menu_b%
        end_if
      next s_menu_a%
    next s_menu_objet%
return
' ==============================================================================
' ==========INITIALISATION MENU POP_UP =========================================
ini_menu_pop_up:
  label  s_menu_reponse        :' une fois objet cliqué et choisi, branchement ici
  label s_menu_teste            :' prévu une fois l'élément cliqué
  label s_menu_define          :' met en tableau les éléments du menu
  label s_menu_table            :' s/prg pour s_menu_define
  label test_mouse_droit        :' le timer vérifie l'éventualité d'un clic droit
  label s_menu_control          :' gestion de l'affichage du menu pop_up
  label s_menu_miseEnForme      :' programmation des différents menus assiciés aux objets (au départ)
  label erreur

  dim s_menu_objet%            :' défini le numéro de l'objet associé à la liste à programmer (mettre en menu pop_up)
  dim s_menu_x%                :' position x de la souris sur l'objet
  dim s_menu_y%                :' position y et n° de l'élément
  dim ss_menu_y%                :' ligne pour s/menu
  dim s_menu_y1%                :' mémoire du passage précédent
  dim s_menu_top%              :' prend la position pour le TOP de form menu%+3 soit s/menu
  dim s_menu_Index%            :' index pour incrémenter le tableau menu
  dim s_menu_Index1%            :' idem mais pour s/menu
  dim mouse%                    :' N° correspondant à l'ensemble du menu d'un objet (l'objet est défini par objet_s_menu%(mouse%)
  dim mouse1%                  :' si = à mouse%, ne réaffiche pas
  dim choi%                    :' pour mettre le tableau en forme 1: menu  2: s/menu
  dim s_menu_fin%              :' nombre d'objets possédant un menu pop_up
  dim passage%                  :' décodage d'erreurs perturbés par le timer (normalement inutile avec ici memo 3)

  dim s_menu$(10,20)            :' table du menu pour 10 objets de 20 éléments verticaux
  dim s_menu1$(10,20)          :' table du sous/menu ici 10 pour 10 objets
  dim objet_s_menu%(20)                                :' défini le numéro d'objet qui correspond au menu
                                ' expl list 1 donc objet 1, donc dans l'ordre des données installées, sera utilisé par list 1
  ' -dim- suivant, remplace les variables: a% b% c% a$ b$ c$ d$
  dim s_menu_a$ , s_menu_c$ , s_menu_b$ , s_menu_d$  , s_menu_a% , s_menu_b% , s_menu_c%
  ' objets pour le fonctionnement
  ' objets pour sous_menu 1er niveau
  form      s_menu% :hide s_menu%:border_hide s_menu%:width s_menu%,150:height s_menu%,200
                    top s_menu%,200 :left s_menu%,200:color s_menu%,255,0,0
  dlist  s_menu%+1
  picture s_menu%+2 :parent s_menu%+2,s_menu%:left s_menu%+2,1:top s_menu%+2,1: :width s_menu%+2,150
                    on_click s_menu%+2, s_menu_teste
  ' ------------------------------------------------------------------------------------------------
  ' objets pour sous_menu 2ème niveau
  form    s_menu%+3 :hide s_menu%+3:border_hide s_menu%+3:width s_menu%+3,150:height s_menu%+3,200
                    top s_menu%+3,200 :left s_menu%+3,350:color s_menu%+3,255,143,0
  dlist  s_menu%+4
  picture s_menu%+5 :parent s_menu%+5,s_menu%+3:left s_menu%+5,1:top s_menu%+5,1: :width s_menu%+5,150
                    on_click s_menu%+5, s_menu_teste
  ' ------------------------------------------------------------------------------------------------
  timer  s_menu%+6 :on_timer s_menu%+6,test_mouse_droit
return

'===============================================================================
s_menu_table:
  select choi%
      case 1                                                :' menu pop_up principal
        item_add s_menu%+1,s_menu_c$                      :    s_menu_Index%=s_menu_Index%+1
        s_menu_d$=chr$(s_menu_Index%+64)                  :    s_menu_c$=s_menu_d$+")"+s_menu_c$:s_menu_c%=0
        s_menu$(s_menu_objet%,s_menu_Index%) = s_menu_c$
      case 2                                                :' s/menu
        item_add s_menu%+4,s_menu_c$                      :    s_menu_Index1%=s_menu_Index1%+1
        s_menu_c%=s_menu_c%+1                              :    s_menu_c$=s_menu_d$+str$(s_menu_c%)+")"+s_menu_c$
        s_menu1$(s_menu_objet%,s_menu_Index1%) = s_menu_c$
  end_select
return
' ==============================================================================
s_menu_define:
  if left$(s_menu_a$,1)="{"
      if len(s_menu_a$)>1 then s_menu_a$=right$(s_menu_a$,len(s_menu_a$)-1)
      s_menu_objet%=s_menu_objet%+1  :  s_menu_Index%=0:s_menu_Index1%=0:s_menu_fin%=s_menu_objet%
      s_menu_Index%=0
  end_if
  s_menu_c$="":choi%=1
  for s_menu_a%=1 to len(s_menu_a$)
      s_menu_b$=mid$(s_menu_a$,s_menu_a%,1)
      if s_menu_b$="|"
        gosub s_menu_table : choi%=2 : s_menu_c$=""
      else
        s_menu_c$=s_menu_c$+s_menu_b$
      end_if
  next s_menu_a%
  if s_menu_c$<>"" and s_menu_b$<>"}" then gosub s_menu_table
return
' ==============================================================================
erreur:
 off_error_goto : timer_off s_menu%+6 : stop
 ' avec le timer, pas de n° de ligne affiché, donc attention
return
' ==============================================================================
test_mouse_droit:
  ' parcourt les objets qui ont un menu pop_up
  for mouse%=1 to s_menu_fin%        :' 2 à modifier selon le nb d'objets
      if mouse_right_down(objet_s_menu%( mouse%))=1 then exit_for
  next mouse%
  if mouse%  <=  s_menu_fin% then gosub s_menu_reponse
return
' ==============================================================================
s_menu_reponse:
  timer_off s_menu%+6
  clear s_menu%+1:clear s_menu%+4
  for s_menu_a%=1 to 10
 '  passage%=passage%+1:item_add 3,passage% :' pour le débogage à cause du timer STOP ne convient pas bien (déplacement de la ligne)
      if s_menu$(mouse%,s_menu_a%)<>""                          :' on ajoute du tableau les éléments ayant le même repère
        item_add s_menu%+1,s_menu$(mouse%,s_menu_a%)
        for s_menu_b%=1 to 10
            if left$(s_menu$(mouse%,s_menu_a%),1)=left$(s_menu1$(mouse%,s_menu_b%),1)
              if s_menu1$(mouse%,s_menu_b%)<>""
                item_add s_menu%+4,s_menu1$(mouse%,s_menu_b%)
              end_if
            end_if
        next s_menu_b%
      end_if
  next s_menu_a%

  repeat : until mouse_right_up(objet_s_menu%(mouse%))=1
  ' positions de la souris pour l'emplacement des objets (et non de la ligne)
  s_menu_x%=mouse_x_position(objet_s_menu%(mouse%))+left(objet_s_menu%(mouse%))
  left s_menu%,s_menu_x% +left(0)                              :' position de form principal au moment du clic droit
  s_menu_y%=mouse_y_position(objet_s_menu%(mouse%))+top(objet_s_menu%(mouse%))+top(0)
  top s_menu%,s_menu_y%+20
  if mouse% <> mouse1%
      s_menu_Index%=0
      2d_target_is s_menu%+2:2d_clear : print_target_is s_menu%+2 :font_name s_menu%+2,"default":font_bold_off s_menu%+2
      for s_menu_a%=1 to 10:if s_menu$(mouse%,s_menu_a%)="" then exit_for  :' connaitre le nb de lignes à afficher
        s_menu_a$=s_menu$(mouse%,s_menu_a%):s_menu_a$=right$(s_menu_a$,len(s_menu_a$)-2):s_menu_a$=left$(s_menu_a$,len(s_menu_a$)-1)
        print " ", s_menu_a$
        s_menu_Index%=s_menu_a%+1
      next s_menu_a%
  end_if
  mouse1%=mouse%
  height s_menu%,( (s_menu_Index%+1 )-2) *14  :  show s_menu%
  timer_interval s_menu%+6,200 : on_timer s_menu%+6, s_menu_control : timer_on s_menu%+6
return

' ==============================================================================
s_menu_control:
  if s_menu_y%<>s_menu_y1%                                :' on affiche seulement si c'est une autre ligne (diminution des flash)
    left s_menu%+3, left(s_menu%)+width(s_menu%)
    top s_menu%+3, top(s_menu%)+s_menu_y%/14            :' 2ème form s/menu
    height s_menu%+3,6*14+5

    ' affiche en normal le menu_pop_up de départ
    2d_target_is s_menu%+2  : print_target_is s_menu%+2 : font_name s_menu%+2,"default"
    2d_pen_color 255,255,255 : 2d_fill_color 255,255,255 : font_color s_menu%+2,0,0,0 : font_bold_off s_menu%+2

    if s_menu_y1%>0 and s_menu_y1%<=count(s_menu%+1)    :' si la ligne est dans les paramètres du dlist
        s_menu_a$=item_read$(s_menu%+1,s_menu_y1%) : 2d_rectangle 0,(s_menu_y1%-1)*14,140,s_menu_y1%*14
        s_menu_a$=right$(s_menu_a$,len(s_menu_a$)-2)                          :' enlève le repère pour l'affichage
        print_locate 5, (s_menu_y1%-1)*14  : print s_menu_a$
    end_if
    ' ensuite affiche la ligne parcourue par la souris

    s_menu_top%=mouse_y_position( s_menu%+2)            :' prend la position pour form s/menu
    top s_menu%+3,s_menu_top% +top(s_menu%)-7            :' form s_menu% + la lig parcourue
    s_menu_y%=(s_menu_top%-6)/14+1                      :' n° de la ligne en cours
    if s_menu_y%>count(s_menu%+1) then s_menu_y%=count(s_menu%+1)

    font_bold s_menu%+2                                  :' on affiche la ligne en sélection
    2d_pen_color 183,196,180:2d_fill_color 255,0,0: font_color s_menu%+2,255,255,255  :' 183,196,180 valeurs avant
    s_menu_a$=item_read$(s_menu%+1,s_menu_y%)    : 2d_rectangle 0,(s_menu_y%-1)*14,140,s_menu_y%*14
    s_menu_a$=right$(s_menu_a$,len(s_menu_a$)-2)
    ' si la droite du texte à ">", alors affichage du triangle avec le chiffre "4" et Webdings
    if instr(s_menu_a$,">")>0
        font_name s_menu%+2,"default":print_locate 5,  (s_menu_y%-1)*14:  print left$(s_menu_a$,instr(s_menu_a$,">")-1)
        font_color s_menu%+2,0,0,0:2d_fill_color 255,255,255
        font_name s_menu%+2,"Webdings"
        print_locate 140,(s_menu_y%-1)*14-2 : print "4"
    else
        font_name s_menu%+2,"default"
        print_locate 5,  (s_menu_y%-1)*14  : print s_menu_a$
    end_if
  end_if
  s_menu_y1%=s_menu_y%                                    :' mémoire pour réafficher normalement le balayage suivant

  s_menu_y%=(mouse_y_position( s_menu%+2)-6)/14+1 :if s_menu_y%>count(s_menu%+1) then s_menu_y%=count(s_menu%+1)
  ' ----------------------------------------------------------------------------

  if right$( item_read$(s_menu%+1,s_menu_y%),1)=">"
    ' dans la 2ème zone, lorsqu'il y a des sous_lignes
    s_menu_b$=  left$( s_menu$(mouse%,s_menu_y%),1)      :' prend le repère de la ligne pour ne choisir dans le s/menu le même repère
    clear s_menu%+4
    for s_menu_a%=1 to 10
        if s_menu_b$=left$(s_menu1$(mouse%,s_menu_a%),1)  :' si le repère du menu est le même du s/menu
          s_menu_c$=s_menu1$(mouse%,s_menu_a%)
          item_add s_menu%+4," "+right$(s_menu_c$,len(s_menu_c$)-3) :' on enlève le repère avant de rajouter ex:  C3)
        end_if
    next s_menu_a%
    height s_menu%+3, count(s_menu%+4)*14
    height s_menu%+5, count(s_menu%+4)*14                :' adapte à la form + picture s/menu
    show s_menu%+3                                      :' on affiche les sous ensembles en normal
    font_color s_menu%+5,0,0,0:font_bold_off s_menu%+5
    2d_target_is s_menu%+5 :2d_clear :2d_fill_color 255,255,255
    2d_pen_color 255,255,255 : 2d_rectangle 0,(s_menu_y%-1)*14-2,145,s_menu_y%*14
    print_target_is s_menu%+5
    for s_menu_a%=1 to count(s_menu%+4)
        print item_read$(s_menu%+4,s_menu_a%)
    next s_menu_a%
    s_menu_x%=mouse_x_position(s_menu%+5)                :' suivre la souris vers la droite vers s/menu (pas trouvé d'autre solution)

    if mouse_x_position(s_menu%+2)> 140 and mouse_x_position(s_menu%+5) > 10 :' dans la zone du s/menu
        timer_interval s_menu%+6,600                      :' on réduit le timer pour diminuer les effets flash
        ss_menu_y%= (mouse_y_position(s_menu%+5)-4)/14 +1 :' on recherche la ligne sur laquelle la souris se déplace
        if ss_menu_y%>count(s_menu%+4) then ss_menu_y%=count(s_menu%+4)
        ' la ligne en cause est affichée en rouge, écriture blanche, et Gras
        2d_fill_color 255,143,0:font_color s_menu%+5,255,255,255
        2d_rectangle 0,(ss_menu_y%-1)*14-2,145,ss_menu_y%*14 :font_bold s_menu%+5
        print_locate 5,(ss_menu_y%-1)*14 :print item_read$(s_menu%+4,ss_menu_y%)
    else
        timer_interval s_menu%+6,200                      :' on augmente la fréquence de balayage en réduisant le temps
    end_if
  else
    font_name s_menu%+2,"default"                        :' si pas ">" alors pas de s/menu et affichage normal
    hide s_menu%+3
  end_if
return

' ==============================================================================

s_menu_teste:
  timer_off s_menu%+6
  item_add 3,"******************************"
  item_add 3,"s_menu_y%    :"+str$(s_menu_y%)
  item_add 3,"ss_menu-y%  :"+str$(ss_menu_y%)
  item_add 3,"s_menu_index%:"+str$(s_menu_index%)
  item_add 3,"      mouse%=" +str$(mouse%)


  rem "***********************************************"
  rem "** objet 1: list 1                          **"
  rem "***********************************************"
  if mouse%=1
      if s_menu_y%>0 and s_menu_y%<= count(s_menu%+1)
        if right$( item_read$(s_menu%+1,s_menu_y%),1)<>">"
            ' menu pop_up
            message  item_read$(s_menu%+1,s_menu_y%)    :item_add 3,item_read$(s_menu%+1,s_menu_y%)
            ' s_menu_y% 1= lire
            ' s_menu_y% 4= rouspéter
        else
        ' sous-menu pop_up
            if ss_menu_y%>0 and ss_menu_y% <= count(s_menu%+4)
              message  item_read$(s_menu%+4,ss_menu_y%):item_add 3,item_read$(s_menu%+4,ss_menu_y%)
              ' si s_menu_y%=2 :>>    ss_menu_y%=1:fiche  /  ss_menu_y%=2:programme
              if s_menu_y%=2 and ss_menu_y%=2 then terminate
            end_if
        end_if
      end_if
  end_if

  rem "***********************************************"
  rem "** objet 2: picture 2                        **"
  rem "***********************************************"
  if mouse%=2
      if right$( item_read$(s_menu%+1,s_menu_y%),1)<>">"
      ' menu pop_up
        message  item_read$(s_menu%+1,s_menu_y%)    :item_add 3,item_read$(s_menu%+1,s_menu_y%)
      else
      ' sous-menu pop_up
        if ss_menu_y%>0 and ss_menu_y% <= count(s_menu%+4)
            message item_read$(s_menu%+4,ss_menu_y%)  :item_add 3,item_read$(s_menu%+4,ss_menu_y%)
        end_if
      end_if
  end_if

  rem "***********************************************"
  rem "** objet 3: à définir                        **"
  rem "***********************************************"
  if mouse%=3
      if right$( item_read$(s_menu%+1,s_menu_y%),1)<>">"
      ' menu pop_up
        message  item_read$(s_menu%+1,s_menu_y%)
      else
      ' sous-menu pop_up
        if ss_menu_y%>0 and ss_menu_y% <= count(s_menu%+4)
            ' programmation de chaque sous-menu

        end_if
      end_if
  end_if
  hide s_menu%:hide s_menu%+3
  on_timer s_menu%+6,test_mouse_droit
  timer_on s_menu%+6
return

test_mouse_droit:
  ' parcourt les objets qui ont un menu pop_up
  for a%=1 to 2        :' 2 à modifier selon le nb d'objets
      if mouse_right_down(objet_s_menu%( a%))=1 then gosub s_menu_reponse
  next a%
return