Les cris des animaux

@ papydall,

- En principe, j'essaye de faire des programmes "portables"
pour que l'endroit où il soit placé par un testeur puis un utilisateur tiers
ne soient pas un problème.

Je vais vérifier pour le *.bat

- Comme je l'ai dit dans un post précédent, l'erreur de tri, je ne me l'explique pas...
J' ai repris l'astuce de Cosmos70, qui est bonne, mais normalement ma chaine $ finale fait 26 mots
mais de temps en temps elle en fait 27 et c'est là qu'on retrouve deux fois la même proposition.
Pourquoi ?, c'est un grand mystère...
C'est comme si je lui demandai de me donner dix fois le résultat de 2+2
et qu' une fois sur 10 il me dise 5 au lieu de 4. geek

Petit problème pour rendre portable le *.bat
l'adresse du fichier d'aide est inscrite dans ce fichier entre deux doubles guillemets (")
sauf que si je créée un fichier puis je veux écrire cette adresse tel que
ben pas moyen

file_writeln 304,"""+Dossier$+"\...........+""" ca passe pas, pas bon string
et si je mets deux simples guillemets(') ca marche pas, adresse pas reconnue

scratch

edit :

même

chr$(34)+Dossier$+"\............"+chr$(34) les chr$(34) ne sont pas pris en compte

L’adresse d’un fichier contenu dans un .bat ne doit pas NECESSAIREMENT être entre 2 doubles guillemets.
Les 2 guillemets du début suffisent.
Exemple :

Code:: @ echo off
"D:\Panoramic\Forum\ygeronimi\LesAnimauxduMonde\Aide Les animaux du monde.chm

Bien sûr il faut adapter le chemin.
Enregistre ce code par exemple sous test.bat sur le bureau.
En double-cliquant sur son nom, il exécute le fichier d’aide.

Pour obtenir en Panoramic une chaine contenant 2 guillemets au début, faites comme ceci : (sans mettre les guillemets à la fin)

Code:: dim a$
a$ = "D:\Panoramic\Forum\ygeronimi\LesAnimauxduMonde\Aide Les animaux du monde.chm
print a$

Je ne sais pas si cette info te sera utile ou non.

@ papydall

Je vais essayer ta solution...et je te tiens au courant... Laughing

le but :

- à l'ouverture vérification de la présence du *.bat
- destruction de celui
- re création avec le chemin de fichier du moment

de ce fait plus d'erreur ...enfin, pour ce motif là... Rolling Eyes

Je viens de compléter le dossier image pour les animaux présents dans le fichier Bdd de base
et de mettre à jours ce fichier Bdd.
c'est dispo sur le webdav.

Si la solution de papydall fonctionne, je mettrai la mise à jour du main sur le forum.
çà vous fera gagner un peu de temps... Laughing

Spécial dédicace pour papydall,

J'ai essayé, çà fonctionne donc je publie... Wink

voilà le code du main dans son intégralité :

Code:: ' ---------------------------------------------------------------------------------------------------------------
' configuration des lignes du fichier base :
' Animal$;Sexe_1$ ou_2$;Animal_frere$ ou_soeur$;Animal_pere$;Animal_mere$;adr Animal_image$;adr Animal_son$ |Cri$
' ---------------------------------------------------------------------------------------------------------------
' La variable passe partout
dim x%, M% ,Lg$,a$,i%,sep% ,T% ,B_Rep% ,J$,res$,P$(5),R$,Propo% ,P%(5),v%,Z$,W%,G%,cpte%,F_bat$
dim Dossier$,Doss_Langue$,Doss_Img$,Doss_Son$,Doss_Bdd$,Score$
dim Param$,Langue$,Base$
dim Titre$(100),Animal$(8),Num_memo%(10),Animal%,Ligne$,Rep$
dim result%,batch$
label Init_Prog,Init_List,Init_Langue,Menu_Langue
label Menu,Jouer,Arreter,Lien,Quitter,Score,Aide
label Init_Jeu,Tirage,Verif_Tirage,Init_Animal,Choix,Enrgt_Choix,Suivant,Ecouter
label Reponse,Tirage_Rep,verif_rep,Remp_Grid,Ferm_Score,Liste_Reponses
' ******************************************************************************
' Definition de la fenêtre principale
W%=500
G%=(screen_x-500)/2
height 0,350 :width 0,W%:top 0,(screen_y-350)/2:left 0,G%
caption 0,"Les animaux du monde - Vs: 0.9":font_name 0,"Times new roman":font_size 0,10:color 0,250,247,232
application_title "Les animaux du monde"
' Le menu
main_menu 1
for x% =2 to 5
sub_menu x%:parent x%,1:on_click x%,Menu
next x%
sub_menu 9:parent 9,1:on_click 9,Menu
for x% =6 to 8
sub_menu x%:parent x%,2:on_click x%,Menu
next x%
' L'image de fond
picture 20:width 20,482:height 20,289
' Le container pour le jeu
container 100:hide 100:font_size 100,10
top 100,5 : left 100,5:height 100,280:width 100,475:font_name 100,"Times new roman"
for x% =101 to 109 :alpha x% :parent x%,100:next x%
top 101,25:left 101,100:font_size 101,16:font_color 101,110,10,5
top 102,60:left 102,13:font_color 102,0,0,255
top 103,60:left 103,60
top 104,60:left 104,160:font_color 104,0,0,255
top 105,60:left 105,207
top 106,60:left 106,307:font_color 106,0,0,255
top 107,60:left 107,354
top 108,100:left 108,200:font_color 108,0,0,255
top 109,255:left 109,13

button 110:parent 110,100:top 110,250:left 110,385:width 110,24:cursor_point 110
caption 110,"X":font_name 110,"Webdings":font_size 110,12:on_click 110,Ecouter
button 111:parent 111,100:top 111,250:left 111,415:width 111,24:cursor_point 111
caption 111,"4":font_name 111,"Webdings":font_size 111,12:on_click 111,Enrgt_Choix
button 112:parent 112,100:top 112,250:left 112,445:width 112,24:cursor_point 112
caption 112,"8":font_name 112,"Webdings":font_size 112,12:on_click 112,Suivant
list 113:parent 113,100:top 113,120:left 113,200:width 113,200:height 113,120
sort_on 113:on_click 113,Choix
picture 114:parent 114,100:top 114,95:left 114,10:width 114,150:height 114,150
sound 115

' Le container pour l'A Propos
container 200:hide 200
top 200,5 : left 200,5:height 200,280:width 200,475
alpha 201:parent 201,200:top 201,30:left 201,20:caption 201,"Cet Utilitaire a été créé avec:":font_name 201,"Arial"
alpha 202:parent 202,200:top 202,60:left 202,50:caption 202,"PANORAMIC":font_name 202,"Arial":font_size 202,15
cursor_point 202:font_bold 202:font_color 202,0,0,255:on_click 202,Lien
hint 202,"Cliquez pour rejoindre la communauté des ''Panoramiciens''"
alpha 203:parent 203,200:top 203,68:left 203,190:caption 203,"Vs 0.9.23i6 du 16/05/2012":font_name 203,"Arial"
alpha 204:parent 204,200:top 204,100:left 204,40:caption 204,"Pour respecter l'esprit, cet utilitaire est freeware"+chr$(13)+"et ne peut être vendu."
font_name 204,"Arial":font_color 204,255,0,0
alpha 205:parent 205,200:font_name 204,"Arial":top 205,150:left 205,30:caption 205,"Ce jeu est basé sur une idée originale de Papydall"+chr$(13)+"Membre du Forum Panoramic"

' contenu du fichier inf
dlist 300
' liste des langues
dlist 301
' contenu du fichier langue
dlist 302
' contenu du fichier base
dlist 303
' contenu du list cri
dlist 305
' contenu du list score
dlist 306
' contenu du list réponses
dlist 307:dlist 308

gosub Init_Prog
gosub Init_Langue
end
' ******************************************************************************
Init_Prog:
Dossier$=Dir_current$
Doss_Langue$=Dossier$+"\Langues"
Doss_Img$=Dossier$+"\Images"
Doss_Son$=Dossier$+"\Sons"
Doss_Bdd$=Dossier$+"\Bdd"
Param$=Dossier$+"\Param.inf"
if file_exists(Param$)=0
file_open_write 304,Param$
file_writeln 304,"French.txt"
file_close 304
end_if
if file_exists(dir_current$+"\fichier_help.bat")=1
file_delete dir_current$+"\fichier_help.bat"
end_if
F_bat$=chr$(34)+dir_current$+"\Aide Les animaux du monde.chm"
file_open_write 2000,dir_current$+"\fichier_help.bat"
file_writeln 2000,"@ echo off"
file_writeln 2000,F_bat$
file_close 2000
batch$=Dossier$+"\fichier_help.bat"
file_load 300,Param$
Langue$=Doss_Langue$+"\French.txt"
Base$=Doss_Bdd$+"\French_Bdd.txt"
file_load 20,Doss_Img$+"\Fond2.jpg"
if file_exists(Dossier$+"\Score.Bdd")=0
file_open_write 304,Dossier$+"\Score.Bdd"
file_close 304
end_if
Score$=Dossier$+"\Score.Bdd"
file_load 306,Score$
gosub Init_List
return
' ------------------------------------------------------------------------------
Init_List:
dir_change Doss_Langue$
item_add 301,file_find_first$
a$=file_find_next$
while a$<>"_"
if a$<>"_"
item_add 301,a$
else
exit_while
end_if
a$=file_find_next$
end_while
file_find_close
for x%=400 to 399+count(301)
sub_menu x% :parent x%,3:caption x%,left$(item_read$(301,x%-399),len(item_read$(301,x%-399))-4):on_click x%,Menu_Langue
next x%
file_load 302,Langue$
file_load 303,Base$
return
' ------------------------------------------------------------------------------
Init_Langue:
for x%=1 to count(302) :Titre$(x%)=item_read$(302,x%) :next x%
for x%=1 to 7 :caption x%+1,Titre$(x%):next x%
caption 104,Titre$(10)
caption 106,Titre$(11)
caption 108,Titre$(12)
caption 201,Titre$(16)
caption 202,Titre$(17)
caption 203,Titre$(18)
caption 204,Titre$(19)
caption 205,Titre$(20)
hint 110,Titre$(13)
hint 111,Titre$(14)
hint 112,Titre$(15)
caption 9,Titre$(27)
return
' ------------------------------------------------------------------------------
Menu:
for x%=2 to 9
if clicked(x%)=1 then M% =x%
next x%
Select M%
case 2
case 3
case 4
show 200:hide 100:hide 20
case 5
gosub Aide
case 6
show 100:hide 200:hide 20
gosub Jouer
case 7
gosub Arreter
case 8
gosub Quitter
case 9
gosub Score
inactive 2:inactive 3:inactive 4:inactive 9
end_select
return
' ------------------------------------------------------------------------------
Menu_Langue:
for x%=400 to 409
if object_exists(x%)=1
if clicked(x%)=1
Lg$=item_read$(301,x%-399)
Langue$=Doss_Langue$+"\"+Lg$
clear 300:clear 302:clear 303
item_add 300,Lg$
file_save 300,Param$
file_load 302,Langue$
if file_exists(Doss_Bdd$+"\"+left$(Lg$,len(Lg$)-4)+"_Bdd.txt")=1
Base$=Doss_Bdd$+"\"+left$(Lg$,len(Lg$)-4)+"_Bdd.txt"
file_load 303,Base$
else
file_open_write 304,Doss_Bdd$+"\"+left$(Lg$,len(Lg$)-4)+"_Bdd.txt"
file_close 304
end_if
end_if
else
exit_for
end_if
next x%
gosub Init_Langue
return
' ------------------------------------------------------------------------------
Jouer:
inactive 4:inactive 6:inactive 9
J$=message_input$("Nom du Joueur","Nom :","Joueur Inconnu")
gosub Init_Jeu
gosub Tirage
clear 113
gosub Liste_Reponses
gosub Reponse
return
'-------------------------------------------------------------------------------
Init_Jeu:
for i%=1 to 10:Num_memo%(i%)=0:next i%
T%=0
B_Rep%=0
caption 101,""
caption 102,""
caption 103,""
caption 105,""
caption 107,""
file_load 114,Doss_Img$+"\defaut.bmp"
return
' ------------------------------------------------------------------------------
Tirage:
if count(303)>0
Animal%=int(rnd(count(303)))+1
end_if
gosub Verif_Tirage
return
' ------------------------------------------------------------------------------
Verif_Tirage:
for i%=1 to 10
if Num_memo%(i%)=0
Num_memo%(i%)=Animal%
Ligne$=item_read$(303,Animal%)
T%=T%+1
gosub Init_Animal
exit_for
else
if Num_memo%(i%)=Animal%
gosub Tirage
exit_for
else
if i%=10 and Num_memo%(i%)>0
gosub Arreter
end_if
end_if
end_if
next i%
return
' ------------------------------------------------------------------------------
Liste_Reponses:
clear 307:clear 308
R$=""
for x%=1 to count(303)
R$=item_read$(303,x%)
sep%=instr(R$,"|")
item_add 307,right$(R$,len(R$)-sep%)
next x%
item_delete 307,Animal%
R$=""
for x%=1 to count(307)
Z$=Trim$(item_read$(307,x%))
if instr(R$,Z$)=0
item_add 308,Z$
R$=R$+"|"+Z$
end_if
next x%
return
' ------------------------------------------------------------------------------
Reponse:
for x%=1 to 4:P%(x%)=0:next x%
repeat
gosub Tirage_Rep
until P%(4)<>0
for x%=1 to 4 :P$(x%)=item_read$(308,P%(x%)):item_add 113,P$(x%):next x%
item_add 113,Animal$(8)
return
' ------------------------------------------------------------------------------
Tirage_Rep:
if count(308)>0
Propo%=int(rnd(count(308)))+1
end_if
gosub Verif_Rep
return
' ------------------------------------------------------------------------------
verif_rep:
for x%=1 to 4
if P%(x%)=0
P%(x%)=Propo%
exit_for
else
if P%(x%)=Propo%
gosub Tirage
exit_for
else
if x%=4 and P%(x%)>0
exit_for
end_if
end_if
end_if
next x%
return
' ------------------------------------------------------------------------------
Init_Animal:
sep%=instr(Ligne$,";")
Animal$(1)=Left$(Ligne$,sep%-1)
caption 101,Animal$(1)
Ligne$=right$(Ligne$,len(Ligne$)-sep%)
sep%=instr(Ligne$,";")
Animal$(2)=Left$(Ligne$,sep%-1)
if val(Animal$(2))=1
caption 102,Titre$(9)
else
caption 102,Titre$(8)
end_if
Ligne$=right$(Ligne$,len(Ligne$)-sep%)
sep%=instr(Ligne$,";")
Animal$(3)=Left$(Ligne$,sep%-1)
caption 103,Animal$(3)
Ligne$=right$(Ligne$,len(Ligne$)-sep%)
sep%=instr(Ligne$,";")
Animal$(4)=Left$(Ligne$,sep%-1)
caption 105,Animal$(4)
Ligne$=right$(Ligne$,len(Ligne$)-sep%)
sep%=instr(Ligne$,";")
Animal$(5)=Left$(Ligne$,sep%-1)
caption 107,Animal$(5)
Ligne$=right$(Ligne$,len(Ligne$)-sep%)
sep%=instr(Ligne$,";")
Animal$(6)=Left$(Ligne$,sep%-1)
if Animal$(6)<>""
file_load 114,Doss_Img$+"\"+Animal$(6)
else
file_load 114,Doss_Img$+"\defaut.bmp"
end_if
Ligne$=right$(Ligne$,len(Ligne$)-sep%)
sep%=instr(Ligne$,"|")
Animal$(7)=Left$(Ligne$,sep%-1)
Animal$(8)=right$(Ligne$,len(Ligne$)-sep%)
caption 109,""
if Animal$(7)=""
inactive 110
else
active 110
end_if
return
' ------------------------------------------------------------------------------
Arreter:
active 4:active 6:active 9
if B_Rep% >5 and B_rep% < 10
Message Titre$(21)+chr$(13)+Titre$(22)+" "+str$(B_Rep%)+" / 10"
else
if B_Rep% <5
Message Titre$(23)+chr$(13)+Titre$(22)+" "+str$(B_Rep%)+" / 10"
else
Message Titre$(24)+chr$(13)+Titre$(22)+" "+str$(B_Rep%)+" / 10"
end_if
end_if
item_add 306,Date$+";"+J$+";"+str$(B_Rep%)
file_save 306,Dossier$+"\Score.Bdd"
show 20:hide 100
gosub Init_Jeu
return
' ------------------------------------------------------------------------------
Choix:
Rep$=item_index$(113)
return
' ------------------------------------------------------------------------------
Enrgt_Choix:
if Rep$=Animal$(8)
B_Rep%=B_Rep%+1
caption 109,Titre$(25):font_color 109,2,173,65:font_size 109,10
else
caption 109,Titre$(26)+Animal$(8):font_color 109,179,4,7:font_size 109,10
end_if
inactive 111
return
' ------------------------------------------------------------------------------
Suivant:
gosub Tirage
clear 113
gosub Liste_Reponses
gosub Reponse
active 111
return
' ------------------------------------------------------------------------------
Ecouter:
if Animal$(7)<>""
file_load 115,Doss_Son$+"\"+Animal$(7)
play 115
end_if
return
' ------------------------------------------------------------------------------
Lien:
execute "http://panoramic-language.pagesperso-orange.fr/French/index.html"
return
' ------------------------------------------------------------------------------
Score:
for x%=0 to 320
W%=W%+1
width 0,W%
next x%
for x%=0 to 320 step 2
G%=G%-1
left 0,G%
next x%
grid 701:top 701,10:left 701,485:height 701,250:width 701,287:grid_column 701,3:grid_row 701,2
grid_row_height 701,20:grid_one_column_width 701,2,134
grid_write 701,1,1,"Date":grid_write 701,1,2,"Joueur":grid_write 701,1,3,"Score"
button 707:top 707,265:left 707,697:caption 707,Titre$(7):on_click 707,Ferm_Score
gosub Remp_Grid
return
' ------------------------------------------------------------------------------
Remp_Grid:
if count(306)>0
grid_row 701,count(306)+1
for x%=1 to count(306)
res$=item_read$(306,x%)
sep%=instr(res$,";")
grid_write 701,x%+1,1,left$(res$,sep%-1)
res$=right$(res$,len(res$)-sep%)
sep%=instr(res$,";")
grid_write 701,x%+1,2,left$(res$,sep%-1)
grid_write 701,x%+1,3,right$(res$,len(res$)-sep%)
next x%
end_if
return
' ------------------------------------------------------------------------------

' ------------------------------------------------------------------------------
Ferm_Score:
delete 701
delete 707
for x%=0 to 320
W%=W%-1
width 0,W%
next x%
for x%=0 to 320 step 2
G%=G%+1
left 0,G%
next x%
active 2:active 3:active 4:active 9
return
' ------------------------------------------------------------------------------
Aide:
DLL_ON Dossier$+"\Utils.dll"
result%=DLL_CALL1("Execute",ADR(batch$))
DLL_OFF
return
' ------------------------------------------------------------------------------
Quitter:
Terminate

J'ai testé le jeu, il est vraiment sympa maintenant. Je n'ai pas le temps de regarder pourquoi le score met des bêtises (10 bonnes réponses => score 8/10) mais si tu ne trouve pas je regarderais la semaine prochaine (pas là ce week-end)

@ Jicehel,

Il y a deux choses que je ne m'explique pas :

- la liste des réponses dans laquelle je pioche pour le "list" qui de temps en temps me sort 1 élément de plus
alors que les listes sont effacées en début de fonction, et qui à ce moment là provoque deux même réponses possible dans le list.

là je voudrai essayer de donner une valeur numérique à chaque réponse avant de créer la chaine de comparaison par "instr"
peut être que l'erreur disparaîtrait ....( mais c'est pas gagné d'avance )

le compteur de bonnes réponses qui, lui, met 8/10 quand c'est 10/10 mais c'est pas tout le temps non plus puisque je suis arrivé à 10/10

voilà ce qui cloche

ha!, j'oubliai ( çà en fait trois ), il y a l' "accès violation" quand on se sert la première fois du score même si quand on clique "ok" il ne se reproduit
plus et le jeu fonctionne
normalement.

On n’est qu’à la 11ème page. La sortie du tunnel se fera avant la 15ème. Alors un petit effort de plus.

sunny

Je pense que ce jeu pourrait rentrer dans la rubrique des programmes collaboratifs
tellement il y a de personne qui y ont participé soit par réponses et/ou test
ou encore par des bouts de code piqués ici et là... Laughing

Je viens de faire une tentative en donnant à chaque proposition de la liste une valeur numérique.
Cette valeur est basé sur l'addition des codes ascii de chaque caractère de la proposition.
le problème persiste ...

voilà le code avec mon essai :

Code:: ' ---------------------------------------------------------------------------------------------------------------
' configuration des lignes du fichier base :
' Animal$;Sexe_1$ ou_2$;Animal_frere$ ou_soeur$;Animal_pere$;Animal_mere$;adr Animal_image$;adr Animal_son$ |Cri$
' ---------------------------------------------------------------------------------------------------------------
' La variable passe partout
dim x%, M% ,Lg$,a$,i%,sep% ,T% ,B_Rep% ,J$,res$,P$(5),R$,Propo% ,P%(5),v%,Z$,W%,G%,cpte%,F_bat$,b%,Z%,W$
dim Dossier$,Doss_Langue$,Doss_Img$,Doss_Son$,Doss_Bdd$,Score$
dim Param$,Langue$,Base$
dim Titre$(100),Animal$(8),Num_memo%(10),Animal%,Ligne$,Rep$
dim result%,batch$
label Init_Prog,Init_List,Init_Langue,Menu_Langue
label Menu,Jouer,Arreter,Lien,Quitter,Score,Aide
label Init_Jeu,Tirage,Verif_Tirage,Init_Animal,Choix,Enrgt_Choix,Suivant,Ecouter
label Reponse,Tirage_Rep,verif_rep,Remp_Grid,Ferm_Score,Liste_Reponses
' ******************************************************************************
' Definition de la fenêtre principale
W%=500
G%=(screen_x-500)/2
height 0,350 :width 0,W%:top 0,(screen_y-350)/2:left 0,G%
caption 0,"Les animaux du monde - Vs: 0.9":font_name 0,"Times new roman":font_size 0,10:color 0,250,247,232
application_title "Les animaux du monde"
' Le menu
main_menu 1
for x% =2 to 5
sub_menu x%:parent x%,1:on_click x%,Menu
next x%
sub_menu 9:parent 9,1:on_click 9,Menu
for x% =6 to 8
sub_menu x%:parent x%,2:on_click x%,Menu
next x%
' L'image de fond
picture 20:width 20,482:height 20,289
' Le container pour le jeu
container 100:hide 100:font_size 100,10
top 100,5 : left 100,5:height 100,280:width 100,475:font_name 100,"Times new roman"
for x% =101 to 109 :alpha x% :parent x%,100:next x%
top 101,25:left 101,100:font_size 101,16:font_color 101,110,10,5
top 102,60:left 102,13:font_color 102,0,0,255
top 103,60:left 103,60
top 104,60:left 104,160:font_color 104,0,0,255
top 105,60:left 105,207
top 106,60:left 106,307:font_color 106,0,0,255
top 107,60:left 107,354
top 108,100:left 108,200:font_color 108,0,0,255
top 109,255:left 109,13

button 110:parent 110,100:top 110,250:left 110,385:width 110,24:cursor_point 110
caption 110,"X":font_name 110,"Webdings":font_size 110,12:on_click 110,Ecouter
button 111:parent 111,100:top 111,250:left 111,415:width 111,24:cursor_point 111
caption 111,"4":font_name 111,"Webdings":font_size 111,12:on_click 111,Enrgt_Choix
button 112:parent 112,100:top 112,250:left 112,445:width 112,24:cursor_point 112
caption 112,"8":font_name 112,"Webdings":font_size 112,12:on_click 112,Suivant
list 113:parent 113,100:top 113,120:left 113,200:width 113,200:height 113,120
sort_on 113:on_click 113,Choix
picture 114:parent 114,100:top 114,95:left 114,10:width 114,150:height 114,150
sound 115

' Le container pour l'A Propos
container 200:hide 200
top 200,5 : left 200,5:height 200,280:width 200,475
alpha 201:parent 201,200:top 201,30:left 201,20:caption 201,"Cet Utilitaire a été créé avec:":font_name 201,"Arial"
alpha 202:parent 202,200:top 202,60:left 202,50:caption 202,"PANORAMIC":font_name 202,"Arial":font_size 202,15
cursor_point 202:font_bold 202:font_color 202,0,0,255:on_click 202,Lien
hint 202,"Cliquez pour rejoindre la communauté des ''Panoramiciens''"
alpha 203:parent 203,200:top 203,68:left 203,190:caption 203,"Vs 0.9.23i6 du 16/05/2012":font_name 203,"Arial"
alpha 204:parent 204,200:top 204,100:left 204,40:caption 204,"Pour respecter l'esprit, cet utilitaire est freeware"+chr$(13)+"et ne peut être vendu."
font_name 204,"Arial":font_color 204,255,0,0
alpha 205:parent 205,200:font_name 204,"Arial":top 205,150:left 205,30:caption 205,"Ce jeu est basé sur une idée originale de Papydall"+chr$(13)+"Membre du Forum Panoramic"

alpha 2001:hide 2001
' contenu du fichier inf
dlist 300
' liste des langues
dlist 301
' contenu du fichier langue
dlist 302
' contenu du fichier base
dlist 303
' contenu du list cri
dlist 305
' contenu du list score
dlist 306
' contenu du list réponses
dlist 307:dlist 308

gosub Init_Prog
gosub Init_Langue
end
' ******************************************************************************
Init_Prog:
Dossier$=Dir_current$
Doss_Langue$=Dossier$+"\Langues"
Doss_Img$=Dossier$+"\Images"
Doss_Son$=Dossier$+"\Sons"
Doss_Bdd$=Dossier$+"\Bdd"
Param$=Dossier$+"\Param.inf"
if file_exists(Param$)=0
file_open_write 304,Param$
file_writeln 304,"French.txt"
file_close 304
end_if
if file_exists(dir_current$+"\fichier_help.bat")=1
file_delete dir_current$+"\fichier_help.bat"
end_if
F_bat$=chr$(34)+dir_current$+"\Aide Les animaux du monde.chm"
file_open_write 2000,dir_current$+"\fichier_help.bat"
file_writeln 2000,"@ echo off"
file_writeln 2000,F_bat$
file_close 2000
batch$=Dossier$+"\fichier_help.bat"
file_load 300,Param$
Langue$=Doss_Langue$+"\French.txt"
Base$=Doss_Bdd$+"\French_Bdd.txt"
file_load 20,Doss_Img$+"\Fond2.jpg"
if file_exists(Dossier$+"\Score.Bdd")=0
file_open_write 304,Dossier$+"\Score.Bdd"
file_close 304
end_if
Score$=Dossier$+"\Score.Bdd"
file_load 306,Score$
gosub Init_List
return
' ------------------------------------------------------------------------------
Init_List:
dir_change Doss_Langue$
item_add 301,file_find_first$
a$=file_find_next$
while a$<>"_"
if a$<>"_"
item_add 301,a$
else
exit_while
end_if
a$=file_find_next$
end_while
file_find_close
for x%=400 to 399+count(301)
sub_menu x% :parent x%,3:caption x%,left$(item_read$(301,x%-399),len(item_read$(301,x%-399))-4):on_click x%,Menu_Langue
next x%
file_load 302,Langue$
file_load 303,Base$
return
' ------------------------------------------------------------------------------
Init_Langue:
for x%=1 to count(302) :Titre$(x%)=item_read$(302,x%) :next x%
for x%=1 to 7 :caption x%+1,Titre$(x%):next x%
caption 104,Titre$(10)
caption 106,Titre$(11)
caption 108,Titre$(12)
caption 201,Titre$(16)
caption 202,Titre$(17)
caption 203,Titre$(18)
caption 204,Titre$(19)
caption 205,Titre$(20)
hint 110,Titre$(13)
hint 111,Titre$(14)
hint 112,Titre$(15)
caption 9,Titre$(27)
return
' ------------------------------------------------------------------------------
Menu:
for x%=2 to 9
if clicked(x%)=1 then M% =x%
next x%
Select M%
case 2
case 3
case 4
show 200:hide 100:hide 20
case 5
gosub Aide
case 6
show 100:hide 200:hide 20
gosub Jouer
case 7
gosub Arreter
case 8
gosub Quitter
case 9
gosub Score
inactive 2:inactive 3:inactive 4:inactive 9
end_select
return
' ------------------------------------------------------------------------------
Menu_Langue:
for x%=400 to 409
if object_exists(x%)=1
if clicked(x%)=1
Lg$=item_read$(301,x%-399)
Langue$=Doss_Langue$+"\"+Lg$
clear 300:clear 302:clear 303
item_add 300,Lg$
file_save 300,Param$
file_load 302,Langue$
if file_exists(Doss_Bdd$+"\"+left$(Lg$,len(Lg$)-4)+"_Bdd.txt")=1
Base$=Doss_Bdd$+"\"+left$(Lg$,len(Lg$)-4)+"_Bdd.txt"
file_load 303,Base$
else
file_open_write 304,Doss_Bdd$+"\"+left$(Lg$,len(Lg$)-4)+"_Bdd.txt"
file_close 304
end_if
end_if
else
exit_for
end_if
next x%
gosub Init_Langue
return
' ------------------------------------------------------------------------------
Jouer:
inactive 4:inactive 6:inactive 9
J$=message_input$("Nom du Joueur","Nom :","Joueur Inconnu")
gosub Init_Jeu
gosub Tirage
clear 113
gosub Liste_Reponses
gosub Reponse
return
'-------------------------------------------------------------------------------
Init_Jeu:
for i%=1 to 10:Num_memo%(i%)=0:next i%
T%=0
B_Rep%=0
caption 101,""
caption 102,""
caption 103,""
caption 105,""
caption 107,""
file_load 114,Doss_Img$+"\defaut.bmp"
return
' ------------------------------------------------------------------------------
Tirage:
if count(303)>0
Animal%=int(rnd(count(303)))+1
end_if
gosub Verif_Tirage
return
' ------------------------------------------------------------------------------
Verif_Tirage:
for i%=1 to 10
if Num_memo%(i%)=0
Num_memo%(i%)=Animal%
Ligne$=item_read$(303,Animal%)
T%=T%+1
gosub Init_Animal
exit_for
else
if Num_memo%(i%)=Animal%
gosub Tirage
exit_for
else
if i%=10 and Num_memo%(i%)>0
gosub Arreter
end_if
end_if
end_if
next i%
return
' ------------------------------------------------------------------------------
Liste_Reponses:
clear 307:clear 308
R$=""
for x%=1 to count(303)
R$=item_read$(303,x%)
sep%=instr(R$,"|")
item_add 307,right$(R$,len(R$)-sep%)
next x%
item_delete 307,Animal%
R$=""
for x%=1 to count(307)
Z$=Trim$(item_read$(307,x%))
W$=Z$
Z%=0
for b%=1 to len(Z$):Z%=Z%+asc(Z$):Z$=right$(Z$,len(Z$)-1):next b%

if instr(R$,str$(Z%))=0
item_add 308,W$
R$=R$+"|"+str$(Z%)
end_if
message R$
next x%
return
' ------------------------------------------------------------------------------
Reponse:
for x%=1 to 4:P%(x%)=0:next x%
repeat
gosub Tirage_Rep
until P%(4)<>0
for x%=1 to 4 :P$(x%)=item_read$(308,P%(x%)):item_add 113,P$(x%):next x%
item_add 113,Animal$(8)
return
' ------------------------------------------------------------------------------
Tirage_Rep:
if count(308)>0
Propo%=int(rnd(count(308)))+1
end_if
gosub Verif_Rep
return
' ------------------------------------------------------------------------------
verif_rep:
for x%=1 to 4
if P%(x%)=0
P%(x%)=Propo%
exit_for
else
if P%(x%)=Propo%
gosub Tirage
exit_for
else
if x%=4 and P%(x%)>0
exit_for
end_if
end_if
end_if
next x%
return
' ------------------------------------------------------------------------------
Init_Animal:
sep%=instr(Ligne$,";")
Animal$(1)=Left$(Ligne$,sep%-1)
caption 101,Animal$(1)
Ligne$=right$(Ligne$,len(Ligne$)-sep%)
sep%=instr(Ligne$,";")
Animal$(2)=Left$(Ligne$,sep%-1)
if val(Animal$(2))=1
caption 102,Titre$(9)
else
caption 102,Titre$(8)
end_if
Ligne$=right$(Ligne$,len(Ligne$)-sep%)
sep%=instr(Ligne$,";")
Animal$(3)=Left$(Ligne$,sep%-1)
caption 103,Animal$(3)
Ligne$=right$(Ligne$,len(Ligne$)-sep%)
sep%=instr(Ligne$,";")
Animal$(4)=Left$(Ligne$,sep%-1)
caption 105,Animal$(4)
Ligne$=right$(Ligne$,len(Ligne$)-sep%)
sep%=instr(Ligne$,";")
Animal$(5)=Left$(Ligne$,sep%-1)
caption 107,Animal$(5)
Ligne$=right$(Ligne$,len(Ligne$)-sep%)
sep%=instr(Ligne$,";")
Animal$(6)=Left$(Ligne$,sep%-1)
if Animal$(6)<>""
file_load 114,Doss_Img$+"\"+Animal$(6)
else
file_load 114,Doss_Img$+"\defaut.bmp"
end_if
Ligne$=right$(Ligne$,len(Ligne$)-sep%)
sep%=instr(Ligne$,"|")
Animal$(7)=Left$(Ligne$,sep%-1)
Animal$(8)=right$(Ligne$,len(Ligne$)-sep%)
caption 109,""
if Animal$(7)=""
inactive 110
else
active 110
end_if
return
' ------------------------------------------------------------------------------
Arreter:
active 4:active 6:active 9
if B_Rep% >5 and B_rep% < 10
Message Titre$(21)+chr$(13)+Titre$(22)+" "+str$(B_Rep%)+" / 10"
else
if B_Rep% <5
Message Titre$(23)+chr$(13)+Titre$(22)+" "+str$(B_Rep%)+" / 10"
else
Message Titre$(24)+chr$(13)+Titre$(22)+" "+str$(B_Rep%)+" / 10"
end_if
end_if
item_add 306,Date$+";"+J$+";"+str$(B_Rep%)
file_save 306,Dossier$+"\Score.Bdd"
show 20:hide 100
gosub Init_Jeu
return
' ------------------------------------------------------------------------------
Choix:
Rep$=item_index$(113)
return
' ------------------------------------------------------------------------------
Enrgt_Choix:
if Rep$=Animal$(8)
B_Rep%=B_Rep%+1
caption 109,Titre$(25):font_color 109,2,173,65:font_size 109,10
else
caption 109,Titre$(26)+Animal$(8):font_color 109,179,4,7:font_size 109,10
end_if
inactive 111
return
' ------------------------------------------------------------------------------
Suivant:
gosub Tirage
clear 113
gosub Liste_Reponses
gosub Reponse
active 111
return
' ------------------------------------------------------------------------------
Ecouter:
if Animal$(7)<>""
file_load 115,Doss_Son$+"\"+Animal$(7)
play 115
end_if
return
' ------------------------------------------------------------------------------
Lien:
execute "http://panoramic-language.pagesperso-orange.fr/French/index.html"
return
' ------------------------------------------------------------------------------
Score:
for x%=0 to 320
W%=W%+1
width 0,W%
next x%
for x%=0 to 320 step 2
G%=G%-1
left 0,G%
next x%
grid 701:top 701,10:left 701,485:height 701,250:width 701,287:grid_column 701,3:grid_row 701,2
grid_row_height 701,20:grid_one_column_width 701,2,134
grid_write 701,1,1,"Date":grid_write 701,1,2,"Joueur":grid_write 701,1,3,"Score"
button 707:top 707,265:left 707,697:caption 707,Titre$(7):on_click 707,Ferm_Score
gosub Remp_Grid
return
' ------------------------------------------------------------------------------
Remp_Grid:
if count(306)>0
grid_row 701,count(306)+1
for x%=1 to count(306)
res$=item_read$(306,x%)
sep%=instr(res$,";")
grid_write 701,x%+1,1,left$(res$,sep%-1)
res$=right$(res$,len(res$)-sep%)
sep%=instr(res$,";")
grid_write 701,x%+1,2,left$(res$,sep%-1)
grid_write 701,x%+1,3,right$(res$,len(res$)-sep%)
next x%
end_if
return
' ------------------------------------------------------------------------------
Ferm_Score:
delete 701
delete 707
for x%=0 to 320
W%=W%-1
width 0,W%
next x%
for x%=0 to 320 step 2
G%=G%+1
left 0,G%
next x%
active 2:active 3:active 4:active 9
return
' ------------------------------------------------------------------------------
Aide:
DLL_ON Dossier$+"\Utils.dll"
result%=DLL_CALL1("Execute",ADR(batch$))
DLL_OFF
return
' ------------------------------------------------------------------------------

' ------------------------------------------------------------------------------
Quitter:
Terminate

Pour être sur du coup j'ai donné sur le même principe une valeur numérique
à chaque proposition possible de cri.

Les cris en double dans la liste initiale portent bien le même nombre donc celà vient de la fonction "instr" dans le code
ou elle saute un élément ou la fonction if = est défectueuse, enfin y'a un pb quelque part... Evil or Very Mad

Invité

Bonjour,
J'ai donné une des deux possibilités que j'utilise. Si elle pose problème, peut-être une écriture différente entre les textes de la comparaison (pour instr).
La deuxième que j'utilise aussi, est de faire un tableau, genre l%(100), où tout est à 0 au départ. Dès que je choisi un mot dans une sélection qui lui aussi est dans une liste, je mets en exemple: animal$(3)="lapin", donc je mets l%(3)=1.
A chaque choix tiré, je regarde, si l%(n°) =0 ou 1.
Comme je l'ai dit, j'ai énormément de mal de trouver le temps de programmer, aussi ton programme je ne le regarde pas. En hiver j'ai plus de temps.

Il y a aussi une troisième solution: Si elle est dans un list, tu supprimes l'item correspondant. Où même dans un tableau, tu mets animal$(3) = "". Evidemment en rejouant, il faut tout remettre.

J'essaie de trouver une solution aux propositions de réponse en double.
Je vous propose d'essayer ce code :

Code:: ' ---------------------------------------------------------------------------------------------------------------
' configuration des lignes du fichier base :
' Animal$;Sexe_1$ ou_2$;Animal_frere$ ou_soeur$;Animal_pere$;Animal_mere$;adr Animal_image$;adr Animal_son$ |Cri$
' ---------------------------------------------------------------------------------------------------------------
' La variable passe partout
dim x%, M% ,Lg$,a$,i%,sep% ,T% ,B_Rep% ,J$,res$,P$(5),R$,Propo% ,P%(5),v%,Z$,W%,G%,cpte%,F_bat$
dim Z%,Nbre_Z%,cas%
dim Dossier$,Doss_Langue$,Doss_Img$,Doss_Son$,Doss_Bdd$,Score$
dim Param$,Langue$,Base$
dim Titre$(100),Animal$(8),Num_memo%(10),Animal%,Ligne$,Rep$
dim result%,batch$
label Init_Prog,Init_List,Init_Langue,Menu_Langue
label Menu,Jouer,Arreter,Lien,Quitter,Score,Aide
label Init_Jeu,Tirage,Verif_Tirage,Init_Animal,Choix,Enrgt_Choix,Suivant,Ecouter
label Reponse,Tirage_Rep,verif_rep,Remp_Grid,Ferm_Score,Liste_Reponses
label Elim_1,Elim_2
' ******************************************************************************
' Definition de la fenêtre principale
W%=500
G%=(screen_x-500)/2
height 0,350 :width 0,W%:top 0,(screen_y-350)/2:left 0,G%
caption 0,"Les animaux du monde - Vs: 0.9":font_name 0,"Times new roman":font_size 0,10:color 0,250,247,232
application_title "Les animaux du monde"
' Le menu
main_menu 1
for x% =2 to 5
sub_menu x%:parent x%,1:on_click x%,Menu
next x%
sub_menu 9:parent 9,1:on_click 9,Menu
for x% =6 to 8
sub_menu x%:parent x%,2:on_click x%,Menu
next x%
' L'image de fond
picture 20:width 20,482:height 20,289
' Le container pour le jeu
container 100:hide 100:font_size 100,10
top 100,5 : left 100,5:height 100,280:width 100,475:font_name 100,"Times new roman"
for x% =101 to 109 :alpha x% :parent x%,100:next x%
top 101,25:left 101,100:font_size 101,16:font_color 101,110,10,5
top 102,60:left 102,13:font_color 102,0,0,255
top 103,60:left 103,60
top 104,60:left 104,160:font_color 104,0,0,255
top 105,60:left 105,207
top 106,60:left 106,307:font_color 106,0,0,255
top 107,60:left 107,354
top 108,100:left 108,200:font_color 108,0,0,255
top 109,255:left 109,13

button 110:parent 110,100:top 110,250:left 110,385:width 110,24:cursor_point 110
caption 110,"X":font_name 110,"Webdings":font_size 110,12:on_click 110,Ecouter
button 111:parent 111,100:top 111,250:left 111,415:width 111,24:cursor_point 111
caption 111,"4":font_name 111,"Webdings":font_size 111,12:on_click 111,Enrgt_Choix
button 112:parent 112,100:top 112,250:left 112,445:width 112,24:cursor_point 112
caption 112,"8":font_name 112,"Webdings":font_size 112,12:on_click 112,Suivant
list 113:parent 113,100:top 113,120:left 113,200:width 113,200:height 113,120
sort_on 113:on_click 113,Choix
picture 114:parent 114,100:top 114,95:left 114,10:width 114,150:height 114,150
sound 115

' Le container pour l'A Propos
container 200:hide 200
top 200,5 : left 200,5:height 200,280:width 200,475
alpha 201:parent 201,200:top 201,30:left 201,20:caption 201,"Cet Utilitaire a été créé avec:":font_name 201,"Arial"
alpha 202:parent 202,200:top 202,60:left 202,50:caption 202,"PANORAMIC":font_name 202,"Arial":font_size 202,15
cursor_point 202:font_bold 202:font_color 202,0,0,255:on_click 202,Lien
hint 202,"Cliquez pour rejoindre la communauté des ''Panoramiciens''"
alpha 203:parent 203,200:top 203,68:left 203,190:caption 203,"Vs 0.9.23i6 du 16/05/2012":font_name 203,"Arial"
alpha 204:parent 204,200:top 204,100:left 204,40:caption 204,"Pour respecter l'esprit, cet utilitaire est freeware"+chr$(13)+"et ne peut être vendu."
font_name 204,"Arial":font_color 204,255,0,0
alpha 205:parent 205,200:font_name 204,"Arial":top 205,150:left 205,30:caption 205,"Ce jeu est basé sur une idée originale de Papydall"+chr$(13)+"Membre du Forum Panoramic"

alpha 2001:hide 2001
' contenu du fichier inf
dlist 300
' liste des langues
dlist 301
' contenu du fichier langue
dlist 302
' contenu du fichier base
dlist 303
' contenu du list cri
dlist 305
' contenu du list score
dlist 306
' contenu du list réponses
dlist 307:dlist 308

gosub Init_Prog
gosub Init_Langue
end
' ******************************************************************************
Init_Prog:
Dossier$=Dir_current$
Doss_Langue$=Dossier$+"\Langues"
Doss_Img$=Dossier$+"\Images"
Doss_Son$=Dossier$+"\Sons"
Doss_Bdd$=Dossier$+"\Bdd"
Param$=Dossier$+"\Param.inf"
if file_exists(Param$)=0
file_open_write 304,Param$
file_writeln 304,"French.txt"
file_close 304
end_if
if file_exists(dir_current$+"\fichier_help.bat")=1
file_delete dir_current$+"\fichier_help.bat"
end_if
F_bat$=chr$(34)+dir_current$+"\Aide Les animaux du monde.chm"
file_open_write 2000,dir_current$+"\fichier_help.bat"
file_writeln 2000,"@ echo off"
file_writeln 2000,F_bat$
file_close 2000
batch$=Dossier$+"\fichier_help.bat"
file_load 300,Param$
Langue$=Doss_Langue$+"\French.txt"
Base$=Doss_Bdd$+"\French_Bdd.txt"
file_load 20,Doss_Img$+"\Fond2.jpg"
if file_exists(Dossier$+"\Score.Bdd")=0
file_open_write 304,Dossier$+"\Score.Bdd"
file_close 304
end_if
Score$=Dossier$+"\Score.Bdd"
file_load 306,Score$
gosub Init_List
return
' ------------------------------------------------------------------------------
Init_List:
dir_change Doss_Langue$
item_add 301,file_find_first$
a$=file_find_next$
while a$<>"_"
if a$<>"_"
item_add 301,a$
else
exit_while
end_if
a$=file_find_next$
end_while
file_find_close
for x%=400 to 399+count(301)
sub_menu x% :parent x%,3:caption x%,left$(item_read$(301,x%-399),len(item_read$(301,x%-399))-4):on_click x%,Menu_Langue
next x%
file_load 302,Langue$
file_load 303,Base$
return
' ------------------------------------------------------------------------------
Init_Langue:
for x%=1 to count(302) :Titre$(x%)=item_read$(302,x%) :next x%
for x%=1 to 7 :caption x%+1,Titre$(x%):next x%
caption 104,Titre$(10)
caption 106,Titre$(11)
caption 108,Titre$(12)
caption 201,Titre$(16)
caption 202,Titre$(17)
caption 203,Titre$(18)
caption 204,Titre$(19)
caption 205,Titre$(20)
hint 110,Titre$(13)
hint 111,Titre$(14)
hint 112,Titre$(15)
caption 9,Titre$(27)
return
' ------------------------------------------------------------------------------
Menu:
for x%=2 to 9
if clicked(x%)=1 then M% =x%
next x%
Select M%
case 2
case 3
case 4
show 200:hide 100:hide 20
case 5
gosub Aide
case 6
show 100:hide 200:hide 20
gosub Jouer
case 7
gosub Arreter
case 8
gosub Quitter
case 9
gosub Score
inactive 2:inactive 3:inactive 4:inactive 9
end_select
return
' ------------------------------------------------------------------------------
Menu_Langue:
for x%=400 to 409
if object_exists(x%)=1
if clicked(x%)=1
Lg$=item_read$(301,x%-399)
Langue$=Doss_Langue$+"\"+Lg$
clear 300:clear 302:clear 303
item_add 300,Lg$
file_save 300,Param$
file_load 302,Langue$
if file_exists(Doss_Bdd$+"\"+left$(Lg$,len(Lg$)-4)+"_Bdd.txt")=1
Base$=Doss_Bdd$+"\"+left$(Lg$,len(Lg$)-4)+"_Bdd.txt"
file_load 303,Base$
else
file_open_write 304,Doss_Bdd$+"\"+left$(Lg$,len(Lg$)-4)+"_Bdd.txt"
file_close 304
end_if
end_if
else
exit_for
end_if
next x%
gosub Init_Langue
return
' ------------------------------------------------------------------------------
Jouer:
inactive 4:inactive 6:inactive 9
J$=message_input$("Nom du Joueur","Nom :","Joueur Inconnu")
gosub Init_Jeu
gosub Tirage
clear 113
gosub Liste_Reponses
gosub Reponse
return
'-------------------------------------------------------------------------------
Init_Jeu:
for i%=1 to 10:Num_memo%(i%)=0:next i%
T%=0
B_Rep%=0
caption 101,""
caption 102,""
caption 103,""
caption 105,""
caption 107,""
file_load 114,Doss_Img$+"\defaut.bmp"
return
' ------------------------------------------------------------------------------
Tirage:
if count(303)>0
Animal%=int(rnd(count(303)))+1
end_if
gosub Verif_Tirage
return
' ------------------------------------------------------------------------------
Verif_Tirage:
for i%=1 to 10
if Num_memo%(i%)=0
Num_memo%(i%)=Animal%
Ligne$=item_read$(303,Animal%)
T%=T%+1
gosub Init_Animal
exit_for
else
if Num_memo%(i%)=Animal%
gosub Tirage
exit_for
else
if i%=10 and Num_memo%(i%)>0
gosub Arreter
end_if
end_if
end_if
next i%
return
' ------------------------------------------------------------------------------
Liste_Reponses:
trace_on Dossier$+"\test.txt"
clear 307:clear 308
R$=""
for x%=1 to count(303)
R$=item_read$(303,x%)
sep%=instr(R$,"|")
item_add 307,right$(R$,len(R$)-sep%)
item_add 308,right$(R$,len(R$)-sep%)
next x%
item_delete 307,Animal%
item_delete 308,Animal%
gosub Elim_1
file_save 308,Dossier$+"\test2.txt"
trace_off
return
' ------------------------------------------------------------------------------
Elim_1:
for x%=1 to count(307)
Z$=Trim$(item_read$(307,x%))
gosub Elim_2
next x%
return
' ------------------------------------------------------------------------------
Elim_2:
Z%=0
Nbre_Z%=0
cas%=0
repeat
Z%=Z%+1
if Z$=item_read$(308,Z%) then Nbre_Z%=Nbre_Z%+1
if Nbre_Z%>2
item_delete 308,Z%
cas%=1
exit_repeat
end_if
if Z%>count(308)
cas%=2
exit_repeat
end_if
until Z%=count(308)
if cas%=1 then gosub Elim_1
return
' ------------------------------------------------------------------------------
Reponse:
for x%=1 to 4:P%(x%)=0:next x%
repeat
gosub Tirage_Rep
until P%(4)<>0
for x%=1 to 4 :P$(x%)=item_read$(308,P%(x%)):item_add 113,P$(x%):next x%
item_add 113,Animal$(8)
return
' ------------------------------------------------------------------------------
Tirage_Rep:
if count(308)>0
Propo%=int(rnd(count(308)))+1
end_if
gosub Verif_Rep
return
' ------------------------------------------------------------------------------
verif_rep:
for x%=1 to 4
if P%(x%)=0
P%(x%)=Propo%
exit_for
else
if P%(x%)=Propo%
gosub Tirage
exit_for
else
if x%=4 and P%(x%)>0
exit_for
end_if
end_if
end_if
next x%
return
' ------------------------------------------------------------------------------
Init_Animal:
sep%=instr(Ligne$,";")
Animal$(1)=Left$(Ligne$,sep%-1)
caption 101,Animal$(1)
Ligne$=right$(Ligne$,len(Ligne$)-sep%)
sep%=instr(Ligne$,";")
Animal$(2)=Left$(Ligne$,sep%-1)
if val(Animal$(2))=1
caption 102,Titre$(9)
else
caption 102,Titre$(8)
end_if
Ligne$=right$(Ligne$,len(Ligne$)-sep%)
sep%=instr(Ligne$,";")
Animal$(3)=Left$(Ligne$,sep%-1)
caption 103,Animal$(3)
Ligne$=right$(Ligne$,len(Ligne$)-sep%)
sep%=instr(Ligne$,";")
Animal$(4)=Left$(Ligne$,sep%-1)
caption 105,Animal$(4)
Ligne$=right$(Ligne$,len(Ligne$)-sep%)
sep%=instr(Ligne$,";")
Animal$(5)=Left$(Ligne$,sep%-1)
caption 107,Animal$(5)
Ligne$=right$(Ligne$,len(Ligne$)-sep%)
sep%=instr(Ligne$,";")
Animal$(6)=Left$(Ligne$,sep%-1)
if Animal$(6)<>""
file_load 114,Doss_Img$+"\"+Animal$(6)
else
file_load 114,Doss_Img$+"\defaut.bmp"
end_if
Ligne$=right$(Ligne$,len(Ligne$)-sep%)
sep%=instr(Ligne$,"|")
Animal$(7)=Left$(Ligne$,sep%-1)
Animal$(8)=right$(Ligne$,len(Ligne$)-sep%)
caption 109,""
if Animal$(7)=""
inactive 110
else
active 110
end_if
return
' ------------------------------------------------------------------------------
Arreter:
active 4:active 6:active 9
if B_Rep% >5 and B_rep% < 10
Message Titre$(21)+chr$(13)+Titre$(22)+" "+str$(B_Rep%)+" / 10"
else
if B_Rep% <5
Message Titre$(23)+chr$(13)+Titre$(22)+" "+str$(B_Rep%)+" / 10"
else
Message Titre$(24)+chr$(13)+Titre$(22)+" "+str$(B_Rep%)+" / 10"
end_if
end_if
item_add 306,Date$+";"+J$+";"+str$(B_Rep%)
file_save 306,Dossier$+"\Score.Bdd"
show 20:hide 100
gosub Init_Jeu
return
' ------------------------------------------------------------------------------
Choix:
Rep$=item_index$(113)
return
' ------------------------------------------------------------------------------
Enrgt_Choix:
if Rep$=Animal$(8)
B_Rep%=B_Rep%+1
caption 109,Titre$(25):font_color 109,2,173,65:font_size 109,10
else
caption 109,Titre$(26)+Animal$(8):font_color 109,179,4,7:font_size 109,10
end_if
inactive 111
return
' ------------------------------------------------------------------------------
Suivant:
gosub Tirage
clear 113
gosub Liste_Reponses
gosub Reponse
active 111
return
' ------------------------------------------------------------------------------
Ecouter:
if Animal$(7)<>""
file_load 115,Doss_Son$+"\"+Animal$(7)
play 115
end_if
return
' ------------------------------------------------------------------------------
Lien:
execute "http://panoramic-language.pagesperso-orange.fr/French/index.html"
return
' ------------------------------------------------------------------------------
Score:
for x%=0 to 320
W%=W%+1
width 0,W%
next x%
for x%=0 to 320 step 2
G%=G%-1
left 0,G%
next x%
grid 701:top 701,10:left 701,485:height 701,250:width 701,287:grid_column 701,3:grid_row 701,2
grid_row_height 701,20:grid_one_column_width 701,2,134
grid_write 701,1,1,"Date":grid_write 701,1,2,"Joueur":grid_write 701,1,3,"Score"
button 707:top 707,265:left 707,697:caption 707,Titre$(7):on_click 707,Ferm_Score
gosub Remp_Grid
return
' ------------------------------------------------------------------------------
Remp_Grid:
if count(306)>0
grid_row 701,count(306)+1
for x%=1 to count(306)
res$=item_read$(306,x%)
sep%=instr(res$,";")
grid_write 701,x%+1,1,left$(res$,sep%-1)
res$=right$(res$,len(res$)-sep%)
sep%=instr(res$,";")
grid_write 701,x%+1,2,left$(res$,sep%-1)
grid_write 701,x%+1,3,right$(res$,len(res$)-sep%)
next x%
end_if
return
' ------------------------------------------------------------------------------
Ferm_Score:
delete 701
delete 707
for x%=0 to 320
W%=W%-1
width 0,W%
next x%
for x%=0 to 320 step 2
G%=G%+1
left 0,G%
next x%
active 2:active 3:active 4:active 9
return
' ------------------------------------------------------------------------------
Aide:
DLL_ON Dossier$+"\Utils.dll"
result%=DLL_CALL1("Execute",ADR(batch$))
DLL_OFF
return
' ------------------------------------------------------------------------------

' ------------------------------------------------------------------------------
Quitter:
Terminate