nouveau pour des concours

dim Height_Form%
dim Width_Form%
dim Height_F%:Height_F%=Height(0)
dim Width_F%:Width_F%=width(0)

dim Height_grid%
dim width_grid%

dim x,y,col,ran,key%,click,line,tot,res%
dim texte$,fichier$,res$,res1$,tot$

label ronde,change,saisie,key,ouvrir,ouvrir1,Annuler,Quitte
label sauvegarde,Dclick,sauver,sauvers,Aide,Imprime,recalc

caption 0,"TourD V 1.0"
left 0,(screen_x-640)/2:top 0,(screen_y-480)/2
color 0,0,154,154
on_close 0,quitte

dll_on "kgf.dll"

alpha 1
   left 1,15

container 10
   left 10,180:width 10,210
alpha 11
   top 11,20:left 11,15
   parent 11,10
   font_name 11,"arial"
   font_size 11,8
   caption 11,"     © Paulet Pascal 2015"+chr$(10)+chr$(10)+"Permet de gérer les points des joueurs"+chr$(10)+"lors d'un tournoi au jeu de dame"

grid 20
   top 20,35
   width 20,width(0)-17
   height 20,height(0)-105
   grid_column_width 20,33
   grid_row_height 20,17
   grid_one_column_width 20,1,100
   grid_fixed_color 20,200,200,200
   hide 20
   on_click 20,saisie
dim Height_g%:Height_g%=Height(20)
dim width_g%:width_g%=width(20)
  
edit 5
   width 5,33:height 5,17
   hide 5
   on_key_down 5,key

button 30
   top 30,5
   left 30,5
   caption 30,"Nouveau"
   on_click 30,ronde

button 31
   top 31,5
   left 31,85
   caption 31,"Ouvrir"
   on_click 31,Ouvrir

button 32
   top 32,5
   left 32,165
   caption 32,"Sauvegarde"
   on_click 32,Sauvegarde
   inactive 32
button 33
   top 33,5
   left 33,245
   caption 33,"Imprime"
   on_click 33,Imprime
   inactive 33
button 34
   top 34,5
   left 34,325
   caption 34,"Annuler"
   on_click 34,Annuler
   inactive 34
button 35
   top 35,5
   left 35,405
   caption 35,"Aide"
   on_click 35,Aide

button 36
   top 36,5
   left 36,485
   caption 36,"Quitte"
   on_click 36,Quitte

panel 40
   top 40,28:left 40,166
   width 40,73:height 40,49
   hide 40

button 41
   top 41,24:left 41,-1
   caption 41,"Sauver_sous"
   parent 41,40
   on_click 41,sauvers

button 42
   left 42,-1
   caption 42,"Sauver"
   parent 42,40
   on_click 42,sauver

dlist 50

' Traitement des fichiers
open_dialog 60
   filter 60,"Tournoi|*.tou*"
   dir_dialog 60,"C:\Tournoi"
save_dialog 61
   filter 61,"Tournoi|*.tou*"
   dir_dialog 61,"C:\Tournoi"

timer 100:on_timer 100,change:timer_interval 100,1

application_title "TourD Erreur"

end
' """""""""nouveau Jeu"""""""""""""""""
ronde:
timer_off 100
hide 40 :' panel40
caption 1,""
   inactive 32
   inactive 33
   inactive 34

if grid_read$(20,2,1)<>""
   grid_clear 20,y,tot
   hide 20
   wait 500
   if active(5)=20 then hide 5
end_if
' donne un nouveau nom au projet
if message_input("Nom & Date","donner le nom du tournoi et la Date","")=1
   caption 1,message_text$
else
   show 10
timer_on 100
   return
end_if

' Edition par défaut
grid_write 20,1,1,"   Nom de joueur"
if message_input("nombre de joueur(s)","Uniquement quatre joueurs","?")=1
' if numeric(message_text$)=2 then goto ronde
   y=val(message_text$)+1
   x=y
   grid_column 20,y:grid_row 20,x
   grid_column_insert 20,x+1
   grid_write 20,1,x+1,"TOT"
   tot=x+1
   ran=y
   col=x
   show 20

' edition des noms des joeurs
for y=2 to x
   if message_input("nom du joeur "+str$(y-1),"Indiquer son nom","?")=1
   grid_write 20,y,1,string$(5," ")+str$(y-1)+"  "+message_text$
   grid_write 20,1,y,str$(y-1)+string$(1," ")+left$(message_text$,2)
   grid_write 20,y,y,"X"
   grid_write 20,y,tot,"0"
   else
timer_on 100
   return
   end_if
next y
end_if
set_focus 20
timer_on 100
return

' """""""""""edition des points obtenus"""""""""""
saisie:
timer_off 100

hide 40 :' panel40
   texte$=""
   y=grid_y_to_row(20,mouse_y_position(20))
   x=grid_x_to_column(20,mouse_x_position(20))

if x=y or x=tot or numeric(grid_read$(20,y,x))=1
   message "Manoeuvre INTERDIT!"
   hide 5
timer_on 100
   return
end_if
   left 5,35+(34*x): top 5,19+(18*y)
   show 5: set_focus 5
timer_on 100
return

' """"""""simulation du grid en édition""""""""""
key:
timer_off 100
   key%=key_down_code
if key%=13
   grid_write 20,y,x,text$(5)
   texte$=text$(5)
   text 5,""
   hide 5
   if texte$="2" then grid_write 20,x,y,"0"
   if texte$="1" then grid_write 20,x,y,"1"
   if texte$="0" then grid_write 20,x,y,"2"

    res$=grid_read$(20,y,tot)
    tot$=str$(val(res$)+val(texte$))
    grid_write 20,y,tot,tot$

    res$=grid_read$(20,x,y)
    res1$=grid_read$(20,x,tot)
    tot$=str$(val(res$)+val(res1$))
    grid_write 20,x,tot,tot$
   active 32
   active 33
   active 34
end_if
timer_on 100
return

' """""""""Anulation de la derniere saisie"""""""""""
Annuler:
timer_off 100
    res$=""
    res1$=""
    tot$=""
hide 40 :' panel40
    res1$=grid_read$(20,x,tot)
    res$=grid_read$(20,x,y)
    tot$=str$(val(res1$)-val(res$))
    grid_write 20,x,tot,tot$
grid_write 20,x,y,""
    res$=grid_read$(20,y,x)
    res1$=grid_read$(20,y,tot)
    tot$=str$(val(res1$)-val(res$))
    grid_write 20,y,tot,tot$
grid_write 20,y,x,""
off_click 34
timer_on 100
return

' """"""""Traitement des fichiers"""""""""""
ouvrir:
timer_off 100
hide 40 :' panel40
if click=41 or click=42 or click=31 or inactive(20)=1 then goto ouvrir1
if grid_read$(20,2,1)<>""
   if message_error_yes_no("Le projet vas être perdu ?")=2 then return
   grid_clear 20,ran,tot
   hide 20
   if active(5)=1 then hide 5
end_if

ouvrir1:
   wait 500
   click=0
   hide 20
   caption 1,""
fichier$=file_name$(60)
   if fichier$<>"_"
      file_load 50,fichier$: line=count(50)
      y=val(item_read$(50,1)): tot=val(item_read$(50,2))
      caption 1,item_read$(50,line)
      x=tot
      grid_column 20,x
      grid_row 20,y
   inactive 32
   active 33
   inactive 34
      show 20: hide 10
      grid_load 20,fichier$
      else
timer_on 100
      return
   end_if
click=31
timer_on 100
return

sauvegarde:
timer_off 100
   show 40 :' panel40
   on_click 32,Dclick
timer_on 100
return
Dclick:
timer_off 100
   hide 40:' panel40
   on_click 32,sauvegarde
timer_on 100
return

sauver:
timer_off 100
   hide 40 :' panel40
   click=15
if ran=0
   on_click 32,sauvegarde
   message "Manoeuvre INTERDIT!"+chr$(10)+"Aucun Projet est présent"
timer_on 100
   return
end_if
   fichier$=caption$(1)+".tou"
   grid_save 20,ran,tot,fichier$
   file_load 50,fichier$
   item_add 50,caption$(1)
   file_save 50,fichier$

timer_on 100
return

sauvers:
timer_off 100
   hide 40:' panel40
   click=14
if ran=0
   on_click 32,sauvegarde
   message "Manoeuvre INTERDIT!"+chr$(10)+"Aucun Projet est présent"
timer_on 100
   return
end_if
   fichier$=""
   fichier$=file_name$(61)+".tou"
   grid_save 20,ran,tot,fichier$
   file_load 50,fichier$
   item_add 50,caption$(8)
   file_save 50,fichier$

timer_on 100
return

Imprime:
timer_off 100
   hide 40:' panel40
if active(20)=0
   message "Manoeuvre INTERDIT!"+chr$(10)+"Aucun Projet est présent"
timer_on 100
   return
end_if
   fichier$=caption$(1)+".tmp"
   file_open_write 1,fichier$
   file_writeln 1,caption$(1)+" "+date$
   file_writeln 1,""
   file_writeln 1," TOTAL"
   y=tot-1
   x=y
   col=tot
 for ran=2 to y
if grid_read$(20,ran,col)<>"_"
   texte$=grid_read$(20,ran,1)+" = "+grid_read$(20,ran,col)
   file_writeln 1,texte$
end_if
   texte$=""
 next ran
   file_writeln 1,""
 for ran=2 to y
 for col=ran to x
if grid_read$(20,ran,col)="X" then goto recalc
if grid_read$(20,ran,col)="" then goto recalc
   texte$=grid_read$(20,ran,1)+" = "+grid_read$(20,ran,col)+string$(2,chr$(9))+grid_read$(20,col,1)+" = "+grid_read$(20,col,ran)
   file_writeln 1,texte$
recalc:
   texte$=""
 next col
 next ran
 file_close 1
execute_wait "wordpad.exe "+fichier$
if handle_form(fichier$+" - WordPad")=0 then file_delete fichier$
timer_on 100
return

Aide:
timer_off 100
   hide 40 :' panel40
   application_title "TourD V1 Aide"
   message "Acculumation des points obtenu"+chr$(10)+"   2=Partie gagné"+chr$(10)+"   1=égalité où partie nul"+chr$(10)+"   0=Partie perdu"
   application_title "TourD Erreur"
timer_on 100
return

' """""""""Dimention temps réel"""""""""""""""""
change:
timer_off 100
if clicked(0)=20 then hide 40 :' panel40
   Height_Form%=(Height(0))-Height_F%
   Width_Form%=(width(0))-Width_F%

   Height_grid%=Height_g%+Height_Form%
   width_grid%=width_g%+Width_Form%
   Height 20,Height_grid%
   width 20,width_grid%

   top 10,Height_Form%/2+170
   left 10,Width_Form%/2+180

   top 1,Height(0)-60

timer_on 100
return


Quitte:
timer_off 100
if click=20
   if message_information_yes_no("Votre projet vas être perdu!"+chr$(10)+"Vous voullez vraiment quitter?")=2
   timer_on 100
   return
   end_if
end_if
  res% = dll_call1("KillProcessByHandle",handle(0))
dll_off

if message_input("nombre de joueur(s)","Uniquement quatre joueurs","?")=1