Auto création d'un Menu Panoramic

' Auto création d'un Menu Panoramic Pascal 1000, Minibug, Jean Claude

DIM no% :' en principe cette variable existe
no%=9 :' pour caler le premier main_menu à 10

WIDTH 0,600 : HEIGHT 0,60 : LEFT 0,400


DIM main_menu%(5):' possibilité de créer 5 main_menu
Create_Menu(1) :' en paramètre le numéro d'ordre du menu
END
rem ============================================================================
SUB Create_Menu(num_menu%)
    ' gestion des variables et label(s)
    if variable("NumSubMenu%")=0 then dim NumSubMenu%
    if variable("NumObjMainMenu%")=0 then dim NumObjMainMenu%
    if variable("n%")=0 then dim n%
    if variable("dlist_menu%")=0 then dim dlist_menu%
    if label("Nom_Sub_Menu")=0 then label Nom_Sub_Menu

    ' création du dlist contenant le code
    no%=no%+1 : LIST no% : dlist_menu%=no%

    ' création de main_menu
    no%=no%+1 : MAIN_MENU no% : main_menu%(num_menu%)=no% : NumObjMainMenu%=no% : NumSubMenu%=no%+1
    ' enregistrement provisoire
    ITEM_ADD dlist_menu%,"MAIN_MENU "+str$(no%)
    SUB_MENU NumSubMenu% : PARENT NumSubMenu%,no% : CAPTION NumSubMenu%,STRING$(10," ") : ON_CLICK NumSubMenu%,Nom_Sub_Menu : NumSubMenu%=NumSubMenu%+1
END_SUB
Nom_Sub_Menu:
  IF message_input("Edit Menu", "Sub_Menu" , "")=1
      CAPTION NUMBER_CLICK,MESSAGE_TEXT$
      OFF_CLICK NUMBER_CLICK
      ' enregistrement provisoire
      ITEM_ADD dlist_menu%,"  SUB_MENU "+str$(NUMBER_CLICK)+" : PARENT "+str$(NUMBER_CLICK)+","+str$(NumSubMenu%-2)+" : CAPTION "+str$(NUMBER_CLICK)+","+chr$(34)+caption$(NUMBER_CLICK)+chr$(34)
      IF message_confirmation_yes_no("Voulez-vous continuer votre menu ?")=1
        IF OBJECT_TYPE(OBJECT_PARENT(NUMBER_CLICK))=12
            SUB_MENU NumSubMenu% : PARENT NumSubMenu%,NumObjMainMenu% : CAPTION NumSubMenu%,STRING$(10," ") : ON_CLICK NumSubMenu%,Nom_Sub_Menu : NumSubMenu%=NumSubMenu%+1
            SUB_MENU NumSubMenu% : PARENT NumSubMenu%,NUMBER_CLICK : CAPTION NumSubMenu%,STRING$(10," ") : ON_CLICK NumSubMenu%,Nom_Sub_Menu : NumSubMenu%=NumSubMenu%+1
        END_IF
        IF OBJECT_TYPE(OBJECT_PARENT(NUMBER_CLICK))=13
            SUB_MENU NumSubMenu% : PARENT NumSubMenu%,OBJECT_PARENT(NUMBER_CLICK) : CAPTION NumSubMenu%,STRING$(10," ") : ON_CLICK NumSubMenu%,Nom_Sub_Menu : NumSubMenu%=NumSubMenu%+1
            SUB_MENU NumSubMenu% : PARENT NumSubMenu%,NUMBER_CLICK : CAPTION NumSubMenu%,STRING$(10," ") : ON_CLICK NumSubMenu%,Nom_Sub_Menu : NumSubMenu%=NumSubMenu%+1
        END_IF
      ELSE
      width dlist_menu%,600
        FOR n%=NumObjMainMenu%+1 to NumSubMenu%-1
            IF CAPTION$(n%)=STRING$(10," ") THEN ITEM_DELETE dlist_menu%,n% : DELETE n%
        NEXT n%
      END_IF
  ELSE
      message "Vous devez donner un nom !" : gosub Nom_Sub_Menu
  END_IF
RETURN
rem ============================================================================

' Auto création d'un Menu Panoramic Pascal 1000, Minibug, Jean Claude

DIM no% :' en principe cette variable existe
no%=9 :' pour caler le premier main_menu à 10
DIM numberclick
WIDTH 0,600 : HEIGHT 0,60 : LEFT 0,400


DIM main_menu%(5):' possibilité de créer 5 main_menu
Create_Menu(1) :' en paramètre le numéro d'ordre du menu
END
rem ============================================================================
SUB Create_Menu(num_menu%)
    ' gestion des variables et label(s)
    if variable("NumSubMenu%")=0 then dim NumSubMenu%
    if variable("NumObjMainMenu%")=0 then dim NumObjMainMenu%
    if variable("n%")=0 then dim n%
    if variable("dlist_menu%")=0 then dim dlist_menu%
    if label("Nom_Sub_Menu")=0 then label Nom_Sub_Menu

    ' création du dlist contenant le code
    no%=no%+1 : LIST no% : dlist_menu%=no%

    ' création de main_menu
    no%=no%+1 : MAIN_MENU no% : main_menu%(num_menu%)=no% : NumObjMainMenu%=no% : NumSubMenu%=no%+1
    ' enregistrement provisoire
    ITEM_ADD dlist_menu%,"MAIN_MENU "+str$(no%)
    SUB_MENU NumSubMenu% : PARENT NumSubMenu%,no% : CAPTION NumSubMenu%,STRING$(10," ") : ON_CLICK NumSubMenu%,Nom_Sub_Menu : NumSubMenu%=NumSubMenu%+1
END_SUB
Nom_Sub_Menu:
  IF message_input("Edit Menu", "Sub_Menu" , "")=1
      numberclick = NUMBER_CLICK : CAPTION numberclick,MESSAGE_TEXT$
      OFF_CLICK numberclick
      ' enregistrement provisoire
      ITEM_ADD dlist_menu%,"  SUB_MENU "+str$(numberclick)+" : PARENT "+str$(numberclick)+","+str$(NumSubMenu%-2)+" : CAPTION "+str$(numberclick)+","+chr$(34)+caption$(numberclick)+chr$(34)
      IF message_confirmation_yes_no("Voulez-vous continuer votre menu ?")=1
        IF OBJECT_TYPE(OBJECT_PARENT(numberclick))=12
            SUB_MENU NumSubMenu% : PARENT NumSubMenu%,NumObjMainMenu% : CAPTION NumSubMenu%,STRING$(10," ") : ON_CLICK NumSubMenu%,Nom_Sub_Menu : NumSubMenu%=NumSubMenu%+1
            SUB_MENU NumSubMenu% : PARENT NumSubMenu%,numberclick : CAPTION NumSubMenu%,STRING$(10," ") : ON_CLICK NumSubMenu%,Nom_Sub_Menu : NumSubMenu%=NumSubMenu%+1
        END_IF
        IF OBJECT_TYPE(OBJECT_PARENT(numberclick))=13
            SUB_MENU NumSubMenu% : PARENT NumSubMenu%,OBJECT_PARENT(numberclick) : CAPTION NumSubMenu%,STRING$(10," ") : ON_CLICK NumSubMenu%,Nom_Sub_Menu : NumSubMenu%=NumSubMenu%+1
            SUB_MENU NumSubMenu% : PARENT NumSubMenu%,numberclick : CAPTION NumSubMenu%,STRING$(10," ") : ON_CLICK NumSubMenu%,Nom_Sub_Menu : NumSubMenu%=NumSubMenu%+1
        END_IF
      ELSE
      width dlist_menu%,600
        FOR n%=NumObjMainMenu%+1 to NumSubMenu%-1
            IF CAPTION$(n%)=STRING$(10," ") THEN ITEM_DELETE dlist_menu%,n% : DELETE n%
        NEXT n%
      END_IF
  ELSE
      message "Vous devez donner un nom !" : gosub Nom_Sub_Menu
  END_IF
RETURN
rem ============================================================================

' editeur_de_menu.bas
'
' Le menu est constitué dans un fichier texte.
' Me caractère "-" indique le niveau d'indention
' Le fichier est présenté dans un mémo, éditable.
' Il peut être sauvegardé et restauré.
' Un bouton permet de générer le code source du menu dans un autre mémo.
' Un spin donne le numéro d'objet de départ pour la création de tous les objets.

label load, save, generate, export, copy

dim no%, no1%, no_open%, no_save%, no_bas%, no_mnu%, no_stack%, no_start%, no_label%
dim f$, i%, s$, niv%, gg$, lab$
gg$ = chr$(34)

width 0,1000
no% = 1000 : no_mnu% = no%
no1% = no%
memo no% : top no%,10 : left no%,10 : width no%,400 : height no%,300 : bar_both no%
  font_name no%,"Courier" : font_size no%,10
no% = no% + 1 : button no% : top no%,top(no1%) : left no%,left(no1%)+width(no1%)+10
  caption no%,"Ouvrir" : on_click no%,load
no% = no% + 1 : button no% : top no%,top(no%-1)+30 : left no%,left(no%-1)
  caption no%,"Sauver" : on_click no%,save
no% = no% + 1 :alpha no% : top no%,top(no%-1)+50 : left no%,left(no%-1)
  caption no%,"Numéro de début:"
no% = no% + 1 : no_start% = no% : spin no%
  top no%,top(no%-1)+20 : left no%,left(no%-1) : width no%,80
  min no%,1 : max no%,10000 : position no%,100
no% = no% + 1 :alpha no% : top no%,top(no%-1)+30 : left no%,left(no%-1)
  caption no%,"Label onclick:"
no% = no% + 1 : no_label% = no% : edit no%
  top no%,top(no%-1)+20 : left no%,left(no%-1) : width no%,80
no% = no% + 1 : button no% : top no%,top(no%-1)+50 : left no%,left(no%-1)
  caption no%,"Générer" : on_click no%,generate
no% = no% + 1 : button no% : top no%,top(no%-1)+50 : left no%,left(no%-1)
  caption no%,"Exporter" : on_click no%,export
no% = no% + 1 : button no% : top no%,top(no%-1)+30 : left no%,left(no%-1)
  caption no%,"Copier" : on_click no%,copy
no% = no% + 1 : no_bas% = no% : memo no%
  top no%,top(no1%) : left no%,left(no1%+1)+width(no1%+1)+20
  width no%,width(no1%) : height no%,height(no1%) :inactive no%
no% = no% + 1 : no_open% = no% : open_dialog no%
no% = no% + 1 : no_save% = no% : save_dialog no%
no% = no% + 1 : no_stack% = no% : dlist no%
end

load:
  filter no_open%,"Fichier source menu|*.mnu"
  f$ = file_name$(no_open%)
  if f$="_" then return
  if lower$(right$(f$,4))<>".mnu" then f$ = f$ + ".mnu"
  if file_exists(f$)=0
    message "Ce fichier n'existe pas."
    message f$
    return
  end_if
  file_load no_mnu%,f$
  return
 
save:
  filter no_save%,"Fichier source menu|*.mnu"
  f$ = file_name$(no_save%)
  if f$="_" then return
  if lower$(right$(f$,4))<>".mnu" then f$ = f$ + ".mnu"
  if file_exists(f$)=1
    if message_information_yes_no("Ce fichier existe déjà. Remplacer ?")<>1 then return
  end_if
  file_save no_mnu%,f$
  return
 
export:
  filter no_save%,"Fichier source Panoramic|*.bas"
  f$ = file_name$(no_save%)
  if f$="_" then return
  if lower$(right$(f$,4))<>".bas" then f$ = f$ + ".bas"
  if file_exists(f$)=1
    if message_information_yes_no("Ce fichier existe déjà. Remplacer ?")<>1 then return
  end_if
  file_save no_bas%,f$
  message "Le texte généré a été enregistré."
  return
 
copy:
  if count(no_bas%)=0
    message "Il n'y a rien à copier."
    return
  end_if
  s$ = ""
  for i%=1 to count(no_bas%)
    s$ = s$ + item_read$(no_bas%,i%) +chr$(13) + chr$(10)
  next i%
  clipboard_string_copy s$
  message "Le texte généré a été copié dans le presse-papier."
  return

generate:
  if count(no_mnu%)=0
    message "Rien à générer."
    return
  end_if
  lab$ = trim$(text$(no_label%))
  if len(lab$)=0
    message "Le label n'est pas défini - 'Click' est utilisé par défaut."
    lab$ = "Click"
    text no_label%,lab$
  end_if
  no% = position(no_start%)
  clear no_bas%
  clear no_stack%
  item_add no_bas%,"label "+lab$
  item_add no_bas%,"main_menu "+str$(no%)
  item_add no_stack%,str$(no%)
  for i%=1 to count(no_mnu%)
    s$ = item_read$(no_mnu%,i%)
      niv% = 0
      while left$(s$,1)="-"
        niv% = niv% + 1
        s$ = mid$(s$,2,len(s$))
      end_while
      if niv%>=count(no_stack%)
        if niv%>(count(no_stack%)+1)
          message "Oups - erreur dans la structure à la ligne "+str$(i%)+chr$(13)+chr$(10)+s$
          return
        end_if
        item_add no_stack%,str$(no%)
      else
        while niv%<(count(no_stack%)-1)
          item_delete no_stack%,count(no_stack%)
        end_while
      end_if
      no% = no% + 1
      item_add no_bas%,"sub_menu "+str$(no%)
      item_add no_bas%,"  parent "+str$(no%)+","+item_read$(no_stack%,count(no_stack%))
      item_add no_bas%,"  caption "+str$(no%)+","+gg$+s$+gg$
      item_add no_bas%,"  on_click "+str$(no%)+","+lab$
  next i%
  item_add no_bas%,"end"
  item_add no_bas%,""
  item_add no_bas%,lab$ + ":"
  item_add no_bas%,"  Sub"+lab$+"()"
  item_add no_bas%,"  return"
  item_add no_bas%,""
  item_add no_bas%,"sub Sub"+lab$+"()"
  item_add no_bas%,"  dim_local obj%"
  item_add no_bas%,"  obj% = number_click"
  item_add no_bas%,"  select obj%"
  item_add no_bas%,"    case "+str$(position(no_start%)+1)
  item_add no_bas%,"'    case "
  item_add no_bas%,"'    case "
  item_add no_bas%,"'    case "
  item_add no_bas%," end_select"
  item_add no_bas%,"end_sub"


  return

Fichiers
-Ouvrir
--Texte
--Panoramic
---Ancien
---Nouveau
--RTF
-Nouveau
--Texte
--Panoramic
---Ancien
---Nouveau
--RTF
-Fermer
Edition
-Copier
-Coller

label Click
main_menu 100
sub_menu 101
  parent 101,100
  caption 101,"Fichiers"
  on_click 101,Click
sub_menu 102
  parent 102,101
  caption 102,"Ouvrir"
  on_click 102,Click
sub_menu 103
  parent 103,102
  caption 103,"Texte"
  on_click 103,Click
sub_menu 104
  parent 104,102
  caption 104,"Panoramic"
  on_click 104,Click
sub_menu 105
  parent 105,104
  caption 105,"Ancien"
  on_click 105,Click
sub_menu 106
  parent 106,104
  caption 106,"Nouveau"
  on_click 106,Click
sub_menu 107
  parent 107,102
  caption 107,"RTF"
  on_click 107,Click
sub_menu 108
  parent 108,101
  caption 108,"Nouveau"
  on_click 108,Click
sub_menu 109
  parent 109,108
  caption 109,"Texte"
  on_click 109,Click
sub_menu 110
  parent 110,108
  caption 110,"Panoramic"
  on_click 110,Click
sub_menu 111
  parent 111,110
  caption 111,"Ancien"
  on_click 111,Click
sub_menu 112
  parent 112,110
  caption 112,"Nouveau"
  on_click 112,Click
sub_menu 113
  parent 113,108
  caption 113,"RTF"
  on_click 113,Click
sub_menu 114
  parent 114,101
  caption 114,"Fermer"
  on_click 114,Click
sub_menu 115
  parent 115,100
  caption 115,"Edition"
  on_click 115,Click
sub_menu 116
  parent 116,115
  caption 116,"Copier"
  on_click 116,Click
sub_menu 117
  parent 117,115
  caption 117,"Coller"
  on_click 117,Click
end

Click:
  SubClick()
  return

sub SubClick()
  dim_local obj%
  obj% = number_click
  select obj%
    case 101
'    case
'    case
'    case
 end_select
end_sub

label creer,creerenfant,depart,tri
dim nomme$, spac$, num%, num2%, num3%, pare%, retour
spac$="

width 0,600 : height 0,60
left 0,400
hide 0
main_menu 1000

sub_menu 1100 : parent 1100,1000 : caption 1100,"Commencer ici"
on_click 1100,depart
sub_menu 1200 : parent 1200,1000 : caption 1200,string$(10," ") : inactive 1200
on_click 1200,depart
sub_menu 1300 : parent 1300,1000 : caption 1300,string$(10," ") : inactive 1300
on_click 1300,depart
sub_menu 1400 : parent 1400,1000 : caption 1400,string$(10," ") : inactive 1400
on_click 1400,depart
sub_menu 1500 : parent 1500,1000 : caption 1500,string$(10," ") : inactive 1500
on_click 1500,depart
sub_menu 1600 : parent 1600,1000 : caption 1600,string$(10," ") : inactive 1600
on_click 1600,depart
sub_menu 1700 : parent 1700,1000 : caption 1700,string$(10," ") : inactive 1700
on_click 1700,depart
sub_menu 1800 : parent 1800,1000 : caption 1800,string$(10," ") : inactive 1800
on_click 1800,depart
sub_menu 1900 : parent 1900,1000 : caption 1900,string$(10," ") : inactive 1900
on_click 1900,depart
sub_menu 2000 : parent 2000,1000 : caption 2000,string$(10," ") : inactive 2000
on_click 2000,depart

' form pour enfant option
form 200
left 200,629
Top 200,340
Width 200,242
Height 200,120
Caption 200,"Option"

hide 200

command_target_is 200

edit 201
left 201,10
Top 201,10
Width 201,120

check 203
top 203,10
left 203,140
width 203,60
caption 203,"Enfant"
hide 203

button 202
top 202,40
left 202,60
caption 202,"OK"
on_click 202,tri


show 0
set_focus 0
end

' ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
depart:
num%=number_click  :' defini le click
pare%=object_parent(num%)  :' defini son parent

if object_type(pare%)=12
hide 203
off_click num%
pare%=num%
if num%+100<2100 then active num%+100
end_if

text 201,""

show 200 :' ouvre de saisi du caption
set_focus 201
return
' ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo

' ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
tri:
if checked(203)=1
gosub creerenfant
else
gosub creer
end_if
return
' ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo

' ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
creer:
nomme$=text$(201)
caption num%,nomme$
hide 200

    message caption$(num%)+" "+ str$(num2%)+" "+ str$(num3%)

num%=num%+1

if num%>1100 then show 203

if num%<>num2%
sub_menu num% : parent num%,pare% : caption num%,string$(10," ")
end_if

num2%=num%
on_click num%,depart
return
' ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo

' ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
' créer l'enfant
creerenfant:
nomme$=text$(201)
caption num%,nomme$
hide 200
show 203

num3%=num3%+20 : ' nouveau sub_menu en desous de num%
sub_menu num3% : parent num3%,pare% : caption num3%,string$(10," ")

num2%=num%+2 : ' l'enfant de num
sub_menu num2% : parent num2%,num% : caption num2%,string$(10," ")

    message caption$(num%)+" "+ str$(num2%)+" "+ str$(num3%)


off_click num%
on_click num2%,depart
on_click num3%,depart
return
' ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo

' ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo