Nombre d'objets

numéro: 21                                        type:MEMO  déclaration ligne : 14
numéro: 22 to 26 (ligne 15)          var:i%      type:EDIT  declaration ligne : 16
numéro: number_objects+1 (ligne 13) var:MaListe%  type:LIST  déclaration ligne : 19

dim num_F%
 dim tp%
 dim lft%
 dim wth%
 dim hgt%
 dim brd_hd%
 dim clr_r%
 dim clr_g%
 dim clr_b%
 dim dumy%
 dim dummy$
 dim I%
 dim compteur%
 ' Définition des tableaux

 dim Tbl_Dictionnaire$(100)
 dim Tbl_variables$(100)
  I%=0
 Tbl_Dictionnaire$(I%)="dim"
  I%=I%+1
  Tbl_Dictionnaire$(I%)="label"
 
 ' Définitions des labels
  Label list1,list2,list3,list4,list5,list6
' Initialisation des variables pour la fenêtre 1
 num_f%=1
 tp%=30
 lft%=440
 wth%=153
 hgt%=445
 brd_hd%=1
 num_f%=2
 tp%=0
 lft%=0
 wth%=130
 hgt%=400
 brd_hd%=1
 clr_r% = 240
 clr_g% = 240
 clr_b% = 240


 ' ************************************
 ' Form 1 pour receptacle les variables
  form 1
  top 1,30
  left 1,440
  width 1,153
  height 1,445
  caption 1,"Dim"
  border_small 1
' **************************************
 ' List pour les variables
  command_target_is 1
  list 2
  top 2,0
  left 2,0
  width 2,133
  height 2,410
  parent 2,1
  color 2,240,240,240
  show 2


  ' ************************************
 ' Form 3 pour receptacle les variables
  form 3
  top 3,25
  left 3,440
  width 3,153
  height 3,445
  caption 3,"Labels"
  border_small 3

  ' *************************************
  ' Pour les labels
  command_target_is 3
    list 4
    top 4,0
    left 4,0
    width 4,133
    height 4,410
    parent 4,3
    color  4,240,240,240
    show 4
    item_add 4,"Label0"
    item_add 4,"Label1"
    item_add 4,"Label2"
    item_add 4,"Label3"
    item_add 4,"Label4"

 ' ************************************
 ' Form 5 pour receptacle les goto
  form 5
  top 5,25
  left 5,440
  width 5,153
  height 5,445
  caption 5,"GOTO"
  border_small 5

  ' *************************************
  ' List pour les goto
  command_target_is 5
    list 6
    top 6,0
    left 6,0
    width 6,133
    height 6,410
    parent 6,5
    color  6,240,240,240
    show 6
    item_add 6,"goto0"
    item_add 6,"goto1"
    item_add 6,"goto2"
    item_add 6,"goto3"
    item_add 6,"goto4"
   
 ' ************************************
 ' Form 7 pour receptacle les gosub
  form 7
  top 7,25
  left 7,440
  width 7,153
  height 7,445
  caption 7,"GOSUB"
  border_small 7

  ' *************************************
  ' List pour les gosub
  command_target_is 7
    list 8
    top 8,0
    left 8,0
    width 8,133
    height 8,410
    parent 8,7
    color  8,240,240,240
    show 8
    item_add 8,"gosub0"
    item_add 8,"gosub1"
    item_add 8,"gosub2"
    item_add 8,"gosub3"
    item_add 8,"gosub4"
 ' ************************************
 ' Form 9 pour receptacle des #include
  form 9
  top 9,25
  left 9,440
  width 9,153
  height 9,445
  caption 9,"#Include"
  border_small 9

  ' *************************************
  ' List pour les #include
  command_target_is 9
    list 10
    top 10,0
    left 10,0
    width 10,133
    height 10,410
    parent 10,9
    color  10,240,240,240
    show 10
    item_add 10,"#include0"
    item_add 10,"#include1"
    item_add 10,"#include2"
    item_add 10,"#include3"
    item_add 10,"#include4"

    ' ************************************
 ' Form 11 pour receptacle les Erreurs
  form 11
  top 11,25
  left 11,440
  width 11,153
  height 11,445
  caption 11,"Erreurs"
  border_small 11

  ' *************************************
  ' List 12 pour les Erreurs
  command_target_is 11
    list 12
    top 12,0
    left 12,0
    width 12,133
    height 12,410
    parent 12,11
    color  12,240,240,240
    show 12
    item_add 12,"Erreurs0"
    item_add 12,"Erreurs1"
    item_add 12,"Erreurs2"
    item_add 12,"Erreurs3"
    item_add 12,"Erreurs4"

 ' ****************************************
 ' Memo 17 pour afficher le programme
  command_target_is 0
  Memo 17
  top 17,0
  left 17,0
  width 17 ,600
  height 17,400
  font_name 17,"Consolas"
  font_size 17,14

 

  ' Initialisation des variables pour numérotation progamme
 dim a$ ,b% ,f$ ,c%  ,d$,E$ ,flgins$,flag_instr%
 b%=0
 flgins$="#include"
 flag_instr%=0
 label include

  ' Ouvrir la boite de dialogue
        open_dialog  13

  ' Choisir le fichier a traiter
        a$=file_name$(13)

  ' récupérer le nombre de caratères du nom de fichier
        c% = len(a$)

  ' récuperer le nom du fichier sans l'extension
      d$= left$(a$,C%-3)

  ' ajouter l'extension txt"
      d$= d$+"txt"

  ' Ouvrir le fichier en lecture a traiter
      file_open_read 14, a$

  ' ouvrir le fichier d'écriture
      file_open_write 15,d$

  ' test si pas fin de fichier
      while file_eof(14) <>1

  ' Lecture d'un ligne de fichier
      file_readln 14,f$

  ' On retire les blancs de devant et de derriere
          f$=trim$(f$)
         
      ' Incrémentation du compteur de ligne
          b%=b%+1

    ' changement de la variable numerique en string
          e$=str$(b%)

    ' ajout d'un blanc entre le numero de ligne et les instructions
          e$ = e$+" "+f$

    ' ecrire la ligne dans le fichier
            file_writeln 15,lower$(e$)
           
      ' on ecrit la ligne dans le memo
          item_add 17,e$
         
      ' Tester si la chaine #include existe dans la ligne
        flag_instr%=instr(f$,flgins$)

    ' Test si le drapeau flag_instr$ différent de zero
        if flag_instr%>0

    ' Test si le premier caractère est bien un #
    ' si oui c'est bien un include on va au sous-prog include
        if "#"= left$(f$,1) then gosub include
        end_if


    ' fin de la boucle
        end_while
     
      ' Fermeture des fichiers
      file_close 14
      file_close 15
     
    ' **********************************************************************
    ' Ceci est un test  pour voir si cela est faisable
    '  on enregistre toutes les déclarations des variables dans un tableau
    '  on a deja mis en minuscule tous les caractères dans le fichier *.txt
    '  On vas appelé le sous programme Variables
    label Recherche
    ' récupéation du mot a chercher
   
    ' Initialisation du compteur du memo
    compteur%=count(17)
    item_add 2,str$(compteur%)
    gosub Recherche


    ' **********************************************************************
   
  on_click 2,list1
  on_click 4,list2
  on_click 6,list3
  on_click 8,list4
  on_click 10,list5
  on_click 12,list6
  end

list1:
          dumy%=item_index(2)
            dummy$=item_read$(2,dumy%)
            print dummy$

return

list2:

            dumy%=item_index(4)
              dummy$=item_read$(4,dumy%)
                print dummy$
 return

 list3:

            dumy%=item_index(6)
              dummy$=item_read$(6,dumy%)
                print dummy$
  return

list4:

            dumy%=item_index(8)
              dummy$=item_read$(8,dumy%)
                print dummy$

  return

  list5:

            dumy%=item_index(10)
              dummy$=item_read$(10,dumy%)
                print dummy$
  return

  list6:

            dumy%=item_index(12)
              dummy$=item_read$(12,dumy%)
                print dummy$
  return

    terminate

include:

    ' longueur de la chaîne
    c%=len(f$)

      ' On convertit la caractère  "
      a$=chr$(34)

      ' position ou se trouve le premier ..."...
      I%=instr(f$,a$)


    ' on rajoute pour avoir le compte correct
          c%=(C%-I%)+2

      ' On a le nom du fichier Include
      f$= right$(f$,c%)

        f$=ltrim$(f$)

      file_open_read 16,f$
        ' test si pas fin de fichier
    while file_eof(16) <>1

    ' Incrémentation de la boucle
        b%=b%+1
       
        ' changement de la variable numerique en string
          e$=str$(b%)

       
      ' Lecture d'un ligne de fichier
    file_readln 16,f$
    ' ajout d'un blanc
          e$ = e$+" "+f$
          ' ecrire la ligne dans le fichier
            file_writeln 15,lower$(e$)

        item_add 17,e$
          end_while
          file_close 16
  flag_instr%=0
    return
   

Recherche:

' Recherche mot dans le memo
dim mot$,ligne$,ins_tr%
  ' On convertit la caractère  "
      a$=chr$(34)

 ' On recupère le mot du dictonnaire
      I%=0
      mot$=Tbl_Dictionnaire$(I%)
     
  for i%=1 to compteur% step 1
    ligne$=item_read$(17,i%)

    ' Est-ce que le mot existe dans la ligne
        ins_tr%=instr(ligne$,Mot$)
          set_focus 2
      If ins_tr%>0
          ins_tr%=instr(ligne$,"'")
              if ins_tr%=0
                    ins_tr%=instr(ligne$,"rem")
                   
                      if ins_tr%=0
                          ins_tr%=instr(ligne$,":")
                            if ins_tr%=0
                            ins_tr%=instr(ligne$,a$)
                            if ins_tr%=0
                              item_add 2,ligne$
                              end_if
                            end_if
                        end_if
              end_if
        end_if
      next i%

      return

DIM a$, b$, toto%(20), txt$(10, 100), x, y....

list 1  :width 1,width(0)-30:height 1,200
' ---
rem "list 2 est le programme à mettre en fin"
memo 2  : top 2,210:width 2,width(0)-30:height 2,200:font_size 2,14:color 2,239,243,189:bar_both 2
file_load 1,"C:\TESTE\M_au _P_TRACE\Ajout_fin.txt"
for a%=1 to count(1)
  a$=item_read$(1,a%)
  if left$(upper$(trim$(a$)),8)="#INCLUDE"
      v%=instr(upper$(a$),"#INCLUDE ")
      item_add 2,"' dépilé: "+trim$(a$)
      b$=mid$(a$,v%+9,50)
      file_add 2,b$
  else
      item_add 2,a$
  end_if
next a%

DIM f$, a$, b$, c$, a1$, i%, k%, k1%, k2%, nl%, nvar%, neti%, nobj%, ign%
DIM var$(200), eti$(100), obj$(100)
LABEL ra, rb, rc, rd, Suit1, Suit2, Tri, Misfo

f$ = "C:\LANGAGES\Panoramic\Etiquette.bas": ' ***** SOURCE A ANALYSER *****

nvar% = 0: neti% = 0: nobj% = 0
' ***** VARIABLES DÉCLARÉES (DIM)
FILE_OPEN_READ 1, f$: nl% = 0
WHILE FILE_EOF(1) = 0
    nl% = nl% + 1: FILE_READLN 1, a$: GOSUB Misfo: IF ign% = 1 THEN GOTO Suit1
    k% = INSTR(a$, "DIM ")
    IF k% > 0
        a$ = MID$(a$, k%+4, LEN(a$)-k%-3)
ra:
        k% = INSTR(a$, ":"): a1$ = ""
        IF k% > 0 THEN a1$ = MID$(a$, k%+1, LEN(a$)-k%): a$ = LEFT$(a$, k%-1)
        k% = INSTR(a$, "(")
        IF k% > 0
            b$ = MID$(a$, k%+1, LEN(a$)-k%)
            k2% = INSTR(b$, ")")
            IF k2% > 0
                k1% = INSTR(b$, ",")
                IF k1% > 0 AND k1% < k2%
                    k1% = k% + k1%: k2% = k% + k2%
                    a$ = LEFT$(a$, k%-1)+"["+MID$(a$, k%+1, LEN(a$)-k%)
                    a$ = LEFT$(a$, k1%-1)+"."+MID$(a$, k1%+1, LEN(a$)-k1%)
                    IF k2% < LEN(a$)
                        a$ = LEFT$(a$, k2%-1)+"]"+MID$(a$, k2%+1, LEN(a$)-k2%)
                    ELSE
                        a$ = LEFT$(a$, k2%-1) + "]"
                    END_IF
                END_IF
            END_IF
        END_IF
rb:
        k% = INSTR(a$, ",")
        nvar% = nvar% + 1: b$ = STR$(nl%): b$ = STRING$(5-LEN(b$)," ") + b$
        IF k% > 0
            var$(nvar%) = TRIM$(LEFT$(a$, k%-1)) + b$
            a$ = MID$(a$, k%+1, LEN(a$)-k%): GOTO rb
        END_IF
        var$(nvar%) = TRIM$(a$) + b$
        IF a1$ <> "" THEN a$ = a1$: GOTO ra
    END_IF
Suit1:
END_WHILE
FILE_CLOSE 1
' *****  ÉTIQUETTES DÉCLARÉES (LABEL)
FILE_OPEN_READ 1, f$: nl% = 0
WHILE FILE_EOF(1) = 0
    nl% = nl% + 1: FILE_READLN 1, a$: GOSUB Misfo: IF ign% = 1 THEN GOTO Suit2
    k% = INSTR(a$, "LABEL ")
    IF k% > 0
        a$ = MID$(a$, k%+6, LEN(a$)-k%-5)
rc:
        k% = INSTR(a$, ":"): a1$ = ""
        IF k% > 0 THEN a1$ = MID$(a$, k%+1, LEN(a$)-k%): a$ = LEFT$(a$, k%-1)
rd:
        k% = INSTR(a$, ",")
        neti% = neti% + 1: b$ = STR$(nl%): b$ = STRING$(5-LEN(b$)," ") + b$
        IF k% > 0
            eti$(neti%) = TRIM$(LEFT$(a$, k%-1)) + b$
            a$ = MID$(a$, k%+1, LEN(a$)-k%): GOTO rd
        END_IF
        eti$(neti%) = TRIM$(a$) + b$
        IF a1$ <> "" THEN a$ = a1$: GOTO rc
    END_IF
Suit2:
END_WHILE
FILE_CLOSE 1
' remise en forme des déclarations de tableaux à double entrée
FOR i% = 1 TO nvar%
    a$ = var$(i%)
    k% = INSTR(a$, "[")
    IF k% > 0
        a$ = LEFT$(a$, k%-1) + "(" + MID$(a$, k%+1, LEN(a$)-k%)
        k% = INSTR(a$, "]")
        IF k% > 0
            a$ = LEFT$(a$, k%-1) + ")" + MID$(a$, k%+1, LEN(a$)-k%)
            k% = INSTR(a$, ".")
            IF k% > 0
                a$ = LEFT$(a$, k%-1) + "," + MID$(a$, k%+1, LEN(a$)-k%)
            END_IF
        END_IF
        b$ = LEFT$(a$, LEN(a$)-5)
        FOR k% = 1 TO LEN(b$): ' suppression éventuelle des espaces superflus
            IF MID$(a$, k%, 1)=" " THEN b$=LEFT$(b$, k%-1) + MID$(b$,k%+1,LEN(b$)-k%)
        NEXT k%
        var$(i%) = b$ + RIGHT$(a$, 5)
    END_IF
NEXT i%
GOSUB Tri: ' tri alpha des résultats
HEIGHT 0, SCREEN_Y
PRINT f$ + " Total= " + STR$(nvar%) + " variables, " + STR$(neti%) + " étiquettes."
FOR i% = 1 TO nvar%
    PRINT LEFT$(var$(i%), LEN(var$(i%))-5) + " [" + TRIM$(RIGHT$(var$(i%),5)) + "]"
NEXT i%
PRINT " - ÉTIQUETTES -"
FOR i% = 1 TO neti%
    PRINT LEFT$(eti$(i%), LEN(eti$(i%))-5) + " [" + TRIM$(RIGHT$(eti$(i%),5)) + "]"
NEXT i%
END

Tri:
DLIST 99
FOR i% = 1 TO nvar%: ITEM_ADD 99, var$(i%): NEXT i%
SORT 99
FOR i% = 1 TO nvar%: var$(i%) = ITEM_READ$(99, i%): NEXT i%
CLEAR 99
FOR i% = 1 TO neti%: ITEM_ADD 99, eti$(i%): NEXT i%
SORT 99
FOR i% = 1 TO neti%: eti$(i%) = ITEM_READ$(99, i%): NEXT i%
DELETE 99
RETURN

Misfo:
' Mise en forme de a$ avant analyse (élimination des éléments superflus)
ign% = 0
a$ = TRIM$(a$): IF a$ = "" THEN ign% = 1: RETURN
k% = INSTR(a$, "' "): IF k% = 1 THEN ign% = 1: RETURN
IF k% > 0 THEN a$ = RTRIM$(LEFT$(a$, k%-1))
IF RIGHT$(a$, 1) = ":" THEN a$ = LEFT$(a$, LEN(a$) - 1)
' Éliminer le contenu entre quotes (merci Nardo)
k% = INSTR(a$, CHR$(34))
IF k% > 0
    b$ = MID$(a$, k%+1, LEN(a$)-k%)
    k1% = INSTR(b$, CHR$(34))
    IF k1% > 0
        a$ = LEFT$(a$, k%) + MID$(b$, k1%, LEN(b$)-k1%+1)
    END_IF
END_IF
RETURN

dim glis%,n_picture%,a%,a$,b%,b$ ,f$
f$="C:\TESTE\voir.bas"

label recherche_label,recherche_dim,charger,clic_aucun,clic_label,clic_dim

full_space 0:height 0,screen_y -40
               
dlist      45 : ' normalement mémoire
dlist      46 : ' est la liste où le programme est en création /load /save /modifie...
list        47 :left 47,width(0)-215:top 47,55:width 47,160:height 47,height(0)-150:font_size 47,12
list      100 :hide 100:left 100,width(0)-215:width 100,160:top 100,55:font_size 100,12 :height 100,height(0)-150

container_option 97 :left 97,width(0)-215:top 97,0:height 97,50:width 97,170
option      96:parent 96,97:left 96,5  :top 96,10:caption 96,"Aucun"
option      94:parent 94,97:left 94,105:top 94,10:caption 94,"Label"
option      93:parent 93,97:left 93,105:top 93,30:caption 93,"Dim"

  gosub charger
  on_click 96,clic_aucun
  on_click 94,clic_label
  on_click 93,clic_dim
end
' ==============================================================================
charger:
  clear 46
  file_load 46,f$
  glis%=0 :n_picture%=count(46)
  gosub recherche_label
  gosub recherche_dim
' ==============================================================================
recherche_label:
  ' recherche des labels
  for a%=1 to count(46)
      a$=item_read$(46,a%)
      if right$( trim$(a$),1)=":"
        if instr(trim$(a$)," ") =0 then item_add 47,a$
      end_if
  next a%
return
' ==============================================================================
recherche_dim:
  ' recherche des DIM
  for a%=1 to count(46)
      a$=trim$(item_read$(46,a%))
      if upper$(left$(trim$(a$),4))="DIM "
        a$=trim$(right$(a$,len(a$)-4))
        b%=instr(a$,":")
        if b%>0 then a$=trim$(left$(a$,b%-1))
        b$=a$
        repeat
            b%=instr(a$,",")
              if b%>0
                  b$=trim$(left$(a$,b%-1))
                  item_add 100,b$
                  a$=trim$(right$(a$,len(a$)-b%))
              else
                  b$=a$
              end_if
        until b%=0
      end_if
  next a%
  sort 100
return
' ==============================================================================
clic_aucun:
  hide 47:hide 100
return
' ==============================================================================
clic_label:
  hide 100
  show 47
return
' ==============================================================================
list_label:
  ch$= item_index$(47)
  hide 47
  mark_on 96
return
' ==============================================================================
clic_dim:
  hide 47
  show 100
return