P'tit cadeau pour Rmont

Sujet: P'tit cadeau pour Rmont Jeu 27 Sep 2012 - 4:19

Petit application pour faire la synthèse de 6 pronostics
Attention seulement 30 concurrents sont admis
donc chaque case doit être inférieure ou égale à 30
je n'ai pas mis de garde geek

mais comme les courses hippiques
en France ont un nombre limité de partants...

Code:: Dim D$,cpte%,NC%,NxC% ,x%,table%(6,10),Chx%(30),def%(30),N%,V$
V$="Vs 1.2"
Label Change,Change2,Clic

dlist 99 :dlist 98
P_Init()
P_F0("Synthèse Pronos Turf "+V$,620,350)
P_Objet0(6)

end

Sub P_Init()
D$=Dir_current$
If file_exists(D$+"\Pronostiqueurs.txt")=0
hide 0
P_Pronostiqueurs()
Else
file_load 99,D$+"\Pronostiqueurs.txt"
End_If
End_Sub

Sub P_Pronostiqueurs()
Dim_Local x%
if message_confirmation_yes_no("Le fichier 'Pronostiqueurs.txt' n'existe pas"+chr$(13)+"Voulez vous le créer ?")=1
file_open_write 1000,D$+"\Pronostiqueurs.txt"
for x%= 1 to 6
if message_input("Pronostiqueurs.txt","Nom du Pronostiqueur","")=1
file_writeln 1000,message_text$
end_if
next x%
file_close 1000
file_load 99,D$+"\Pronostiqueurs.txt"
show 0
else
message "Au Revoir..."
P_Close0()
End_if
End_Sub

Sub P_F0(Titre$,W%,H%)
Width 0,W% :Height 0,H% :Top 0,(Screen_y-H%)/2:Left 0,(Screen_x-W%)/2
Font_Name 0,"Times new roman":Font_Size 0,10:Caption 0,Titre$
End_Sub

Sub P_Objet0(a%)
Dim_Local x%,y%,z%,w% ,i%
y%=-20
For x%=cpte%+1 To cpte%+a%
y%=y%+40
Alpha x% :Top x%,y% :left x%,10:cpte%=x%:caption x%,"Pronostiqueur :"
next x%
y%=-20
For x%=cpte%+1 To cpte%+a%
y%=y%+40
Alpha x% :Top x%,y% :left x%,180:cpte%=x%:caption x%,"Sélection :"
next x%
y%=-2
For x%=cpte%+1 To cpte%+a%
y%=y%+40
Combo x% :Top x%,y% :left x%,10:cpte%=x% :On_change x%,Change2
If count(99)>0 :for i%=1 to count(99):item_add cpte%,item_read$(99,i%): Next i%:End_if
next x%
y%=-2
for x%=cpte%+1 To cpte%+a%
y%=y%+40 :w%=180
for z%=cpte%+1 to cpte%+10 :w%=w%+30:edit z% :top z%,y% :left z%,w% :width z%,20:On_change z%,change :cpte%=z%:next z%
next x%
cpte%=cpte%+1
Button cpte% :top cpte%,280:left cpte%,525:caption cpte%,"Synthèse":cursor_point cpte% :On_click cpte%,Clic
set_focus 13
End_Sub

Change:
NC%=Number_change
If len(text$(Number_change))=2
If (NC%>18 and NC%<28)or(NC%>28 and NC%<38)or(NC%>38 and NC%<48)or(NC%>48 and NC%<58)or(NC%>58 and NC%<68)or(NC%>68 and NC%<78)
set_focus Number_change+1
Else
N%=13
for NC%=28 to 68 step 10
N%=N%+1
if len(text$(NC%))=2 then Set_focus N%
next NC%
if NC%=78 and len(text$(NC%))=2
set_focus 79
end_if
end_if
end_if
Return

Change2:
NC%=Number_change
NxC%=19
if NC%=13 then set_focus NxC%
For x%=14 to 18
NxC%=NxC%+10
if NC%=x% then set_focus NxC%
next x%
Return

Clic:
P_RemplisTab()
P_Attribution()
P_Result()
return

Sub P_RemplisTab()
Dim_Local x%,y%,z%,w%
z%=18
For x%=1 to 6
For y% = 1 to 10
z% = z%+1
if text$(z%)<>""
w% = val(text$(z%))
Table%(x%,y%)=w%
end_if
Next y%
Next x%
End_Sub

Sub P_Attribution()
dim_local x%,y%,z%
for x%=1 to 6
for y%=1 to 10
Chx%(Table%(x%,y%))=Chx%(Table%(x%,y%))+11-y%
next y%
next x%
for x%=1 to 30 :item_add 98,Chx%(x%) :next x%
End_Sub

Sub P_Result()
Dim_Local x%,vs%,ii%,L$,z%,synth$
z%=1
while z%<count(98) or z%=count(98)
vs%=0: ii%=0
for x%=1 to count(98)
L$=item_read$(98,x%)
if val(L$)>vs%
vs%=val(L$)
ii%=x%
end_if
Next x%
if ii%>0
def%(z%)=ii%
item_delete 98,ii%
item_insert 98,ii%,"0"
end_if
z%=z%+1
end_while
synth$=str$(def%(1))+"-"+str$(def%(2))+"-"+str$(def%(3))+"-"+str$(def%(4))+"-"+str$(def%(5))+"-"+str$(def%(6))+"-"+str$(def%(7))+"-"+str$(def%(8))+"-"+str$(def%(9))+"-"+str$(def%(10))
message "Synthèse :"+synth$
P_Sauvegarde(synth$)
End_sub

Sub P_Sauvegarde(synth$)
dim_local Day$,Course$
Day$=date$
if Message_information_yes_no("Voulez vous sauvegarder cette synthèse ?")=1
if message_input("Course","Nom de la course :","")=1 then Course$=message_text$
file_open_write 1000,D$+"\Sauvegarde.txt"
file_writeln 1000,date$+" - "+Course$
file_writeln 1000,synth$
file_close 1000
P_Close()
else
P_Close0()
end_if
End_Sub

Sub P_Close0()
Terminate
End_Sub

Bon, une remonté de bretelles, un prog, maintenant P'tit cadeau pour Rmont Sommeil-reve-2942

Sujet: Re: P'tit cadeau pour Rmont Jeu 27 Sep 2012 - 7:36

Hé bé, pour quelqu'un qui avait peur des SUB()... Very Happy

Bravo, A+

Sujet: Re: P'tit cadeau pour Rmont Jeu 27 Sep 2012 - 7:39

Bon bien, mais maintenant tu dessines avec des chevaux en 3D la courses pour voir si on gagne ? Very Happy

Sujet: re Jeu 27 Sep 2012 - 12:21

ha mais... si on m'explique longtemps,je comprends vite Laughing

heu ...pour la 3d faudra attendre un p'tit peu... Wink

Sujet: Re: P'tit cadeau pour Rmont Jeu 27 Sep 2012 - 13:05

Mais combien de temps doit durer le longtemps pour que tu comprennes aussi vite ? P'tit cadeau pour Rmont Galop2

Sujet: Re: P'tit cadeau pour Rmont Jeu 27 Sep 2012 - 13:10

Bon alors tu peux le faire en 2D si tu veux, mais bon c'était une boutade comme tu l'avais compris Wink

Sujet: re Jeu 27 Sep 2012 - 13:17

@ Papydall,

Ben, il m' a bien fallu une semaine de lecture de post
et un bon tuto signé de ta main ... Laughing

@Jicehel,

Pour faire une course en 3D je n'ai pas trouvé de chevaux en 3ds très convaincant
au niveau du graphisme. le 3/4 des chevaux que j'ai vu ressemblent à des dinosaures
difformes. Suspect

Sujet: Re: P'tit cadeau pour Rmont Jeu 27 Sep 2012 - 14:01

Salut ygeronimi
La procédure SUB P_Attribution() :
Cette interminable série de IF… ELSE imbriquées, moi je n’aurais pas le courage de m’y aventurer :

Code:: Sub P_Attribution()
dim_local x%,y%,z%
for x%=1 to 6
for y%=1 to 10
if y%=1
Chx%(Table%(x%,y%))=Chx%(Table%(x%,y%))+10
else
if y%=2
Chx%(Table%(x%,y%))=Chx%(Table%(x%,y%))+9
else
if y%=3
Chx%(Table%(x%,y%))=Chx%(Table%(x%,y%))+8
else
if y%=4
Chx%(Table%(x%,y%))=Chx%(Table%(x%,y%))+7
else
if y%=5
Chx%(Table%(x%,y%))=Chx%(Table%(x%,y%))+6
else
if y%=6
Chx%(Table%(x%,y%))=Chx%(Table%(x%,y%))+5
else
if y%=7
Chx%(Table%(x%,y%))=Chx%(Table%(x%,y%))+4
else
if y%=8
Chx%(Table%(x%,y%))=Chx%(Table%(x%,y%))+3
else
if y%=9
Chx%(Table%(x%,y%))=Chx%(Table%(x%,y%))+2
else
if y%=10
Chx%(Table%(x%,y%))=Chx%(Table%(x%,y%))+1
end_if
end_if
end_if
end_if
end_if
end_if
end_if
end_if
end_if
end_if
next y%
next x%
for x%=1 to 30 :item_add 98,Chx%(x%) :next x%
End_Sub

Voila, comment je l’aurais écrite :

Code:: Sub P_Attribution()
dim_local x%,y%,z%
for x%=1 to 6
for y%=1 to 10
Chx%(Table%(x%,y%))=Chx%(Table%(x%,y%))+11-y%
next y%
next x%
for x%=1 to 30 :item_add 98,Chx%(x%) :next x%
End_Sub

Ça doit marcher, essaye-la Laughing

Mais peut-être que tu es adepte du «pourquoi faire simple quand on peut faire compliqué»
P'tit cadeau pour Rmont A_hit

Sujet: Re: P'tit cadeau pour Rmont Jeu 27 Sep 2012 - 14:25

Juste pour terminer le sujet ygeronimi, Bignono nous a fait de jolis chevaux en 3D disponible sur son Webdav

Sujet: re Jeu 27 Sep 2012 - 14:29

@ Papydall,

J' ai surtout fait comme cela me venait à l'esprit... Laughing

Je suis certain que certains passages peuvent être raccourci
mais là ...j'ai pas le temps . En France, la rentrée scolaire commence en
Septembre et finie en Juin... Laughing

Je vais avoir droit à la salle d'attente d' un toubib pour les certificats d'aptitude
sportive, sachant pertinemment que d'ici 15 jours ce sera pour une exemption... Laughing

@ Jicehel,

Pour le trait, je veux bien mais ils sont un peu épais pour des pur-sangs... P'tit cadeau pour Rmont Rire-20060614

Sujet: re Jeu 27 Sep 2012 - 14:41

@ Papydall,

çà a l'air de fonctionner... Laughing

je verrai plus en détails ce soir.

Sujet: Re: P'tit cadeau pour Rmont Jeu 27 Sep 2012 - 18:18

Ça doit fonctionner puisque c’est moi qui l’ai codée P'tit cadeau pour Rmont 0021

Sujet: Re: P'tit cadeau pour Rmont Jeu 27 Sep 2012 - 19:07

bonjour a tous.
meci ygeronimi ; papydal ; nardo26 ; jean-claude et tout ceux qui on pris de leur temps pour me répondre.
mais j'ai un conflit entre les deux dernieres versions 23 et 24i presentes sur mon ecran
pour l'instant je ne peux essayer les prg evec les sub et dim_local.
je vais de nouveau retecharger la derniere version
encore merci

Sujet: re Jeu 27 Sep 2012 - 19:52

@ Rmont,

Je t' ai mis l'executable sur mon webdav dans le dossier Panoramic
et les sources 1.0 et 1.1 dans le dossier "Panoramic\Panoramic 2"

http://www.mydrive.ch/
panoramic@ygeronimi
panoramic123

@ Papydall,

P'tit cadeau pour Rmont Cartonne

Je pense à une version 2.0... Laughing

Edit :
J'ai oublié une précision pour profiter du passage de focus automatique
les numéros 1 à 9 doivent être rentré avec 0 devant :01,02,03,04,05,06,07,08,09

Sujet: re Jeu 27 Sep 2012 - 22:32

La fonction "Change" qui change... Laughing

Code:: Change:
NC%=Number_change
If len(text$(Number_change))=2
If (NC%>18 and NC%<28)or(NC%>28 and NC%<38)or(NC%>38 and NC%<48)or(NC%>48 and NC%<58)or(NC%>58 and NC%<68)or(NC%>68 and NC%<78)
set_focus Number_change+1
Else
N%=13
for NC%=28 to 68 step 10
N%=N%+1
if len(text$(NC%))=2 then Set_focus N%
next NC%
if NC%=78 and len(text$(NC%))=2
set_focus 79
end_if
end_if
end_if
Return

...C'est plus court ! non ? Laughing

Sujet: Re: P'tit cadeau pour Rmont Ven 28 Sep 2012 - 1:52

Donc si je comprend bien ta ligne IF hyper longue :
tu acceptes tous les nombres compris entre 19 et 77 sauf 28,38,48,58 et 68... c'est ça ?
il y a certainement un moyen de coder ça plus simplement...

Sujet: re Ven 28 Sep 2012 - 2:05

cela vient de la numérotation des objets ( combo et edit ) qui ne se suivent pas

le focus passent du combo 13 à l'edit 19 puis jusqu'à l'edit 28 qui lui renvoi vers le combo 14

tu me suis ?... Laughing

les edit sont créés comme un tableau ( plus facile pour la suite pour la récup des entrées et la distribution des points).
si tu simplifies d'un côté, tu compliques de l'autre et tant que l'on ne peit pas écrire directement dans un grid.... Wink

Sujet: Re: P'tit cadeau pour Rmont Ven 28 Sep 2012 - 7:55

Bonjour ygeronimi,
oui j'avais bien compris, mais je te parle uniquement de ton IF à rallonge....

Sujet: re Ven 28 Sep 2012 - 11:59

@ Nardo26,

Pour que nous parlions du même source, je le remet ici :

Code:: Dim D$,cpte%,NC%,NxC% ,x%,table%(6,10),Chx%(30),def%(30),N%,V$
V$="Vs 1.2"
Label Change,Change2,Clic

dlist 99 :dlist 98
P_Init()
P_F0("Synthèse Pronos Turf "+V$,620,350)
P_Objet0(6)
end

Sub P_Init()
D$=Dir_current$
If file_exists(D$+"\Pronostiqueurs.txt")=0
hide 0
P_Pronostiqueurs()
Else
file_load 99,D$+"\Pronostiqueurs.txt"
End_If
End_Sub

Sub P_Pronostiqueurs()
Dim_Local x%
if message_confirmation_yes_no("Le fichier 'Pronostiqueurs.txt' n'existe pas"+chr$(13)+"Voulez vous le créer ?")=1
file_open_write 1000,D$+"\Pronostiqueurs.txt"
for x%= 1 to 6
if message_input("Pronostiqueurs.txt","Nom du Pronostiqueur","")=1
file_writeln 1000,message_text$
end_if
next x%
file_close 1000
file_load 99,D$+"\Pronostiqueurs.txt"
show 0
else
message "Au Revoir..."
P_Close0()
End_if
End_Sub

Sub P_F0(Titre$,W%,H%)
Width 0,W% :Height 0,H% :Top 0,(Screen_y-H%)/2:Left 0,(Screen_x-W%)/2
Font_Name 0,"Times new roman":Font_Size 0,10:Caption 0,Titre$
End_Sub

Sub P_Objet0(a%)
Dim_Local x%,y%,z%,w% ,i%
y%=-20
For x%=cpte%+1 To cpte%+a%
y%=y%+40
Alpha x% :Top x%,y% :left x%,10:cpte%=x%:caption x%,"Pronostiqueur :"
next x%
y%=-20
For x%=cpte%+1 To cpte%+a%
y%=y%+40
Alpha x% :Top x%,y% :left x%,180:cpte%=x%:caption x%,"Sélection :"
next x%
y%=-2
For x%=cpte%+1 To cpte%+a%
y%=y%+40
Combo x% :Top x%,y% :left x%,10:cpte%=x% :On_change x%,Change2
If count(99)>0 :for i%=1 to count(99):item_add cpte%,item_read$(99,i%): Next i%:End_if
next x%
y%=-2
for x%=cpte%+1 To cpte%+a%
y%=y%+40 :w%=180
for z%=cpte%+1 to cpte%+10 :w%=w%+30:edit z% :top z%,y% :left z%,w% :width z%,20:On_change z%,change :cpte%=z%:next z%
next x%
cpte%=cpte%+1
Button cpte% :top cpte%,280:left cpte%,525:caption cpte%,"Synthèse":cursor_point cpte% :On_click cpte%,Clic
set_focus 13
End_Sub

Change:
NC%=Number_change
If len(text$(Number_change))=2
If (NC%>18 and NC%<78) and (NC%<>28 and NC%<>38 and NC%<>48 and NC%<>58 and NC%<>68)
set_focus Number_change+1
Else
N%=13
for NC%=28 to 68 step 10
N%=N%+1
if len(text$(NC%))=2 then Set_focus N%
next NC%
if NC%=78 and len(text$(NC%))=2
set_focus 79
end_if
end_if
end_if
Return

Change2:
NC%=Number_change
NxC%=19
if NC%=13 then set_focus NxC%
For x%=14 to 18
NxC%=NxC%+10
if NC%=x% then set_focus NxC%
next x%
Return

Clic:
P_RemplisTab()
P_Attribution()
P_Result()
return

Sub P_RemplisTab()
Dim_Local x%,y%,z%,w%
z%=18
For x%=1 to 6
For y% = 1 to 10
z% = z%+1
if text$(z%)<>""
w% = val(text$(z%))
Table%(x%,y%)=w%
end_if
Next y%
Next x%
End_Sub

Sub P_Attribution()
dim_local x%,y%,z%
for x%=1 to 6
for y%=1 to 10
Chx%(Table%(x%,y%))=Chx%(Table%(x%,y%))+11-y%
next y%
next x%
for x%=1 to 30 :item_add 98,Chx%(x%) :next x%
End_Sub

Sub P_Result()
Dim_Local x%,vs%,ii%,L$,z%,synth$
z%=1
while z%<count(98) or z%=count(98)
vs%=0: ii%=0
for x%=1 to count(98)
L$=item_read$(98,x%)
if val(L$)>vs%
vs%=val(L$)
ii%=x%
end_if
Next x%
if ii%>0
def%(z%)=ii%
item_delete 98,ii%
item_insert 98,ii%,"0"
end_if
z%=z%+1
end_while
for x%= 1 to 10:synth$=synth$+chr$(32)+str$(def%(x%))+chr$(32):next x%
message "Synthèse : "+trim$(synth$)
P_Sauvegarde(synth$)
End_sub

Sub P_Sauvegarde(synth$)
dim_local Day$,Course$
Day$=date$
if Message_information_yes_no("Voulez vous sauvegarder cette synthèse ?")=1
if message_input("Course","Nom de la course :","")=1 then Course$=message_text$
P_Ecriture(Synth$,Course$)
P_Close0()
else
P_Close0()
end_if
End_Sub

Sub P_Ecriture(Synth$,Course$)
file_open_write 1000,D$+"\Sauvegarde.txt"
file_writeln 1000,date$+" - "+Course$
file_writeln 1000,trim$(synth$)
file_close 1000
End_Sub

Sub P_Close0()
Terminate
End_Sub

Si tu parles de la ligne 75, on parle de la même ligne et là je ne vois pas comment ...

Version 1.1 intégration du raccourci de Papydall sur la procédure "Attribution"
Version 1.2 intégration du raccourci de "Moi même" sur la procédure "Change"

La version 1.3 sera t elle celle de l'intégration d'un raccourci de Nardo26 ?... Laughing

version 1.3 intégration du raccourci de jicehel sur la procédure "Change" modif des lignes 149,150 et 169 ( raccourcis )

Sujet: Re: P'tit cadeau pour Rmont Ven 28 Sep 2012 - 13:08

ygeronimi a écrit:

@ Nardo26,
Pour que nous parlions du même source, je le remet ici :

Code:: Change:
...
If (NC%>18 and NC%<28)or(NC%>28 and NC%<38)or(NC%>38 and NC%<48)or(NC%>48 and NC%<58)or(NC%>58 and NC%<68)or(NC%>68 and NC%<78)
...
Return

Si tu parles de la ligne 75, on parle de la même ligne et là je ne vois pas comment ...

Je chipote mais je crois que je t'ai déjà donné une piste :

Nardo a écrit:: tu acceptes tous les nombres compris entre 19 et 77 sauf 28,38,48,58 et 68... c'est ça ?

Allé, encore une...

Code:: .... (N%-(INT(NC%/10)*10))<>8 ...

ATTENTION avec une expression utilisant le AND -> on ne sort pas du test à la 1ere assertion fausse (il te faudra passer par un flag)...

Je crois que j'en ai trop dis...

Sujet: Re: P'tit cadeau pour Rmont Ven 28 Sep 2012 - 13:12

bon c'est un détail mais c'est vrai que si l'on veut on peut simplifier un peu le test:

Code:: If (NC%>18 and NC%<28)or(NC%>28 and NC%<38)or(NC%>38 and NC%<48)or(NC%>48 and NC%<58)or(NC%>58 and NC%<68)or(NC%>68 and NC%<78)

qui peut s'écrire aussi

Code:: If (NC%>18 and NC%<>28 and NC%<>38 and NC%<>48 and NC%<>58 and NC%<>68 and NC%<78)

ou encore

Code:: If (NC%>18 and NC%<78) and (NC%<>28 and NC%<>38 and NC%<>48 and NC%<>58 and NC%<>68)

Sujet: Re: P'tit cadeau pour Rmont Ven 28 Sep 2012 - 13:18

Jicehel a écrit:

Code:: If (NC%>18 and NC%<78) and (NC%<>28 and NC%<>38 and NC%<>48 and NC%<>58 and NC%<>68)

Je crois que cela correspond exactement à ma phrase... Wink

Tu aurais pu laisser ygeronimi chercher un peu... Wink

Cela me fait penser à l'époque où je faisais des tableaux de karnaugh

Sujet: re Ven 28 Sep 2012 - 13:45

@ Nardo26,

j'ai essayé çà :

Code:: if NC%>18 and NC%<78 and (NC% -(int(NC%/10)*10))<>8

mais çà plante : "Not correct logical expression" scratch

Edit :

la dernière ligne que tu as prise en citation de Jicehel fonctionne.

Sujet: re Ven 28 Sep 2012 - 13:55

@ Nardo26 et Jicehel,

Merci à tous les deux ! mais je crois que c'est la solution Jicehel qui prend l'avantage.

Je prends cette dernière le temps de comprendre pourquoi
j'ai une erreur avec celle que j'ai mise et de corriger
le pourquoi du comment.

raccourci des lignes 149, 150 et 169

Sujet: Re: P'tit cadeau pour Rmont Ven 28 Sep 2012 - 14:40

Disons que la dernière et facile à comprendre sur une simple lecture. Celle de Nardo est plus technique mais moins clair en lecture. Il faut un peu réfléchir pour la comprendre.

» Pour RMont
» Mon cadeau de noël pour vous tous!
» PANORAMIC et informatique de gestion (les tableaux)
» Mon cadeau de Noël: une pendule à 1 euro
» Jeu des ptit chvaux