' Panoramic (Commentaire obligatoire pour exécution par chain...) DIM VERBOSE:VERBOSE=0 DIM USER_PATH$,USER_FILE$ : ' essai de commentaire DIM BORDER_SIZE%,TITLE_SIZE%,w%,h% picture 1:full_space 1:TITLE_SIZE%=height(0)-height(1):BORDER_SIZE% = width(0)-width(1): delete 1 LABEL ProgClose: on_close 0,ProgClose LABEL ProgError: on_error_goto ProgError ' dll_on "G:\SITE_FTP\Panoramic\Compteur\DateFile.dll" dll_on "DateFile.dll" REM ceci est un essai WIDTH 0,750 : REM ceci est un 2eme essai if VERBOSE=1 DIM Debug%,mDebug% : Debug%=1: mDebug%=2 FORM Debug%: MEMO mDebug% : parent mDebug%,Debug% LEFT Debug%,width(0):width Debug%,400 WIDTH mDebug%,width(Debug%)-BORDER_SIZE%:height mDebug%,height(Debug%)-TITLE_SIZE%:bar_both mDebug% DIM DebugSrc%,mDebugSrc%:DebugSrc%=3:mDebugSrc%=4 FORM DebugSrc%: MEMO mDebugSrc% : parent mDebugSrc%,DebugSrc% WIDTH mDebugSrc%,width(DebugSrc%)-BORDER_SIZE%:height mDebugSrc%,height(DebugSrc%)-TITLE_SIZE%:bar_both mDebugSrc% END_IF ' **************************************************************************** ' I.H.M ' **************************************************************************** DIM lstObject%: lstObject% = number_objects+1: LIST lstObject% DIM bLoadFile%: bLoadFile% = number_objects+1: button bLoadFile% DIM bObjet% : bObjet% = number_objects+1: button bObjet% : inactive bObjet% DIM bVariable%: bVariable% = number_objects+1: button bVariable% : inactive bVariable% DIM bLabel% : bLabel% = number_objects+1: button bLabel% : inactive bLabel% DIM ProgBar%: ProgBar% = number_objects+1: progress_bar ProgBar% : hide ProgBar% DIM tmpResultVar%: tmpResultVar% = number_objects+1: DLIST tmpResultVar% WIDTH lstObject%,WIDTH(0)-BORDER_SIZE% HEIGHT lstObject%,HEIGHT(0)-TITLE_SIZE%-TOP(lstObject%)-height(bObjet%)-BORDER_SIZE%-1 LEFT bLoadFile%,5 : TOP bLoadFile%,TOP(lstObject%)+HEIGHT(lstObject%) : caption bLoadFile%,"Load" LEFT bObjet%,left(bLoadFile%)+width(bLoadFile%)+5 :TOP bObjet%,top(bLoadFile%) : caption bObjet%,"Objets" LEFT bVariable%,left(bObjet%)+width(bObjet%)+5 :TOP bVariable%,top(bLoadFile%) : caption bVariable%,"Variables":hint bVariable%,"pas encore implémenté" LEFT bLabel%,left(bVariable%)+width(bVariable%)+5 :TOP bLabel%,top(bLoadFile%) : caption bLabel%,"Label" LEFT ProgBar%,WIDTH(0)/4:WIDTH ProgBar%,WIDTH(0)/2 TOP ProgBar%,(HEIGHt(0)/2)-TITLE_SIZE% DIM dFichierInitial%: dFichierInitial% = number_objects+1: Dlist dFichierInitial% DIM dFichierTmp% DIM tRedraw%: tRedraw% = number_objects+1: timeR tRedraw% DIM tFileScan%: tFileScan% = number_objects+1: TIMER tFileScan% TIMER_OFF tRedraw% : timer_interval tRedraw%,100 TIMER_OFF tFileScan% : timer_interval tFileScan%,2000 ' **************************************************************************** ' Variables communes ' **************************************************************************** ' ------------- Objets ----------------+--- Labels ----------+-------- Variable -------- ' 0: Type | | ' 1: Valeur | nom etiquette | nom variable ' 2: Variable identifiant | | nombre de fois utilisée ' 3: ligne_déclaration de l'objet | Ligne label | ligne de déclaration ' 4: ligne de définition de (2) | ligne etiquette | lignes ou variable utilisée ' 5: evenenement(s) associé(s) | DIM nbInfo% : nbInfo%=6 DIM Objet$(400,6),MaxStr(6) : ' que c'est râlant de ne pas pouvoir écrire : DIM Objet$(200,nbInfo%), MaxStr(nbInfo%) !! LABEL LoadFile, FileScan, FileScan_end, Redraw LABEL Scan, AfficheResultat ' recherche du nom d'un sous-programme LABEL SrchLabel DIM SrchKeyword$,SrchLine$,SrchOption% ' recherche d'une liste de caracteres dans une chaine LABEL NotInStr : DIM NotInStr%,NotInStr$,NotInStr1$,NotInStr_i% LABEL Decompose DIM lstNbMots%:lstNbMots%=number_objects+1:DLIST lstNbMots% DIM Decompose_i%,Decompose_j%,word$ DIM ResDecomp$:ResDecomp$="ResDecomp$" ' Mise en forme du résultat : LABEL FormatResult: DIM FormatResult_i%,FormatResult% ' doit être ABSOLUMENT different sinon les variables de dates pointent sur la même chaine de caractère... DIM DateFile$,OldDateFile$,retourDLL% DateFile$ = string$(25," ") : OldDateFile$ = "kjlkj" DIM FileScan_i%,FileScan_j% DIM Mode% : Mode%=0 : ' mode de recherche 0:variable 1:Label DIM tmpObject%,fichier$,i%,j%,k%,l%,ligne$,old_ligne$,a$,b$,c$ DIM ligne% DIM ProgPos%:ProgPos%=0 DIM nbCarLigne% ' **************************************************************************** ' Variables pour recherche d'objets ' **************************************************************************** LABEL ChercheObjet,ChercheObjet1,ControlNumerotation,ControlNumerotation1 DIM NomObjet$(30),nbObjets%,nbObjetsTrouves% DIM motCle% DIM SensRecherche%,start_line%,end_line% : SensRecherche%=-1 ' **************************************************************************** ' Variables pour recherche des etiquettes ' **************************************************************************** LABEL ChercheLabel ' **************************************************************************** ' Variables pour recherche des variables ' **************************************************************************** LABEL ChercheVariable ' **************************************************************************** ' ZONE DE TEST !!! ' **************************************************************************** dim button1 DIM Transform,piege_EDIT Transform = 2 piege_EDIT=789 EDIT 456:LIST piege_EDIT:hide 456:hide 789 j%=number_objects+1 for i%=j% to j%+5 edit i%:hide i% next i% dim essai : label essai essai=2 : gosub essai EDIT 4578:HIDE 4578 DIM Apero%:essai=2:Apero%=874 if Apero%<>i% then Apero%=Apero%+1 DLIST Apero%:DELETE Apero% for i%=874 to 876 DLIST i% : DELETE i% next i% DLIST Apero%+45 LABEL Test1: Gosub Test1 Edit Test1_Obj:delete Test1_Obj ' **************************************************************************** ' FIN DU TEST ' **************************************************************************** FONT_NAME lstObject%,"Courier New" FONT_SIZE lstObject%,10 ' calcul de la largeur d'un caractère nbCarLigne%= (width(lstObject%)-20)/(int(10/1.25)) ' nbCarLigne%= (width(lstObject%)-20)/(int(10/1.3)) for nbObjets%=0 to 30 read NomObjet$(nbObjets%) if NomObjet$(nbObjets%)="####" then nbObjets%=nbObjets%-1:exit_for next nbObjets% on_click bObjet%,Scan on_click bLabel%,Scan on_click bVariable%,Scan on_click bLoadFile%,LoadFile on_timer tRedraw%,Redraw : timer_on tRedraw% on_timer tFileScan%,FileScan END ' **************************************************************************** ' ZONE DE TEST !!! ' **************************************************************************** EtiquetteAvantLabel: print "coucou" return essai: print essai label EtiquetteAvantLabel return Test1: DIM Test1_Obj:Test1_Obj=number_objects+1 return ' **************************************************************************** ' FIN DU TEST ' **************************************************************************** LoadFile: tmpObject%=number_objects+1 OPEN_DIALOG tmpObject% FILTER tmpObject%,"fichier panoramic|*.bas" fichier$=FILE_NAME$(tmpObject%) if fichier$<>"_" TIMER_OFF tFileScan% ' on raz tout : clear dFichierInitial% FILE_LOAD dFichierInitial%,fichier$ : ' puis on charge le nouveau source retourDLL% = dll_call3("DateFichier",adr(fichier$),adr(DateFile$),len(DateFile$)) OldDateFile$ = "PANO:" + DateFile$ caption 0,fichier$+" nb ligne:"+str$(count(dFichierInitial%)) active bObjet%: active bLabel%: active bVariable% ' recherche du chemin d'accès du fichier k%=len(fichier$) while mid$(fichier$,k%,1)<>"\": k%=k%-1:end_while USER_PATH$ = LEFT$(fichier$,k%) USER_FILE$ = RIGHT$(fichier$,len(fichier$)-k%) Gosub Scan TIMER_ON tFileScan% else TIMER_OFF tFileScan% inactive bObjet%: inactive bLabel%: inactive bVariable% end_if DELETE tmpObject% return ' --------------------------------------------------------------------------------------------- ' on test si la date a changé ' --------------------------------------------------------------------------------------------- FileScan: TIMER_OFF tFileScan% retourDLL% = dll_call3("DateFichier",adr(USER_FILE$),adr(DateFile$),len(DateFile$)) if DateFile$<>RIGHT$(OldDateFile$,len(OldDateFile$)-5) dFichierTmp% = number_objects+1 : Dlist dFichierTmp% on_error_goto FileScan_end FILE_LOAD dFichierTmp%,fichier$ OldDateFile$="PANO:"+DateFile$ clear dFichierInitial%:clear lstObject% for FileScan_i%=1 to count(dFichierTmp%) item_add dFichierInitial%,item_read$(dFichierTmp%,FileScan_i%) next FileScan_i% delete dFichierTmp% on_error_goto ProgError Gosub Scan FileScan_end: off_error_goto on_error_goto ProgError end_if TIMER_ON tFileScan% return ' --------------------------------------------------------------------------------------------- ' Preparation de la ligne de code avant traitement ' --------------------------------------------------------------------------------------------- Scan: if (number_click = bObjet%)then Mode% =0 if (number_click = bLabel%) then Mode%=1 if (number_click = bVariable%) then Mode%=2 show ProgBar% clear lstObject% nbObjetsTrouves%=0 if VERBOSE = 1 clear mDebug% clear mDebugSrc% end_if for FileScan_i%=0 to nbInfo%-1 MaxStr(FileScan_i%)=0 for FileScan_j%=0 to 199 ' Objet$(FileScan_j%,FileScan_i%)="" if FileScan_i%=2 and Mode%=2 Objet$(FileScan_j%,FileScan_i%)="0" else Objet$(FileScan_j%,FileScan_i%)="" end_if next FileSCan_j% next FileScan_i% ' ------------------------------------- ' Parcours des lignes du fichier source ' ------------------------------------- for ligne%=1 to count(dFichierInitial%) wait 2 ProgPos%=(ligne%/count(dFichierInitial%))*100 position ProgBar%,ProgPos% ligne$="" ligne$=TRIM$(item_read$(dFichierInitial%,ligne%)) if VERBOSE = 1 then item_add mDebug%,"start scan:"+ligne$ old_ligne$=ligne$ ' maintenant on vire toutes les chaines de caractères ainsi que les commentaires if instr(ligne$,chr$(34))<> 0 or instr(ligne$,chr$(39))<> 0 k%=0:a$="" for j%=1 to len(ligne$) ' si on arrive à un commentaire, on a fini de parcourir la ligne (ce qui suit est ignoré) if mid$(ligne$,j%,1)=chr$(39) and k%=0 a$=TRIM$(a$) if right$(a$,1)=":" then a$=left$(a$,len(a$)-1) exit_for end_if ' k% -> bascule qui permet de ne pas récupérer ce qu'il y a entre les guillemets. if mid$(ligne$,j%,1)=chr$(34) a$=a$+mid$(ligne$,j%,1) k%=bin_xor(k%,1) else ' on mémorise le caractère si pas dans une chaine de caractère if k%=0 then a$=a$+mid$(ligne$,j%,1) end_if next j% ' on affecte la nouvelle ligne (expurgée de ses 'string' et autres comments ligne$=a$ old_ligne$=a$ end_if if VERBOSE = 1 then item_add mDebug%,"End scan:"+ligne$ ligne$=TRIM$(ligne$) k%=INSTR(UPPER$(ligne$),"REM ") if k%<> 0 if k%=1 ligne$="" else ligne$=TRIM$(left$(ligne$,k%-1)) if right$(ligne$,1)=":" then ligne$=TRIM$(left$(ligne$,len(ligne$)-1)) end_if end_if old_ligne$=ligne$ if ligne$<>"" if VERBOSE = 1 then item_add mDebugSrc%,str$(ligne%)+"->"+ligne$ ' on lance la recherche objet/Etiquette if (number_click = bObjet%)or (Mode%=0) then gosub ChercheObjet if (number_click = bLabel%) or (Mode%=1) then gosub ChercheLabel if (number_click = bVariable%) or (Mode%=2) then gosub Decompose: gosub ChercheVariable end_if next ligne% HIDE ProgBar% gosub AfficheResultat item_add lstObject%," Fini !" return ' --------------------------------------------------------------------------------------------- ' Recherche d'objets ' --------------------------------------------------------------------------------------------- ' variables réservées : ' a$ : ligne hors commentaire et chaine de caracteres ' ligne%: numéro de la ligne en cours de traitement ' --------------------------------------------------------------------------------------------- ChercheObjet: Mode%=0 ' on vérifie si déclaration d'objets... for motCle%=0 to nbObjets% ChercheObjet1: k%=INSTR(UPPER$(ligne$),NomObjet$(motCle%)) : ' on teste la ligne en majuscule if k%>1 ' cas particulier pour ON_TIMER et autres joyeusetés if mid$(ligne$,k%-1,1)<>" " and mid$(ligne$,k%-1,1)<>":" then k%=0 end_if ' on a trouvé une déclaration d'objet : if k%<>0 nbObjetsTrouves%=nbObjetsTrouves%+1 ' on va chercher ce qui se trouve à droite du mot clé (normalement le numéro ou la variable) a$="":k%=k%+len(NomObjet$(motCle%)) while mid$(ligne$,k%,1)<>":" a$=a$+mid$(ligne$,k%,1) : k%=k%+1 if k%> len(ligne$) then exit_while end_while a$=TRIM$(a$) : ' on vire les espaces à droite et à gauche qui ne nous servent à rien ' si ce n'est pas une donnée numérique, nous avons donc un nom de variable ou une expression numerique IF numeric(a$)<>1 and ((instr(a$,"+")+instr(a$,"-")+instr(a$,"*")) = 0) ' si c'est une variable on cherche l'affectation de cette variable gosub ControlNumerotation ELSE : ' donnée numérique ou expression Objet$(nbObjetsTrouves%,1)=TRIM$(a$) : if len(Objet$(nbObjetsTrouves%,1)) > MaxStr(1) then MaxStr(1)=len(Objet$(nbObjetsTrouves%,1)) end_if Objet$(nbObjetsTrouves%,0)= NomObjet$(motCle%) Objet$(nbObjetsTrouves%,3)= TRIM$(str$(ligne%)) FormatResult% = nbObjetsTrouves%: gosub FormatResult ' on relance pour voir si il n'y a pas un autre objet sur la ligne k%=INSTR(UPPER$(ligne$),NomObjet$(motCle%))+len(NomObjet$(motCle%)) if k%<>len(ligne$) ligne$=mid$(ligne$,k%,len(ligne$)-k%) : ' on vire l'objet déjà traité goto ChercheObjet1 : ' puis on relance le traitement pour le même mot-clé end_if end_if ligne$=old_ligne$ next motCle% return ' --------------------------------------------------------------------------------------------- ' recherche de l'affectation (simple) d'une variable ' --------------------------------------------------------------------------------------------- ControlNumerotation: c$="":SensRecherche%=-1 start_line%=ligne%:end_line%=1 ' on fait une lecture depuis la ligne courante jusqu'au début du programme ' (recherche de l'affectation la plus récente) ControlNumerotation1: for i%=start_line% to end_line% step SensRecherche% b$=TRIM$(item_read$(dFichierInitial%,i%)): ' supression des espaces inutiles j%=instr(b$,a$) : ' on regarde si la variable a$ se trouve dans la ligne b$ repeat if j%<>0 j%=j%+len(a$) : ' on pointe après le mot cle while mid$(b$,j%,1)=" ":j%=j%+1:end_while : ' on "saute" les espaces éventuels après le nom de la variable ' puis on controle si c'est une affectation if mid$(b$,j%,1)="=" j%=j%+1:c$="" ' on mémorise dans c$ la valeur située après le signe '=' while (mid$(b$,j%,1)<>":") and (j%<=LEN(b$)): c$=c$+mid$(b$,j%,1):j%=j%+1:end_while exit_for else ' cas particulier : b$="DIM variable% : variable%=25" ' on cherche l'instruction suivante qui se trouve sur la même ligne b$=right$(b$,len(b$)-j%+1) : ' on tronçonne b$ -> b$="variable%=25" j%=instr(b$,a$) end_if end_if until j%=0 next i% if i%=0 SensRecherche%=1: start_line%=1:end_line%=count(dFichierInitial%) goto ControlNumerotation1 end_if c$=TRIM$(c$) Objet$(nbObjetsTrouves%,1)=c$ Objet$(nbObjetsTrouves%,2)=a$ Objet$(nbObjetsTrouves%,4)=str$(i%) FormatResult% = nbObjetsTrouves%: gosub FormatResult return ' --------------------------------------------------------------------------------------------- ' Recherche d'étiquette ' --------------------------------------------------------------------------------------------- ' variables réservées : ' a$ : ligne hors commentaire et chaine de caracteres ' ligne%: numéro de la ligne en cours de traitement ' --------------------------------------------------------------------------------------------- ChercheLabel: Mode%=1 ligne$=trim$(ligne$) ' ------------------------------------------ ' Detection de la ligne du sous-programme ' ------------------------------------------ NotInStr$=ligne$:NotInStr1$=" =$%":gosub NotInStr: ' recherche si caractères illégaux if NotInStr%=0 and right$(ligne$,1)=":" ' c'est une etiquette, on vérifie si on connait la déclaration if nbObjetsTrouves%<>0 for i%=1 to nbObjetsTrouves% if Objet$(i%,1)=left$(ligne$,len(ligne$)-1) then exit_for next i% ' si on l'a trouvé : if Objet$(i%,1)= left$(ligne$,len(ligne$)-1) Objet$(i%,4)=str$(ligne%) : ' on mémorise l'emplacement de l'étiquette FormatResult% = i%: gosub FormatResult if VERBOSE = 1 then item_add mDebug%,"Etiquette deja déclarée trouvé:<"+Objet$(i%,1)+">" ' sinon c'est une nouvelle étiquette else ' j'ai bien envi d'un petit goto sur le else d'en-dessous.... ' mais cela rajoute une étiquette... ;) nbObjetsTrouves%=nbObjetsTrouves%+1 Objet$(nbObjetsTrouves%,1)= left$(ligne$,len(ligne$)-1) : ' memorise le nom de l'étiquette Objet$(nbObjetsTrouves%,3)="#not_def#" : ' la déclaration du label n'est pas encore connue Objet$(nbObjetsTrouves%,4)=str$(ligne%) : ' on mémorise l'emplacement de l'étiquette FormatResult% = nbObjetsTrouves%: gosub FormatResult if VERBOSE = 1 then item_add mDebug%,"Nouvelle etiquette trouvée:<"+Objet$(nbObjetsTrouves%,1)+">" end_if ' c'est une nouvelle étiquette else nbObjetsTrouves%=nbObjetsTrouves%+1 Objet$(nbObjetsTrouves%,1)= left$(ligne$,len(ligne$)-1) : ' memorise le nom de l'étiquette Objet$(nbObjetsTrouves%,3)="#not_def#" : ' la déclaration du label n'est pas encore connue Objet$(nbObjetsTrouves%,4)=str$(ligne%) : ' on mémorise l'emplacement de l'étiquette FormatResult% = nbObjetsTrouves%: gosub FormatResult if VERBOSE = 1 then item_add mDebug%,"Nouvelle etiquette trouvée:<"+Objet$(nbObjetsTrouves%,1)+">" end_if else ' ---------------------------- ' Détection de la déclaration ' ---------------------------- k%=INSTR(UPPER$(ligne$),"LABEL ") : ' on teste la ligne en majuscule ' cas particulier : variable ou procedure contenant le mot 'Label' if k% > 1 if mid$(ligne$,k%-1,1)<>" " and mid$(ligne$,k%-1,1)<>":" then k%=0 end_if ' on a trouvé une déclaration d'étiquette : if k% <> 0 ' on va chercher ce qui se trouve à droite du mot clé (normalement le(s) nom(s) de(s) étiquette) a$="":k%=k%+6 while mid$(ligne$,k%,1)<>":" a$=a$+mid$(ligne$,k%,1) : k%=k%+1 : if k%> len(ligne$) then exit_while end_while a$=TRIM$(a$) : ' on vire les espaces à droite et à gauche qui ne nous servent à rien ' on vérifie si il n'y a pas plusieurs étiquettes repeat b$="":k%=1 while mid$(a$,k%,1)<>"," b$=b$+mid$(a$,k%,1): k%=k%+1 : if k% > len(a$) then exit_while end_while b$=TRIM$(b$) ' b$ contient un nom d'étiquette, on vérifie si cette étiquette n'est pas déjà connue if nbObjetsTrouves%<>0 for i%=1 to nbObjetsTrouves% if b$=Objet$(i%,1) then exit_for next i% ' si etiquette connue, on mémorise la ligne où elle est déclarée if b$=Objet$(i%,1) Objet$(i%,3)=str$(ligne%) FormatResult% = i%: gosub FormatResult if VERBOSE = 1 then item_add mDebug%,"LABEL trouvé (etiquette connue):"+Objet$(i%,1) ' c'est une nouvelle déclaration : else ' un petit goto ? non ?.... nein ! (je dois être maso) ;) nbObjetsTrouves%=nbObjetsTrouves%+1 Objet$(nbObjetsTrouves%,1)=b$ : ' memorise le nom de l'étiquette Objet$(nbObjetsTrouves%,3)=str$(ligne%) : ' memorise la ligne de déclaration du label FormatResult% = nbObjetsTrouves%: gosub FormatResult if VERBOSE = 1 then item_add mDebug%,"Nouveau LABEL :"+Objet$(nbObjetsTrouves%,1) end_if else nbObjetsTrouves% = nbObjetsTrouves% + 1 Objet$(nbObjetsTrouves%,1)=b$ : ' memorise le nom de l'étiquette Objet$(nbObjetsTrouves%,3)=str$(ligne%) : ' memorise la ligne de déclaration du label FormatResult% = nbObjetsTrouves%: gosub FormatResult end_if ' on passe à l'eventuelle étiquette suivante if k%=len(a$) k%=INSTR(UPPER$(ligne$),"LABEL ")+6 if k% < len(ligne$) ligne$=mid$(ligne$,k%+1,len(ligne$)-k%): ' on vire la commande LABEL déjà traité goto ChercheLabel : ' puis on relance le traitement pour de nouveau le mot 'LABEL' end_if else ' ---------------------------- ' recherche si il y a un appel à un sous-programme ' ---------------------------- SrchOption%=0 SrchKeyword$="GOTO ":SrchLine$=ligne$:gosub SrchLabel SrchKeyword$="GOSUB ":SrchLine$=ligne$:gosub SrchLabel SrchKeyword$="ON_ERROR_GOTO ":SrchLine$=ligne$:gosub SrchLabel SrchOption%=1 SrchKeyword$="ON_CLICK ":SrchLine$=ligne$:gosub SrchLabel SrchKeyword$="ON_TIMER ":SrchLine$=ligne$:gosub SrchLabel SrchKeyword$="ON_CLOSE ":SrchLine$=ligne$:gosub SrchLabel SrchKeyword$="ON_CHANGE ":SrchLine$=ligne$:gosub SrchLabel SrchKeyword$="ON_KEYDOWN ":SrchLine$=ligne$:gosub SrchLabel SrchKeyword$="ON_KEY_UP ":SrchLine$=ligne$:gosub SrchLabel end_if end_if return SrchLabel: k%=INSTR(UPPER$(SrchLine$),SrchKeyword$) ' cas particulier : variable ou procedure contenant le mot SrchKeyword$ if k%>1 if mid$(SrchLine$,k%-1,1)<>" " and mid$(SrchLine$,k%-1,1)<>":" then k%=0 end_if ' on a trouvé quelque chose if k%<> 0 ' on va chercher ce qui se trouve à droite du mot clé a$="":k%=k%+len(SrchKeyword$) if SrchOption%=1 while mid$(SrchLine$,k%-1,1)<>",": k%=k%+1:end_while end_if while mid$(SrchLine$,k%,1)<>":" a$=a$+mid$(SrchLine$,k%,1) : k%=k%+1: if k% > len(SrchLine$) then exit_while end_while a$=TRIM$(a$) SrchLine$=mid$(SrchLine$,k%,1000) ' on regarde si a$ est déjà connu if nbObjetsTrouves%<>0 for i%=1 to nbObjetsTrouves% if a$=Objet$(i%,1) then exit_for next i% else Objet$(1,1)=a$+"#not-def": i% = 1 end_if ' a$ est inconnue : if a$<>Objet$(i%,1) nbObjetsTrouves%=nbObjetsTrouves%+1 Objet$(nbObjetsTrouves%,1)=a$ Objet$(nbObjetsTrouves%,2)="" end_if Objet$(i%,2)=Objet$(i%,2)+str$(ligne%)+"," goto SrchLabel end_if return ' --------------------------------------------------------------------------------------------- ' Recherche de variable ' --------------------------------------------------------------------------------------------- ChercheVariable: Mode%=2 ligne$=trim$(ligne$) k%=INSTR(UPPER$(ligne$),"DIM ") : ' on teste la ligne en majuscule if k%>1 if mid$(ligne$,k%-1,1)<>" " and mid$(ligne$,k%-1,1)<>":" then k%=0 end_if ' on a trouvé une déclaration de variable(s) if k%<>0 ' on va chercher ce qui se trouve à droite du mot clé (normalement le(s) nom(s) de(s) variables) a$="":k%=k%+4 while mid$(ligne$,k%,1)<>":" a$=a$+mid$(ligne$,k%,1) : k%=k%+1 : if k%> len(ligne$) then exit_while end_while a$=TRIM$(a$) : ' on vire les espaces à droite et à gauche qui ne nous servent à rien ' on vérifie si il n'y a pas plusieurs étiquettes repeat ' on stocke dans b$ le nom de la variable b$="":k%=1 while mid$(a$,k%,1)<>"," b$=b$+mid$(a$,k%,1): k%=k%+1 : if k% > len(a$) then exit_while ' cas d'une déclaration d'un tableau de n dimension if mid$(a$,k%,1)="," NotInStr$=mid$(a$,k%+1,1):NotInStr1$="0123456789":gosub NotInStr if NotInStr%<>0 : ' c'est une valeur numerique b$=b$+mid$(a$,k%,1): k%=k%+1 : if k% > len(a$) then exit_while end_if end_if end_while b$=TRIM$(b$) if VERBOSE = 1 then item_add mDebug%," Found "+b$ nbObjetsTrouves%=nbObjetsTrouves%+1 Objet$(nbObjetsTrouves%,1)=b$ : ' memorise le nom de la variable Objet$(nbObjetsTrouves%,3)=str$(ligne%) : ' memorise la ligne de déclaration FormatResult% = nbObjetsTrouves%: gosub FormatResult ' on passe à l'eventuelle variable qui suit sur la même ligne... if k%=len(a$) k%=INSTR(UPPER$(ligne$),"DIM ")+4 if k% < len(ligne$) ligne$=mid$(ligne$,k%+1,len(ligne$)-k%): ' on vire la commande DIM déjà traitée k%=INSTR(ligne$,":") if k%<>0 ligne$=mid$(ligne$,k%+1,len(ligne$)-k%) end_if goto ChercheVariable : ' puis on relance le traitement pour de nouveau le mot 'DIM ' end_if end_if for i%=1 to nbObjetsTrouves% ' on regarde maintenant dans la liste des variables déclarées si on n'a pas de rajout à faire ' il y a une faille : si le DIM est déclaré APRES (cas d'un gosub) une ligne contenant le nom de la variable for j%=1 to count(lstNbMots%) word$=Objet$(i%,1) : k%=instr(word$,"(") if k%<>0 then word$=left$(word$,k%-1) if word$ = item_read$(lstNbMots%,j%) Objet$(i%,4)=Objet$(i%,4)+str$(ligne%)+"," k%=val(Objet$(i%,2)) k%=k%+1 Objet$(i%,2)=str$(k%) exit_for end_if next j% next i% return ' --------------------------------------------------------------------------------------------- ' Mise en forme du résultat : ' mémorisation du champs d'info le plus long ' --------------------------------------------------------------------------------------------- FormatResult: for FormatResult_i%= 0 to nbInfo%-1 if len(Objet$(FormatResult%,FormatResult_i%)) > MaxStr(FormatResult_i%) then MaxStr(FormatResult_i%)=len(Objet$(FormatResult%,FormatResult_i%)) next FormatResult_i% return ' --------------------------------------------------------------------------------------------- ' recherche si caractères présent dans une chaine ' paramètres : ' NotInStr$ : chaine de caractères à tester ' NotInStr1$ : liste des caractères à controler ' NotInStr% : valeur de retour <> 1 si des caractères sont présents ' --------------------------------------------------------------------------------------------- NotInStr: NotInStr%=0 for NotInStr_i%=1 to len(NotInStr1$) NotInStr% = NotInStr% + instr(NotInStr$,mid$(NotInStr1$,NotInStr_i%,1)) next NotInStr_i% return ' --------------------------------------------------------------------------------------------- ' paramètres : ' ligne$ ' --------------------------------------------------------------------------------------------- Decompose: if VERBOSE = 1 then item_add mDebug%,"Start Decomp "+str$(ligne%)+"->"+ligne$ clear lstNbMots% : word$="" Decompose_j%=1 NotInStr1$="(), +-/*:=<>" for Decompose_i%=1 to len(ligne$) NotInStr%=instr(NotInStr1$,mid$(ligne$,Decompose_i%,1)) if NotInStr%<> 0 : ' or Decompose_i%=len(ligne$) ' si le mot n'est pas numerique word$=trim$(word$) if numeric(word$) <> 1 ' est que ce n'est pas des caracteres speciaux if word$<>"" item_add lstNbMots%,word$ : word$="" end_if else word$="" end_if else word$=word$+mid$(ligne$,Decompose_i%,1) end_if next Decompose_i% if word$<>"" then item_add lstNbMots%,word$ if VERBOSE = 1 item_add mDebug%," nb mot:"+str$(count(lstNbMots%)) for Decompose_i%=1 to count(lstNbMots%) item_add mDebug%," "+item_read$(lstNbMots%,Decompose_i%) next Decompose_i% item_add mDebug%,"End Decomp." end_if return ' --------------------------------------------------------------------------------------------- ' Reaffichage des objets en fct de la taille du formulaire ' --------------------------------------------------------------------------------------------- Redraw: if w%<>width(0) or h%<>height(0) WIDTH lstObject%,WIDTH(0)-BORDER_SIZE% HEIGHT lstObject%,HEIGHT(0)-TITLE_SIZE%-TOP(lstObject%)-height(bObjet%) TOP bLoadFile%,TOP(lstObject%)+HEIGHT(lstObject%): LEFT bLoadFile%,5 LEFT bObjet%,left(bLoadFile%)+width(bLoadFile%)+5:TOP bObjet%,top(bLoadFile%) LEFT bVariable%,left(bObjet%)+width(bObjet%)+5:TOP bVariable%,top(bObjet%) LEFT bLabel%,left(bVariable%)+width(bVariable%)+5:TOP bLabel%,top(bObjet%) LEFT ProgBar%,WIDTH(0)/4:WIDTH ProgBar%,WIDTH(0)/2 TOP ProgBar%,(HEIGHt(0)/2)-TITLE_SIZE% ' calcul de la largeur d'un caractère nbCarLigne%= (width(lstObject%)-30)/(int(10/1.25)) ' nbCarLigne%= (width(lstObject%)-30)/(int(10/1.3)) gosub AfficheResultat if VERBOSE = 1 WIDTH mDebugSrc%,width(DebugSrc%)-BORDER_SIZE%:height mDebugSrc%,height(DebugSrc%)-TITLE_SIZE% WIDTH mDebug%,width(Debug%)-BORDER_SIZE%:height mDebug%,height(Debug%)-TITLE_SIZE% end_if w%=width(0):h%=height(0) end_if return AfficheResultat: ' --------------------------- ' Affichage du résultat : ' --------------------------- clear tmpResultVar% clear lstObject% if nbObjetsTrouves% <> 0 for i% = 1 TO nbObjetsTrouves% for j%=0 to nbInfo%-1 if len(Objet$(i%,j%))"" item_add lstObject%,"Objet: "+Objet$(i%,0)+ Objet$(i%,1)+ " Ligne "+Objet$(i%,3)+ " Identifié par "+Objet$(i%,2)+" en ligne "+Objet$(i%,4) else item_add lstObject%,"Objet: "+Objet$(i%,0)+Objet$(i%,1)+ " Ligne "+Objet$(i%,3) end_if caption 0,fichier$+" nb ligne:"+str$(count(dFichierInitial%))+" nb objets:"+str$(nbObjetsTrouves%) case 1 a$="Etiquette: "+Objet$(i%,1)+" Ligne "+Objet$(i%,4)+", déclarée en ligne "+Objet$(i%,3) if TRIM$(Objet$(i%,2))="" :a$=a$+"### non utilisé ###":else:a$=a$ +" utilisée en ligne "+Objet$(i%,2):end_if item_add lstObject%,a$ caption 0,fichier$+" nb ligne:"+str$(count(dFichierInitial%))+" nb d'etiquettes:"+str$(nbObjetsTrouves%) case 2 item_add tmpResultVar%,Objet$(i%,1)+" déclarée en ligne "+Objet$(i%,3)+" utilisée "+Objet$(i%,2)+" fois en "+Objet$(i%,4) caption 0,fichier$+" nb ligne:"+str$(count(dFichierInitial%))+" nb de variables:"+str$(nbObjetsTrouves%) end_select next i% if Mode%=2 sort tmpResultVar% for i%= 1 to nbObjetsTrouves% ligne$=item_read$(tmpResultVar%,i%) while len(ligne$)>nbCarLigne% caption 0,str$(nbCarLigne%) for j%=nbCarLigne% to instr(ligne$,",") step -1 if mid$(ligne$,j%,1)="," then exit_for next j% item_add lstObject%,left$(ligne$,j%) ligne$=" "+mid$(ligne$,j%+1,len(ligne$)-j%) if nbCarLigne% < 17 then exit_while end_while if right$(ligne$,1)="," then ligne$=left$(ligne$,len(ligne$)-1) item_add lstObject%,ligne$ ligne$=string$(nbCarLigne%,"-") item_add lstObject%,ligne$ next i% else sort lstObject% end_if end_if return ' les mots clés doivent être en MAJUSCULE suivi d'un espace DATA "FORM ","BUTTON ","DLIST ","LIST ","EDIT ","MEMO ","OPEN_DIALOG ","TIMER ","PICTURE ","ALPHA " DATA "COMBO ","MOVIE ","GRID ","OPTION ","SCENE2D ","SCENE3D ","SCROLL_BAR ","SOUND ","SPIN ","SPRITE " DATA "CONTAINER ","CHECK " DATA "####" ProgError: ERROR_FRENCH ' message str$(nbCarLigne%) message "Erreur n°"+str$(ERROR_NUMBER)+" "+ERROR_TYPE$+" line "+str$(ERROR_LINE) ' puis on ferme la dll ProgClose: dll_off terminate