Jeu Puzzle

' ******************************************************************************
dim Dossier$,Doss_Sprite$,Doss_Fond$,Doss_Langue$
dim Langue$,def$(100),jeu%
dim M%
dim N%,T%,L%,T1%,L1%
dim x%,x$,joueur$
dim img%,img$,Doss_img_select$,view$
dim mess%
dim Table%(4,4),R%,C%,a%,b%,z%,cpte%,i%,gagne%,G%,H%,VS$,sep%
dim heure%,minute%,secd%,Tps%,heure$,minute$,secd$,Chrono$,Donnee$
' ------------------------------------------------------------------------------
label Init,Init_Dossier,Init_List,Init_Param,Init_Langue,Init_Bdd
label Change_Langue,New_Langue
label Menu,Jouer,Arreter,APp,Aide
label Select_Joueur,choix_joueur,Ajout_Joueur,Valid_Joueur
label Select_Img,Preview,Choix,Creation,Placement,Verif,Selection
label Action_G,Action_D,Action_H,Action_B
label Create_Solution,Verif_Solution,Chrono,Close_Jeu,Continu_Jeu
label Visu_Score,Remp_Grid,Quit_Score
label Quitter
' ******************************************************************************
caption 0,"Mon Puzzle":width 0,516:height 0,558:color 0,240,240,150
top 0,(screen_y-558)/2:left 0,(screen_x-516)/2
font_name 0,"Times new roman":font_size 0,10
main_menu 1
 sub_menu 2:parent 2,1:on_click 2,Menu:caption 2,"Jouer"
 sub_menu 3:parent 3,1:on_click 3,Menu:caption 3,"Langue"
 sub_menu 4:parent 4,1:on_click 4,Menu:caption 4,"A Propos"
 sub_menu 5:parent 5,1:on_click 5,Menu:caption 5,"Aide"
 sub_menu 801:parent 801,1:on_click 801,Visu_Score
 sub_menu 800:parent 800,1
 Chrono$="00 : 00 : 00"
 caption 800,Chrono$
 inactive 5
 button 802:top 802,470:left 802,420:cursor_point 802:on_click 802,Quitter
dlist 6 :' Liste des peramètres
dlist 7 :' Liste des langues dispo
dlist 8 :' Contenu de la langue choisie
dlist 9 :' Liste des Images
dlist 400 :' Solution
dlist 402 :' Liste des scores
timer 401:timer_off 401
gosub Init
end
' ******************************************************************************
Init:
  gosub Init_Dossier
  gosub Init_List
  gosub Init_Param
  gosub Init_Bdd
  gosub Create_Solution
return
' ------------------------------------------------------------------------------
Init_Dossier:
  Dossier$=Dir_Current$
  Doss_Sprite$=Dossier$+"\Sprites"
  Doss_Fond$=Dossier$+"\Fonds"
  Doss_Langue$=Dossier$+"\Langue"
return
' ------------------------------------------------------------------------------
Init_List:
  ' langues disponibles
  dir_change Doss_Langue$
  x$=file_find_first$
  if x$<>"_" then item_add 7,x$
  x$=file_find_next$
  while x$<>"_"
      if x$<>"_" then item_add 7,x$
      x$=file_find_next$
  end_while
  file_find_close
  ' liste des images
  dir_change Doss_Fond$
  x$=file_find_first$
  if x$<>"_" then item_add 9,x$
  x$=file_find_next$
  while x$<>"_"
      if x$<>"_" then item_add 9,x$
      x$=file_find_next$
  end_while
  file_find_close
return
' ------------------------------------------------------------------------------
Init_Param:
  if file_exists(Dossier$+"\Param.inf")=1
      file_load 6,Dossier$+"\Param.inf"
      gosub Init_Langue
  else
      gosub Change_Langue
  end_if
return
' ------------------------------------------------------------------------------
Init_Langue:
  clear 8
  if count(6)>0
      Langue$=Doss_Langue$+"\"+item_read$(6,1)+".txt"
      file_load 8,Langue$
      for x%=1 to count(8):def$(x%)=item_read$(8,x%):next x%
      for x%=2 to 5:caption x%,def$(x%-1):next x%
      caption 801,def$(9)
      caption 802,def$(19)
      if jeu%=1 then caption 2,def$(5)
  end_if
return
' ------------------------------------------------------------------------------
Change_Langue:
  if object_exists(100)=1
      show 100
  else
      form 100
      width 100,200:height 100,130:top 100,(screen_y-130)/2:left 100,(screen_x-200)/2
      caption 100,"Paramètres":font_name 100,"Times new roman":font_size 100,10
      command_target_is 100
      alpha 101:top 101,10:left 101,10:caption 101,"Langue :"
      combo 102:top 102,30:left 102,10
      for x%=1 to count(7):item_add 102,left$(item_read$(7,x%),len(item_read$(7,x%))-4):next x%
      on_change 102,New_Langue
  end_if
return
'-------------------------------------------------------------------------------
New_Langue:
  If count(6)>0 and Text$(102)<>""
      item_delete 6,1
      item_insert 6,1,Text$(102)
  else
      if Text$(102)<>"" then item_insert 6,1,Text$(102)
  end_if
  file_save 6,Dossier$+"\Param.inf"
  gosub Init_Langue
  hide 100
return
'-------------------------------------------------------------------------------
Init_Bdd:
  if file_exists(Dossier$+"\Score.Bdd")=1
      file_load 402,Dossier$+"\Score.Bdd"
  end_if
return
' ------------------------------------------------------------------------------
Menu:
  for x%=2 to 5
      if clicked(x%)=1 then M%=x%
  next x%
  select M%
  case 2
      jeu%=jeu%+1
      if jeu%=1
        caption 2,def$(5)
        gosub Jouer
      else
        jeu%=0
        caption 2,def$(1)
        gagne%=0
        gosub Arreter
      end_if
  case 3
      gosub Change_Langue
  case 4
      gosub APp
  case 5
      gosub Aide
  end_select
return
' ------------------------------------------------------------------------------
Jouer:
  gosub Select_Joueur
return
' ------------------------------------------------------------------------------
Select_Joueur:
  Joueur$="Joueur inconnu"
  if object_exists(500)=1
      show 500
  else
      form 500:width 500,360:height 500,205:top 500,(screen_y-205)/2:left 500,(screen_x-360)/2
      caption 500,def$(10):font_name 500,"Times new roman":font_size 500,10
      command_target_is 500
      list 501:height 501,160:sort_on 501
      if file_exists(Dossier$+"\Joueur.Bdd")=1 then file_load 501,Dossier$+"\Joueur.Bdd"
      cursor_point 501:hint 501,def$(11):on_click 501,choix_joueur
      edit 502:text 502,"":top 502,20:left 502,140
      button 503:top 503,20:left 503,265:width 503,20:height 503,20:caption 503,"..."
      cursor_point 503:on_click 503,Ajout_Joueur:hint 503,def$(12)
      button 504:top 504,140:left 504,265:caption 504,def$(8)
      cursor_point 504:on_click 504,Valid_Joueur
  end_if
return
' ------------------------------------------------------------------------------
Choix_Joueur:
  text 502,item_index$(501)
return
' ------------------------------------------------------------------------------
Ajout_Joueur:
  a%=0
  if text$(502)<>""
      for x%=1 to count(501)
        if text$(502)=item_read$(501,x%) then a%=a%+1
      next x%
  end_if
  if a%=0
      item_add 501,text$(502)
      file_save 501,Dossier$+"\Joueur.Bdd"
  end_if
return
' ------------------------------------------------------------------------------
Valid_Joueur:
 if text$(502)<>"" then  Joueur$=text$(502)
 hide 500
 gosub Select_img
return
' ------------------------------------------------------------------------------
Select_img:
  if object_exists(200)=1
      show 200
  else
      form 200:width 200,500:height 200,350:top 200,(screen_y-350)/2:left 200,(screen_x-500)/2
      caption 200,def$(6):font_name 200,"Times new roman":font_size 200,10
      command_target_is 200
      alpha 201:top 201,10:left 201,5:caption 201,def$(7)
      list 202 :top 202,30:left 202,5:width 202,170:height 202,230:cursor_point 202
      for x%=1 to count(9):item_add 202,item_read$(9,x%):next x%
      on_click 202,Preview
      picture 203:top 203,5:left 203,180:width 203,290:height 203,290:stretch_on 203
      button 204 :top 204,270:left 204,50:caption 204,def$(8):cursor_point 204
      inactive 204:on_click 204,Choix
  end_if
return
' ------------------------------------------------------------------------------
Preview:
  view$=Doss_Fond$+"\"+item_index$(202)
  file_load 203,view$
  active 204
return
' ------------------------------------------------------------------------------
Choix:
  img$=item_index$(202)
  Doss_img_select$=Doss_Sprite$+"\"+left$(img$,len(img$)-4)
  hide 200
  command_target_is 0
  inactive 802
  hide 802
  gosub Creation
return
' ------------------------------------------------------------------------------
Creation:
  for x%=1 to 24
      img%=10+x%
      picture img%
      width img%,100 :height img%,100:cursor_point img%
      stretch_on img% :file_load img%,Doss_img_select$+"\"+str$(img%)+".bmp"
      on_click img%,Selection
  next x%
  gosub Placement
  Tps%=0
  timer_on 401
  on_timer 401,Chrono
  active 5
return
' ------------------------------------------------------------------------------
Placement:
  Table%(4,4)=1
  for img%=11 to 34
      repeat
        R%=int(rnd(5))
        C%=int(rnd(5))
      until Table%(R%,C%)=0
      Table%(R%,C%)=img%
      left img%,R%*100
      top img%,C%*100
  next img%
  Table%(4,4)=0
return
' ------------------------------------------------------------------------------
Selection:
  for x%=1 to 24:off_click x%+10:next x%
  N%=number_click
  T%=Top(N%)
  L%=Left(N%)
  gosub Verif
  gosub Verif_Solution
return
' ------------------------------------------------------------------------------
Verif:
  T1%=T%/100
  L1%=L%/100
  ' pour se deplacer vers la gauche il faut au minimum etre dans la colonne 2
  if L1%>0
      if Table%(L1%-1,T1%)=0
        gosub Action_G
        Table%(L1%-1,T1%)=Table%(L1%,T1%)
        Table%(L1%,T1%)=0
      end_if
  end_if
  ' pour ce deplacer vers la droite il faut au maximum etre dans la colonne 4
  if L1%<4
      if Table%(L1%+1,T1%)=0
        gosub Action_D
        Table%(L1%+1,T1%)=Table%(L1%,T1%)
        Table%(L1%,T1%)=0
      end_if
  end_if
  ' pour ce deplacer vers le haut il faut etre au minimum sur la ligne 2
  if T1%>0
      if Table%(L1%,T1%-1)=0
        gosub Action_H
        Table%(L1%,T1%-1)=Table%(L1%,T1%)
        Table%(L1%,T1%)=0
      end_if
  end_if
  ' pour se deplacer vers le bas il faut au maximum etre sur la ligne 4
  if T1%<4
      if Table%(L1%,T1%+1)=0
        gosub Action_B
        Table%(L1%,T1%+1)=Table%(L1%,T1%)
        Table%(L1%,T1%)=0
      end_if
  end_if
  for x%=1 to 24:on_click x%+10,Selection :next x%
return
' ------------------------------------------------------------------------------
Action_G:
  if L%>=100
      for x%=L% to L%-100 step -5:top N%,T% :left N%,x% :wait 5 :next x%
  end_if
return
' ------------------------------------------------------------------------------
Action_D:
  if L%<400
      for x%=L% to L%+100 step 5:top N%,T% :left N%,x% :wait 5 :next x%
  end_if
return
' ------------------------------------------------------------------------------
Action_H:
  if T%>=100
      for x%=T% to T%-100 step -5:top N%,x% :left N%,L% :wait 5 :next x%
  end_if
return
' ------------------------------------------------------------------------------
Action_B:
  if T%<400
      for x%=T% to T%+100 step 5:top N%,x% :left N%,L% :wait 5 :next x%
  end_if
return
' ------------------------------------------------------------------------------
Arreter:
  Timer_off 401
  if gagne%=0
      if message_confirmation_yes_no("Etes vous sûr de vouloir abandonner ?")=1
        gosub Close_Jeu
      else
        gosub continu_Jeu
      end_if
  else
      if gagne%=1
        message "Bravo !!!"+chr$(13)+"Vous avez résolu le puzzle en :"+chr$(13)+Chrono$
        item_add 402,Date$+";"+Time$+";"+Joueur$+";"+view$+";"+Chrono$
        file_save 402,Dossier$+"\Score.Bdd"
        gosub Close_Jeu
      end_if
  end_if
return
' ------------------------------------------------------------------------------
Close_Jeu:
  for img%=11 to 34 : delete img% : next img%
  for R%=0 to 4: for C%=0 to 4 : Table%(R%,C%)=0 : next C%: next R%
  Tps%=0
  Chrono$="00 : 00 : 00"
  caption 800,Chrono$
  show 802
  active 802
return
' ------------------------------------------------------------------------------
Continu_Jeu:
  jeu%=1
  caption 2,def$(5)
  Timer_on 401
return
' ------------------------------------------------------------------------------
APp:
return
' ------------------------------------------------------------------------------
Aide:
  if object_exists(300)=1
      show 300
  else
      form 300:height 300,328:width 300,306:caption 300,def$(4)
      top 300,top(0):left 300,left(0)+520
      command_target_is 300
      picture 301:height 301,290:width 301,290:file_load 301,view$
  end_if
  pause 5000
  hide 300
return
' ------------------------------------------------------------------------------
Create_Solution:
  H%=-100
  repeat
      G%=-100
      H%=H%+100
      for x%=1 to 5
        G%=G%+100
        item_add 400,str$(G%)+"|"+str$(H%)
      next x%
  until H%=400
return
' ------------------------------------------------------------------------------
Verif_Solution:
  cpte%=0
  for x%=11 to 34
  VS$=item_read$(400,x%-10)
  sep%=instr(VS$,"|")
  G%=val(left$(VS$,sep%-1))
  H%=val(right$(VS$,len(VS$)-sep%))
      if top(x%)=H% and left(x%)=G%
        cpte%=cpte%+1
      end_if
  next x%
  if cpte%=24
      gagne%=1
      gosub arreter
  end_if
return
' ------------------------------------------------------------------------------
Chrono:
  Tps%=Tps%+1
  heure%=int(Tps%/3600)
  minute%=int(Tps%/60)-(heure%*60)
  secd%=Tps% -((heure%*3600)+(minute%*60))
    if len(str$(heure%))<2
    heure$="0"+str$(heure%)
  else
    heure$=str$(heure%)
  end_if
  if len(str$(minute%))<2
    minute$="0"+str$(minute%)
  else
    minute$=str$(minute%)
  end_if
  if len(str$(secd%))<2
    secd$="0"+str$(secd%)
  else
    secd$=str$(secd%)
  end_if
  Chrono$=heure$+" : "+minute$+" : "+secd$
  caption 800,Chrono$
return
' ------------------------------------------------------------------------------
Visu_Score:
  if object_exists(600)=1
    show 600
    caption 600,def$(9):caption 602,def$(13)
    for x%=1 to 5:grid_write 601,1,x% ,def$(x%+13):next x%
  else
    form 600:width 600,425:height 600,210:caption 600,def$(9)
    font_name 600,"Times new roman":font_size 600,10
    command_target_is 600
    grid 601:top 601,15:left 601,5:width 601,398
    grid_column 601,5:grid_row 601,2:grid_row_height 601,20
    grid_one_column_width 601,3,80
    grid_one_column_width 601,4,100
    for x%=1 to 5:grid_write 601,1,x% ,def$(x%+13):next x%
    button 602:top 602,140:left 602,327:caption 602,def$(13):cursor_point 602
    on_click 602,Quit_Score
  end_if
  gosub Remp_Grid
return
' ------------------------------------------------------------------------------
Remp_Grid:
  if count(402)>0
      grid_row 601,count(402)+2
      for x%=1 to count(402)
        Donnee$=item_read$(402,x%)
        sep%=instr(Donnee$,";")
        grid_write 601,x%+1,1,left$(Donnee$,sep%-1)
        Donnee$=right$(Donnee$,len(Donnee$)-sep%)
        sep%=instr(Donnee$,";")
        grid_write 601,x%+1,2,left$(Donnee$,sep%-1)
        Donnee$=right$(Donnee$,len(Donnee$)-sep%)
        sep%=instr(Donnee$,";")
        grid_write 601,x%+1,3,left$(Donnee$,sep%-1)
        Donnee$=right$(Donnee$,len(Donnee$)-sep%)
        sep%=instr(Donnee$,";")
        grid_write 601,x%+1,4,file_extract_name$(left$(Donnee$,sep%-1))
        grid_write 601,x%+1,5,right$(Donnee$,len(Donnee$)-sep%)
      next x%
  end_if
return
' ------------------------------------------------------------------------------
Quit_Score:
  Hide 600
return
' ------------------------------------------------------------------------------
Quitter:
terminate

' ******************************************************************************
dim Dossier$,Doss_Sprite$,Doss_Fond$,Doss_Langue$
dim Langue$,def$(100),jeu%
dim M%
dim N%,T%,L%,T1%,L1%
dim x%,x$,joueur$
dim img%,img$,Doss_img_select$,view$
dim mess%
dim Table%(4,4),R%,C%,a%,b%,z%,cpte%,i%,gagne%,G%,H%,VS$,sep%
dim heure%,minute%,secd%,Tps%,heure$,minute$,secd$,Chrono$,Donnee$,Donnee%
dim hnd%,mode%,res%,res2%,hnd2%
dim pos_x%,pos_y%,lign_sel%,col_sel%
dim Nom$,List_Nom$(100),Num%,Tri$(5),v$(3),v%(3),v_record%,v_ligne%,z1%,v_record_Lign%
' ------------------------------------------------------------------------------
label Init,Init_Dossier,Init_List,Init_Param,Init_Langue,Init_Bdd
label Change_Langue,New_Langue
label Menu,Jouer,Arreter,APp,Aide
label Select_Joueur,choix_joueur,Ajout_Joueur,Valid_Joueur
label Select_Img,Preview,Choix,Creation,Placement,Verif,Selection
label Action_G,Action_D,Action_H,Action_B
label Create_Solution,Verif_Solution,Chrono,Close_Jeu,Continu_Jeu
label Visu_Score,Remp_Grid,Quit_Score
label Selection_Cellule,Tri_Grid_Joueur,Tri_Grid_Record,Tri_Grid_Image,Remp_Grid2
label Quitter
' ******************************************************************************
caption 0,"Mon Puzzle":width 0,516:height 0,558:color 0,240,240,150
top 0,(screen_y-558)/2:left 0,(screen_x-516)/2
font_name 0,"Times new roman":font_size 0,10
main_menu 1
 sub_menu 2:parent 2,1:on_click 2,Menu:caption 2,"Jouer"
 sub_menu 3:parent 3,1:on_click 3,Menu:caption 3,"Langue"
 sub_menu 4:parent 4,1:on_click 4,Menu:caption 4,"A Propos"
 sub_menu 5:parent 5,1:on_click 5,Menu:caption 5,"Aide"
 sub_menu 801:parent 801,1:on_click 801,Visu_Score
 sub_menu 800:parent 800,1
 Chrono$="00 : 00 : 00"
 caption 800,Chrono$
 inactive 5
 button 802:top 802,470:left 802,420:cursor_point 802:on_click 802,Quitter
dlist 6 :' Liste des peramètres
dlist 7 :' Liste des langues dispo
dlist 8 :' Contenu de la langue choisie
dlist 9 :' Liste des Images
dlist 400 :' Solution
dlist 402 :' Liste des scores
dlist 403 :' liste temporaire pour les tris
dlist 404 :' liste temporaire pour les tris
timer 401:timer_off 401
gosub Init
end
' ******************************************************************************
Init:
  gosub Init_Dossier
  gosub Init_List
  gosub Init_Param
  gosub Init_Bdd
  gosub Create_Solution
return
' ------------------------------------------------------------------------------
Init_Dossier:
  Dossier$=Dir_Current$
  Doss_Sprite$=Dossier$+"\Sprites"
  Doss_Fond$=Dossier$+"\Fonds"
  Doss_Langue$=Dossier$+"\Langue"
return
' ------------------------------------------------------------------------------
Init_List:
  ' langues disponibles
  dir_change Doss_Langue$
  x$=file_find_first$
  if x$<>"_" then item_add 7,x$
  x$=file_find_next$
  while x$<>"_"
      if x$<>"_" then item_add 7,x$
      x$=file_find_next$
  end_while
  file_find_close
  ' liste des images
  dir_change Doss_Fond$
  x$=file_find_first$
  if x$<>"_" then item_add 9,x$
  x$=file_find_next$
  while x$<>"_"
      if x$<>"_" then item_add 9,x$
      x$=file_find_next$
  end_while
  file_find_close
return
' ------------------------------------------------------------------------------
Init_Param:
  if file_exists(Dossier$+"\Param.inf")=1
      file_load 6,Dossier$+"\Param.inf"
      gosub Init_Langue
  else
      gosub Change_Langue
  end_if
return
' ------------------------------------------------------------------------------
Init_Langue:
  clear 8
  if count(6)>0
      Langue$=Doss_Langue$+"\"+item_read$(6,1)+".txt"
      file_load 8,Langue$
      for x%=1 to count(8):def$(x%)=item_read$(8,x%):next x%
      for x%=2 to 5:caption x%,def$(x%-1):next x%
      caption 801,def$(9)
      caption 802,def$(19)
      if jeu%=1 then caption 2,def$(5)
  end_if
return
' ------------------------------------------------------------------------------
Change_Langue:
  if object_exists(100)=1
      show 100
  else
      form 100
      width 100,200:height 100,130:top 100,(screen_y-130)/2:left 100,(screen_x-200)/2
      caption 100,"Paramètres":font_name 100,"Times new roman":font_size 100,10
      command_target_is 100
      alpha 101:top 101,10:left 101,10:caption 101,"Langue :"
      combo 102:top 102,30:left 102,10
      for x%=1 to count(7):item_add 102,left$(item_read$(7,x%),len(item_read$(7,x%))-4):next x%
      on_change 102,New_Langue
  end_if
return
'-------------------------------------------------------------------------------
New_Langue:
  If count(6)>0 and Text$(102)<>""
      item_delete 6,1
      item_insert 6,1,Text$(102)
  else
      if Text$(102)<>"" then item_insert 6,1,Text$(102)
  end_if
  file_save 6,Dossier$+"\Param.inf"
  gosub Init_Langue
  hide 100
return
'-------------------------------------------------------------------------------
Init_Bdd:
  if file_exists(Dossier$+"\Score.Bdd")=1
      file_load 402,Dossier$+"\Score.Bdd"
  end_if
return
' ------------------------------------------------------------------------------
Menu:
  for x%=2 to 5
      if clicked(x%)=1 then M%=x%
  next x%
  select M%
  case 2
      jeu%=jeu%+1
      if jeu%=1
        caption 2,def$(5)
        gosub Jouer
      else
        jeu%=0
        caption 2,def$(1)
        gagne%=0
        gosub Arreter
      end_if
  case 3
      gosub Change_Langue
  case 4
      gosub APp
  case 5
      gosub Aide
  end_select
return
' ------------------------------------------------------------------------------
Jouer:
  gosub Select_Joueur
return
' ------------------------------------------------------------------------------
Select_Joueur:
  dll_on Dossier$+"\form.dll"
  Joueur$="Joueur inconnu"
  if object_exists(500)=1
      show 500
  else
      form 500:width 500,360:height 500,205:top 500,(screen_y-205)/2:left 500,(screen_x-360)/2
      caption 500,def$(10):font_name 500,"Times new roman":font_size 500,10:border_small 500
      command_target_is 500
      hnd%=handle(500)
      Mode%=0
      res%=dll_call2("SetCaption",hnd%,mode%)
      list 501:height 501,160:sort_on 501
      if file_exists(Dossier$+"\Joueur.Bdd")=1 then file_load 501,Dossier$+"\Joueur.Bdd"
      cursor_point 501:hint 501,def$(11):on_click 501,choix_joueur
      edit 502:text 502,"":top 502,20:left 502,140
      button 503:top 503,20:left 503,265:width 503,20:height 503,20:caption 503,"..."
      cursor_point 503:on_click 503,Ajout_Joueur:hint 503,def$(12)
      button 504:top 504,140:left 504,265:caption 504,def$(8)
      cursor_point 504:on_click 504,Valid_Joueur
  end_if
return
' ------------------------------------------------------------------------------
Choix_Joueur:
  text 502,item_index$(501)
return
' ------------------------------------------------------------------------------
Ajout_Joueur:
  a%=0
  if text$(502)<>""
      for x%=1 to count(501)
        if text$(502)=item_read$(501,x%) then a%=a%+1
      next x%
  end_if
  if a%=0
      item_add 501,text$(502)
      file_save 501,Dossier$+"\Joueur.Bdd"
  end_if
return
' ------------------------------------------------------------------------------
Valid_Joueur:
 if text$(502)<>"" then  Joueur$=text$(502)
 dll_off
 hide 500
 gosub Select_img
return
' ------------------------------------------------------------------------------
Select_img:
  dll_on Dossier$+"\form.dll"
  if object_exists(200)=1
      show 200
  else
      form 200:width 200,500:height 200,350:top 200,(screen_y-350)/2:left 200,(screen_x-500)/2
      caption 200,def$(6):font_name 200,"Times new roman":font_size 200,10:border_small 200
      command_target_is 200
      hnd2%=handle(200)
      res2%=dll_call2("SetCaption",hnd2%,0)
      alpha 201:top 201,10:left 201,5:caption 201,def$(7)
      list 202 :top 202,30:left 202,5:width 202,170:height 202,230:cursor_point 202
      for x%=1 to count(9):item_add 202,item_read$(9,x%):next x%
      on_click 202,Preview
      picture 203:top 203,5:left 203,180:width 203,290:height 203,290:stretch_on 203
      button 204 :top 204,270:left 204,50:caption 204,def$(8):cursor_point 204
      inactive 204:on_click 204,Choix
  end_if
return
' ------------------------------------------------------------------------------
Preview:
  view$=Doss_Fond$+"\"+item_index$(202)
  file_load 203,view$
  active 204
return
' ------------------------------------------------------------------------------
Choix:
  img$=item_index$(202)
  Doss_img_select$=Doss_Sprite$+"\"+left$(img$,len(img$)-4)
  dll_off
  hide 200
  command_target_is 0
  inactive 802
  hide 802
  gosub Creation
return
' ------------------------------------------------------------------------------
Creation:
  for x%=1 to 24
      img%=10+x%
      picture img%
      width img%,100 :height img%,100:cursor_point img%
      stretch_on img% :file_load img%,Doss_img_select$+"\"+str$(img%)+".bmp"
      on_click img%,Selection
  next x%
  gosub Placement
  Tps%=0
  timer_on 401
  on_timer 401,Chrono
  active 5
return
' ------------------------------------------------------------------------------
Placement:
  Table%(4,4)=1
  for img%=11 to 34
      repeat
        R%=int(rnd(5))
        C%=int(rnd(5))
      until Table%(R%,C%)=0
      Table%(R%,C%)=img%
      left img%,R%*100
      top img%,C%*100
  next img%
  Table%(4,4)=0
return
' ------------------------------------------------------------------------------
Selection:
  for x%=1 to 24:off_click x%+10:next x%
  N%=number_click
  T%=Top(N%)
  L%=Left(N%)
  gosub Verif
  gosub Verif_Solution
return
' ------------------------------------------------------------------------------
Verif:
  T1%=T%/100
  L1%=L%/100
  ' pour se deplacer vers la gauche il faut au minimum etre dans la colonne 2
  if L1%>0
      if Table%(L1%-1,T1%)=0
        gosub Action_G
        Table%(L1%-1,T1%)=Table%(L1%,T1%)
        Table%(L1%,T1%)=0
      end_if
  end_if
  ' pour ce deplacer vers la droite il faut au maximum etre dans la colonne 4
  if L1%<4
      if Table%(L1%+1,T1%)=0
        gosub Action_D
        Table%(L1%+1,T1%)=Table%(L1%,T1%)
        Table%(L1%,T1%)=0
      end_if
  end_if
  ' pour ce deplacer vers le haut il faut etre au minimum sur la ligne 2
  if T1%>0
      if Table%(L1%,T1%-1)=0
        gosub Action_H
        Table%(L1%,T1%-1)=Table%(L1%,T1%)
        Table%(L1%,T1%)=0
      end_if
  end_if
  ' pour se deplacer vers le bas il faut au maximum etre sur la ligne 4
  if T1%<4
      if Table%(L1%,T1%+1)=0
        gosub Action_B
        Table%(L1%,T1%+1)=Table%(L1%,T1%)
        Table%(L1%,T1%)=0
      end_if
  end_if
  for x%=1 to 24:on_click x%+10,Selection :next x%
return
' ------------------------------------------------------------------------------
Action_G:
  if L%>=100
      for x%=L% to L%-100 step -5:top N%,T% :left N%,x% :wait 5 :next x%
  end_if
return
' ------------------------------------------------------------------------------
Action_D:
  if L%<400
      for x%=L% to L%+100 step 5:top N%,T% :left N%,x% :wait 5 :next x%
  end_if
return
' ------------------------------------------------------------------------------
Action_H:
  if T%>=100
      for x%=T% to T%-100 step -5:top N%,x% :left N%,L% :wait 5 :next x%
  end_if
return
' ------------------------------------------------------------------------------
Action_B:
  if T%<400
      for x%=T% to T%+100 step 5:top N%,x% :left N%,L% :wait 5 :next x%
  end_if
return
' ------------------------------------------------------------------------------
Arreter:
  Timer_off 401
  if gagne%=0
      if message_confirmation_yes_no("Etes vous sûr de vouloir abandonner ?")=1
        gosub Close_Jeu
      else
        gosub continu_Jeu
      end_if
  else
      if gagne%=1
        message "Bravo !!!"+chr$(13)+"Vous avez résolu le puzzle en :"+chr$(13)+Chrono$
        item_add 402,Date$+";"+Time$+";"+Joueur$+";"+view$+";"+Chrono$
        file_save 402,Dossier$+"\Score.Bdd"
        gosub Close_Jeu
      end_if
  end_if
return
' ------------------------------------------------------------------------------
Close_Jeu:
  for img%=11 to 34 : delete img% : next img%
  for R%=0 to 4: for C%=0 to 4 : Table%(R%,C%)=0 : next C%: next R%
  Tps%=0
  Chrono$="00 : 00 : 00"
  caption 800,Chrono$
  show 802
  active 802
return
' ------------------------------------------------------------------------------
Continu_Jeu:
  jeu%=1
  caption 2,def$(5)
  Timer_on 401
return
' ------------------------------------------------------------------------------
APp:
return
' ------------------------------------------------------------------------------
Aide:
  if object_exists(300)=1
      show 300
  else
      form 300:height 300,328:width 300,306:caption 300,def$(4)
      top 300,top(0):left 300,left(0)+520
      command_target_is 300
      picture 301:height 301,290:width 301,290:file_load 301,view$
  end_if
  pause 5000
  hide 300
return
' ------------------------------------------------------------------------------
Create_Solution:
  H%=-100
  repeat
      G%=-100
      H%=H%+100
      for x%=1 to 5
        G%=G%+100
        item_add 400,str$(G%)+"|"+str$(H%)
      next x%
  until H%=400
return
' ------------------------------------------------------------------------------
Verif_Solution:
  cpte%=0
  for x%=11 to 34
  VS$=item_read$(400,x%-10)
  sep%=instr(VS$,"|")
  G%=val(left$(VS$,sep%-1))
  H%=val(right$(VS$,len(VS$)-sep%))
      if top(x%)=H% and left(x%)=G%
        cpte%=cpte%+1
      end_if
  next x%
  if cpte%=24
      gagne%=1
      gosub arreter
  end_if
return
' ------------------------------------------------------------------------------
Chrono:
  Tps%=Tps%+1
  heure%=int(Tps%/3600)
  minute%=int(Tps%/60)-(heure%*60)
  secd%=Tps% -((heure%*3600)+(minute%*60))
    if len(str$(heure%))<2
    heure$="0"+str$(heure%)
  else
    heure$=str$(heure%)
  end_if
  if len(str$(minute%))<2
    minute$="0"+str$(minute%)
  else
    minute$=str$(minute%)
  end_if
  if len(str$(secd%))<2
    secd$="0"+str$(secd%)
  else
    secd$=str$(secd%)
  end_if
  Chrono$=heure$+" : "+minute$+" : "+secd$
  caption 800,Chrono$
return
' ------------------------------------------------------------------------------
Visu_Score:
  if object_exists(600)=1
    show 600
    caption 600,def$(9):caption 602,def$(13)
    for x%=1 to 5:grid_write 601,1,x% ,def$(x%+13):next x%
  else
    form 600:width 600,425:height 600,210:caption 600,def$(9)
    font_name 600,"Times new roman":font_size 600,10
    command_target_is 600
    grid 601:top 601,15:left 601,5:width 601,398
    grid_column 601,5:grid_row 601,2:grid_row_height 601,20
    grid_one_column_width 601,3,80
    grid_one_column_width 601,4,100
    for x%=1 to 5:grid_write 601,1,x% ,def$(x%+13):next x%
    button 602:top 602,140:left 602,327:caption 602,def$(13):cursor_point 602
    on_double_click 601,Selection_Cellule
    on_click 602,Quit_Score
  end_if
  gosub Remp_Grid
return
' ------------------------------------------------------------------------------
Remp_Grid:
  if count(402)>0
      grid_row 601,count(402)+2
      for x%=1 to count(402)
        Donnee$=item_read$(402,x%)
        sep%=instr(Donnee$,";")
        grid_write 601,x%+1,1,left$(Donnee$,sep%-1)
        Donnee$=right$(Donnee$,len(Donnee$)-sep%)
        sep%=instr(Donnee$,";")
        grid_write 601,x%+1,2,left$(Donnee$,sep%-1)
        Donnee$=right$(Donnee$,len(Donnee$)-sep%)
        sep%=instr(Donnee$,";")
        grid_write 601,x%+1,3,left$(Donnee$,sep%-1)
        Donnee$=right$(Donnee$,len(Donnee$)-sep%)
        sep%=instr(Donnee$,";")
        grid_write 601,x%+1,4,file_extract_name$(left$(Donnee$,sep%-1))
        grid_write 601,x%+1,5,right$(Donnee$,len(Donnee$)-sep%)
      next x%
  end_if
return
' ------------------------------------------------------------------------------
Selection_Cellule:
  pos_y%=mouse_y_left_down(601):pos_x%=mouse_x_left_down(601)
  lign_sel%=GRID_Y_TO_ROW(601,pos_y%):col_sel%=GRID_X_TO_COLUMN(601,pos_x%)
  if lign_sel%=1 and col_sel%=3 then gosub Tri_Grid_Joueur
  if lign_sel%=1 and col_sel%=4 then gosub Tri_Grid_Image
  if lign_sel%=1 and col_sel%=5 then gosub Tri_Grid_record
return
' ------------------------------------------------------------------------------
Tri_Grid_Joueur:
  for x%=0 to 100:List_Nom$(x%)="":next x%
  clear 404:clear 403
  if file_exists(Dossier$+"\Joueur.Bdd")=1
      file_load 403,Dossier$+"\Joueur.Bdd"
      for x%=1 to count(403)
        Nom$=item_read$(403,x%)
        List_Nom$(x%)=Nom$
      next x%
      if count(402)>0
        Num%=0
        repeat
            Num%=Num%+1
            for x%=1 to count(402)
              Donnee$=item_read$(402,x%)
              sep%=instr(Donnee$,";")
              Tri$(1)=left$(Donnee$,sep%-1)
              Donnee$=right$(Donnee$,len(Donnee$)-sep%)
              sep%=instr(Donnee$,";")
              Tri$(2)=left$(Donnee$,sep%-1)
              Donnee$=right$(Donnee$,len(Donnee$)-sep%)
              sep%=instr(Donnee$,";")
              Tri$(3)=left$(Donnee$,sep%-1)
              Donnee$=right$(Donnee$,len(Donnee$)-sep%)
              sep%=instr(Donnee$,";")
              Tri$(4)=file_extract_name$(left$(Donnee$,sep%-1))
              Tri$(5)=right$(Donnee$,len(Donnee$)-sep%)
              if List_Nom$(Num%)=Tri$(3)
              item_add 404,Tri$(1)+";"+Tri$(2)+";"+Tri$(3)+";"+Tri$(4)+";"+Tri$(5)
              end_if
            next x%
        until Num%=count(403)
      else
        message "Il n'y a pas assez de données pour faire un tri !"
      end_if
  else
      message "La liste des joueurs n'est pas créée !"
  end_if
  gosub Remp_Grid2
return
' ------------------------------------------------------------------------------
Tri_Grid_Record:
  for x%=0 to 100:List_Nom$(x%)="":next x%
  clear 404:clear 403
  if count(402)>0
      for x%=1 to count(402)
        Donnee$=item_read$(402,x%)
        Donnee$=right$(Donnee$,12)
        sep%=instr(Donnee$,":")
        v%(1)=val(left$(trim$(Donnee$),sep%-1))*3600
        Donnee$=right$(Donnee$,len(Donnee$)-sep%)
        sep%=instr(Donnee$,":")
        v%(2)=val(trim$(left$(Donnee$,sep%-1)))*60
        v%(3)=val(trim$(right$(Donnee$,len(Donnee$)-sep%)))
        Donnee%=v%(1)+v%(2)+v%(3)
        Donnee$=str$(Donnee%)
        item_add 403,Donnee$
      next x%
      for x%=1 to count(403)
      v_record%=86400
        for z1%=1 to count(403)
            v_ligne%=item_read$(403,z1%)
            if v_ligne% < v_record%
              v_record% = v_ligne%
              v_record_Lign% = z1%
            end_if
        next z1%
        item_add 404,item_read$(402,v_record_Lign%)
        item_delete 403,v_record_Lign%
        item_insert 403,v_record_Lign%,"86400"
      next x%
  end_if
  gosub Remp_Grid2
return
' ------------------------------------------------------------------------------
Tri_Grid_Image:
  for x%=0 to 100:List_Nom$(x%)="":next x%
  clear 404:clear 403
  if count(9)>0
      for x%=1 to count(9)
        Nom$=item_read$(9,x%)
        List_Nom$(x%)=Nom$
      next x%
      if count(402)>0
        Num%=0
        repeat
            Num%=Num%+1
            for x%=1 to count(402)
              Donnee$=item_read$(402,x%)
              sep%=instr(Donnee$,";")
              Tri$(1)=left$(Donnee$,sep%-1)
              Donnee$=right$(Donnee$,len(Donnee$)-sep%)
              sep%=instr(Donnee$,";")
              Tri$(2)=left$(Donnee$,sep%-1)
              Donnee$=right$(Donnee$,len(Donnee$)-sep%)
              sep%=instr(Donnee$,";")
              Tri$(3)=left$(Donnee$,sep%-1)
              Donnee$=right$(Donnee$,len(Donnee$)-sep%)
              sep%=instr(Donnee$,";")
              Tri$(4)=file_extract_name$(left$(Donnee$,sep%-1))
              Tri$(5)=right$(Donnee$,len(Donnee$)-sep%)
              if List_Nom$(Num%)=Tri$(4)
              item_add 404,Tri$(1)+";"+Tri$(2)+";"+Tri$(3)+";"+Tri$(4)+";"+Tri$(5)
              end_if
            next x%
        until Num%=count(9)
      else
        message "Il n'y a pas assez de données pour faire un tri !"
      end_if
  else
      message "La liste des joueurs n'est pas créée !"
  end_if
  gosub Remp_Grid2
return
' ------------------------------------------------------------------------------
Remp_Grid2:
  if count(404)>0
      grid_row 601,count(404)+2
      for x%=1 to count(404)
        Donnee$=item_read$(404,x%)
        sep%=instr(Donnee$,";")
        grid_write 601,x%+1,1,left$(Donnee$,sep%-1)
        Donnee$=right$(Donnee$,len(Donnee$)-sep%)
        sep%=instr(Donnee$,";")
        grid_write 601,x%+1,2,left$(Donnee$,sep%-1)
        Donnee$=right$(Donnee$,len(Donnee$)-sep%)
        sep%=instr(Donnee$,";")
        grid_write 601,x%+1,3,left$(Donnee$,sep%-1)
        Donnee$=right$(Donnee$,len(Donnee$)-sep%)
        sep%=instr(Donnee$,";")
        grid_write 601,x%+1,4,file_extract_name$(left$(Donnee$,sep%-1))
        grid_write 601,x%+1,5,right$(Donnee$,len(Donnee$)-sep%)
      next x%
  end_if
return
' ------------------------------------------------------------------------------
Quit_Score:
  Hide 600
return
' ------------------------------------------------------------------------------
Quitter:
terminate

Yannick
Gilbert
Edouard
Roger

03/08/2012;06:16:01;Yannick;C:\Users\Yannick\Desktop\Puzzle\Fonds\Numerique.bmp;00 : 05 : 06
04/08/2012;08:10:02;Gilbert;C:\Users\Yannick\Desktop\Puzzle\Fonds\Numerique.bmp;00 : 04 : 06
10/08/2012;08:15:02;Edouard;C:\Users\Yannick\Desktop\Puzzle\Fonds\Numerique.bmp;00 : 06 : 06
10/08/2012;08:20:02;Gilbert;C:\Users\Yannick\Desktop\Puzzle\Fonds\Numerique.bmp;00 : 04 : 56
11/08/2012;08:30:02;Roger;C:\Users\Yannick\Desktop\Puzzle\Fonds\Numerique.bmp;00 : 06 : 06
11/08/2012;08:35:02;Gilbert;C:\Users\Yannick\Desktop\Puzzle\Fonds\Numerique.bmp;00 : 03 : 26
12/08/2012;08:20:02;Roger;C:\Users\Yannick\Desktop\Puzzle\Fonds\Numerique.bmp;00 : 04 : 46
12/08/2012;08:24:02;Yannick;C:\Users\Yannick\Desktop\Puzzle\Fonds\Numerique.bmp;00 : 05 : 16

' ******************************************************************************
dim Dossier$,Doss_Sprite$,Doss_Fond$,Doss_Langue$
dim Langue$,def$(100),jeu%
dim M%
dim N%,T%,L%,T1%,L1%,x0%,y0%,x1%,y1%,T2%,T3%,L2%,L3%,e%,f%,j%
dim x%,x$,joueur$
dim img%,img$,Doss_img_select$,view$
dim mess%
dim Table%(4,4),R%,C%,a%,b%,z%,cpte%,i%,gagne%,G%,H%,VS$,sep%
dim heure%,minute%,secd%,Tps%,heure$,minute$,secd$,Chrono$,Donnee$,Donnee%
dim hnd%,mode%,res%,res2%,hnd2%,res_dll2%
dim pos_x%,pos_y%,lign_sel%,col_sel%
dim Nom$,List_Nom$(100),Num%,Tri$(5),v$(3),v%(3),v_record%,v_ligne%,z1%,v_record_Lign%
dim PB%,etat%
' ------------------------------------------------------------------------------
label Init,Init_Dossier,Init_List,Init_Param,Init_Langue,Init_Bdd
label Change_Langue,New_Langue
label Menu,Jouer,Arreter,APp,Aide
label Select_Joueur,choix_joueur,Ajout_Joueur,Valid_Joueur
label Select_Img,Preview,Choix,Sous_Creation,Creation,Placement,Verif,Selection
label Messager
label Action_G,Action_D,Action_H,Action_B
label Create_Solution,Verif_Solution,Chrono,Close_Jeu,Continu_Jeu
label Visu_Score,Remp_Grid,Quit_Score
label Selection_Cellule,Tri_Grid_Joueur,Tri_Grid_Record,Tri_Grid_Image,Remp_Grid2
label Quitter
' ******************************************************************************
caption 0,"Mon Puzzle":width 0,516:height 0,558:color 0,240,240,150
top 0,(screen_y-558)/2:left 0,(screen_x-516)/2
font_name 0,"Times new roman":font_size 0,10
main_menu 1
 sub_menu 2:parent 2,1:on_click 2,Menu:caption 2,"Jouer"
 sub_menu 3:parent 3,1:on_click 3,Menu:caption 3,"Langue"
 sub_menu 4:parent 4,1:on_click 4,Menu:caption 4,"A Propos"
 sub_menu 5:parent 5,1:on_click 5,Menu:caption 5,"Aide"
 sub_menu 801:parent 801,1:on_click 801,Visu_Score
 sub_menu 800:parent 800,1
 Chrono$="00 : 00 : 00"
 caption 800,Chrono$
 inactive 5
 button 802:top 802,470:left 802,420:cursor_point 802:on_click 802,Quitter
dlist 6 :' Liste des peramètres
dlist 7 :' Liste des langues dispo
dlist 8 :' Contenu de la langue choisie
dlist 9 :' Liste des Images
dlist 400 :' Solution
dlist 402 :' Liste des scores
dlist 403 :' liste temporaire pour les tris
dlist 404 :' liste temporaire pour les tris
timer 401:timer_off 401
gosub Init
end
' ******************************************************************************
Init:
  gosub Init_Dossier
  gosub Init_List
  gosub Init_Param
  gosub Init_Bdd
  gosub Create_Solution
return
' ------------------------------------------------------------------------------
Init_Dossier:
  Dossier$=Dir_Current$
  Doss_Sprite$=Dossier$+"\Sprites"
  Doss_Fond$=Dossier$+"\Fonds"
  Doss_Langue$=Dossier$+"\Langue"
return
' ------------------------------------------------------------------------------
Init_List:
  ' langues disponibles
  dir_change Doss_Langue$
  x$=file_find_first$
  if x$<>"_" then item_add 7,x$
  x$=file_find_next$
  while x$<>"_"
      if x$<>"_" then item_add 7,x$
      x$=file_find_next$
  end_while
  file_find_close
  ' liste des images
  dir_change Doss_Fond$
  x$=file_find_first$
  if x$<>"_" then item_add 9,x$
  x$=file_find_next$
  while x$<>"_"
      if x$<>"_" then item_add 9,x$
      x$=file_find_next$
  end_while
  file_find_close
return
' ------------------------------------------------------------------------------
Init_Param:
  if file_exists(Dossier$+"\Param.inf")=1
      file_load 6,Dossier$+"\Param.inf"
      gosub Init_Langue
  else
      gosub Change_Langue
  end_if
return
' ------------------------------------------------------------------------------
Init_Langue:
  clear 8
  if count(6)>0
      Langue$=Doss_Langue$+"\"+item_read$(6,1)+".txt"
      file_load 8,Langue$
      for x%=1 to count(8):def$(x%)=item_read$(8,x%):next x%
      for x%=2 to 5:caption x%,def$(x%-1):next x%
      caption 801,def$(9)
      caption 802,def$(19)
      if jeu%=1 then caption 2,def$(5)
  end_if
return
' ------------------------------------------------------------------------------
Change_Langue:
  if object_exists(100)=1
      show 100
  else
      form 100
      width 100,200:height 100,130:top 100,(screen_y-130)/2:left 100,(screen_x-200)/2
      caption 100,"Paramètres":font_name 100,"Times new roman":font_size 100,10
      command_target_is 100
      alpha 101:top 101,10:left 101,10:caption 101,"Langue :"
      combo 102:top 102,30:left 102,10
      for x%=1 to count(7):item_add 102,left$(item_read$(7,x%),len(item_read$(7,x%))-4):next x%
      on_change 102,New_Langue
  end_if
return
'-------------------------------------------------------------------------------
New_Langue:
  If count(6)>0 and Text$(102)<>""
      item_delete 6,1
      item_insert 6,1,Text$(102)
  else
      if Text$(102)<>"" then item_insert 6,1,Text$(102)
  end_if
  file_save 6,Dossier$+"\Param.inf"
  gosub Init_Langue
  hide 100
return
'-------------------------------------------------------------------------------
Init_Bdd:
  if file_exists(Dossier$+"\Score.Bdd")=1
      file_load 402,Dossier$+"\Score.Bdd"
  end_if
return
' ------------------------------------------------------------------------------
Menu:
  for x%=2 to 5
      if clicked(x%)=1 then M%=x%
  next x%
  select M%
  case 2
      jeu%=jeu%+1
      if jeu%=1
        caption 2,def$(5)
        gosub Jouer
      else
        jeu%=0
        caption 2,def$(1)
        gagne%=0
        gosub Arreter
      end_if
  case 3
      gosub Change_Langue
  case 4
      gosub APp
  case 5
      gosub Aide
  end_select
return
' ------------------------------------------------------------------------------
Jouer:
  gosub Select_Joueur
return
' ------------------------------------------------------------------------------
Select_Joueur:
  dll_on Dossier$+"\form.dll"
  Joueur$="Joueur inconnu"
  if object_exists(500)=1
      show 500
  else
      form 500:width 500,360:height 500,205:top 500,(screen_y-205)/2:left 500,(screen_x-360)/2
      caption 500,def$(10):font_name 500,"Times new roman":font_size 500,10:border_small 500
      command_target_is 500
      hnd%=handle(500)
      Mode%=0
      res%=dll_call2("SetCaption",hnd%,mode%)
      list 501:height 501,160:sort_on 501
      if file_exists(Dossier$+"\Joueur.Bdd")=1 then file_load 501,Dossier$+"\Joueur.Bdd"
      cursor_point 501:hint 501,def$(11):on_click 501,choix_joueur
      edit 502:text 502,"":top 502,20:left 502,140
      button 503:top 503,20:left 503,265:width 503,20:height 503,20:caption 503,"..."
      cursor_point 503:on_click 503,Ajout_Joueur:hint 503,def$(12)
      button 504:top 504,140:left 504,265:caption 504,def$(8)
      cursor_point 504:on_click 504,Valid_Joueur
  end_if
return
' ------------------------------------------------------------------------------
Choix_Joueur:
  text 502,item_index$(501)
return
' ------------------------------------------------------------------------------
Ajout_Joueur:
  a%=0
  if text$(502)<>""
      for x%=1 to count(501)
        if text$(502)=item_read$(501,x%) then a%=a%+1
      next x%
  end_if
  if a%=0
      item_add 501,text$(502)
      file_save 501,Dossier$+"\Joueur.Bdd"
  end_if
return
' ------------------------------------------------------------------------------
Valid_Joueur:
 if text$(502)<>"" then  Joueur$=text$(502)
 dll_off
 hide 500
 gosub Select_img
return
' ------------------------------------------------------------------------------
Select_img:
  dll_on Dossier$+"\form.dll"
  if object_exists(200)=1
      show 200
  else
      form 200:width 200,500:height 200,350:top 200,(screen_y-350)/2:left 200,(screen_x-500)/2
      caption 200,def$(6):font_name 200,"Times new roman":font_size 200,10:border_small 200
      command_target_is 200
      hnd2%=handle(200)
      res2%=dll_call2("SetCaption",hnd2%,0)
      alpha 201:top 201,10:left 201,5:caption 201,def$(7)
      list 202 :top 202,30:left 202,5:width 202,170:height 202,230:cursor_point 202
      for x%=1 to count(9):item_add 202,item_read$(9,x%):next x%
      on_click 202,Preview
      picture 203:top 203,5:left 203,180:width 203,290:height 203,290:stretch_on 203
      button 204 :top 204,270:left 204,50:caption 204,def$(8):cursor_point 204
      inactive 204:on_click 204,Choix
  end_if
return
' ------------------------------------------------------------------------------
Preview:
  view$=Doss_Fond$+"\"+item_index$(202)
  file_load 203,view$
  active 204
return
' ------------------------------------------------------------------------------
Choix:
  img$=item_index$(202)
  dll_off
  hide 200
  gosub Messager
  gosub Sous_Creation
  command_target_is 0
  inactive 802
  hide 802

return
' ------------------------------------------------------------------------------
Sous_Creation:
  for x%=11 to 35
      if file_exists(Doss_Sprite$+"\"+str$(x%)+".bmp")=1
        delete Doss_Sprite$+"\"+str$(x%)+".bmp"
      end_if
  next x%
  form 600:hide 600:width 600,307:height 600,335
  command_target_is 600
  dll_on Dossier$+"\PrintScreen.dll"
  picture 606:width 606,290:height 606,290
  j%=0
  for x%=1 to 5
      if x%=1
        e%=0:f%=5:T2%=0:T3%=57
      else
        if x%=2
        e%=5:f%=10:T2%=58:T3%=115
        else
            if x%=3
            e%=10:f%=15:T2%=116:T3%=173
            else
              if x%=4
              e%=15:f%=20:T2%=174:T3%=231
              else
              e%=20:f%=25:T2%=232:T3%=289
              end_if
            end_if
        end_if
      end_if
      repeat
        e%=e%+1
        j%=j%+1
        file_load 606,view$
        clipboard_copy 606
        pause 500
        res_dll2% = dll_call0("LoadPicture")
        if e%=((x%-1)*5)+1
            L2%=0
            L3%=57
        else
            if e%=((x%-1)*5)+2
              L2%=58
              L3%=115
            else
              if e%=((x%-1)*5)+3
                  L2%=116
                  L3%=173
              else
                  if e%=((x%-1)*5)+4
                    L2%=174
                    L3%=231
                  else
                    if e%=((x%-1)*5)+5
                        L2%=232
                        L3%=289
                    end_if
                  end_if
              end_if
            end_if
        end_if
        x0% = L2%
        y0% = T2%
        x1% = L3%
        y1% = T3%
        res_dll2% = dll_call4("ExtractRectangleFromPicture",x0%,y0%,x1%,y1%)
        pause 400
        res_dll2%=dll_call0("SavePicture")
        clipboard_paste 606
        file_save 606,Doss_Sprite$+"\"+str$(e%+10)+".bmp"
        pause 400
        etat%=j%*8
        for PB%=1 to etat%
            position 701,PB%
        next PB%
      until e%=f%
      next x%
  dll_off
return
' ------------------------------------------------------------------------------
Messager:
  form 700:height 700,130:width 700,250:top 700,(screen_y-130)/2:left 700,(screen_x-250)/2
  caption 700,def$(20)
  command_target_is 700
      progress_bar 701:top 701,10:left 701,10:width 701,200
     
      if j%=25 then gosub Creation
return
' ------------------------------------------------------------------------------
Creation:
  delete 600
  delete 700
  for x%=1 to 24
      img%=10+x%
      picture img%
      width img%,100 :height img%,100:cursor_point img%
      stretch_on img% :file_load img%,Doss_Sprite$+"\"+str$(img%)+".bmp"
      on_click img%,Selection
  next x%
  gosub Placement
  Tps%=0
  timer_on 401
  on_timer 401,Chrono
  active 5
return
' ------------------------------------------------------------------------------
Placement:
  Table%(4,4)=1
  for img%=11 to 34
      repeat
        R%=int(rnd(5))
        C%=int(rnd(5))
      until Table%(R%,C%)=0
      Table%(R%,C%)=img%
      left img%,R%*100
      top img%,C%*100
  next img%
  Table%(4,4)=0
return
' ------------------------------------------------------------------------------
Selection:
  for x%=1 to 24:off_click x%+10:next x%
  N%=number_click
  T%=Top(N%)
  L%=Left(N%)
  gosub Verif
  gosub Verif_Solution
return
' ------------------------------------------------------------------------------
Verif:
  T1%=T%/100
  L1%=L%/100
  ' pour se deplacer vers la gauche il faut au minimum etre dans la colonne 2
  if L1%>0
      if Table%(L1%-1,T1%)=0
        gosub Action_G
        Table%(L1%-1,T1%)=Table%(L1%,T1%)
        Table%(L1%,T1%)=0
      end_if
  end_if
  ' pour ce deplacer vers la droite il faut au maximum etre dans la colonne 4
  if L1%<4
      if Table%(L1%+1,T1%)=0
        gosub Action_D
        Table%(L1%+1,T1%)=Table%(L1%,T1%)
        Table%(L1%,T1%)=0
      end_if
  end_if
  ' pour ce deplacer vers le haut il faut etre au minimum sur la ligne 2
  if T1%>0
      if Table%(L1%,T1%-1)=0
        gosub Action_H
        Table%(L1%,T1%-1)=Table%(L1%,T1%)
        Table%(L1%,T1%)=0
      end_if
  end_if
  ' pour se deplacer vers le bas il faut au maximum etre sur la ligne 4
  if T1%<4
      if Table%(L1%,T1%+1)=0
        gosub Action_B
        Table%(L1%,T1%+1)=Table%(L1%,T1%)
        Table%(L1%,T1%)=0
      end_if
  end_if
  for x%=1 to 24:on_click x%+10,Selection :next x%
return
' ------------------------------------------------------------------------------
Action_G:
  if L%>=100
      for x%=L% to L%-100 step -5:top N%,T% :left N%,x% :wait 5 :next x%
  end_if
return
' ------------------------------------------------------------------------------
Action_D:
  if L%<400
      for x%=L% to L%+100 step 5:top N%,T% :left N%,x% :wait 5 :next x%
  end_if
return
' ------------------------------------------------------------------------------
Action_H:
  if T%>=100
      for x%=T% to T%-100 step -5:top N%,x% :left N%,L% :wait 5 :next x%
  end_if
return
' ------------------------------------------------------------------------------
Action_B:
  if T%<400
      for x%=T% to T%+100 step 5:top N%,x% :left N%,L% :wait 5 :next x%
  end_if
return
' ------------------------------------------------------------------------------
Arreter:
  Timer_off 401
  if gagne%=0
      if message_confirmation_yes_no("Etes vous sûr de vouloir abandonner ?")=1
        gosub Close_Jeu
      else
        gosub continu_Jeu
      end_if
  else
      if gagne%=1
        message "Bravo !!!"+chr$(13)+"Vous avez résolu le puzzle en :"+chr$(13)+Chrono$
        item_add 402,Date$+";"+Time$+";"+Joueur$+";"+view$+";"+Chrono$
        file_save 402,Dossier$+"\Score.Bdd"
        gosub Close_Jeu
      end_if
  end_if
return
' ------------------------------------------------------------------------------
Close_Jeu:
  for img%=11 to 34 : delete img% : next img%
  for R%=0 to 4: for C%=0 to 4 : Table%(R%,C%)=0 : next C%: next R%
  Tps%=0
  Chrono$="00 : 00 : 00"
  caption 800,Chrono$
  show 802
  active 802
return
' ------------------------------------------------------------------------------
Continu_Jeu:
  jeu%=1
  caption 2,def$(5)
  Timer_on 401
return
' ------------------------------------------------------------------------------
APp:
return
' ------------------------------------------------------------------------------
Aide:
  if object_exists(300)=1
      show 300
  else
      form 300:height 300,328:width 300,306:caption 300,def$(4)
      top 300,top(0):left 300,left(0)+520
      command_target_is 300
      picture 301:height 301,290:width 301,290:file_load 301,view$
  end_if
  pause 5000
  hide 300
return
' ------------------------------------------------------------------------------
Create_Solution:
  H%=-100
  repeat
      G%=-100
      H%=H%+100
      for x%=1 to 5
        G%=G%+100
        item_add 400,str$(G%)+"|"+str$(H%)
      next x%
  until H%=400
return
' ------------------------------------------------------------------------------
Verif_Solution:
  cpte%=0
  for x%=11 to 34
  VS$=item_read$(400,x%-10)
  sep%=instr(VS$,"|")
  G%=val(left$(VS$,sep%-1))
  H%=val(right$(VS$,len(VS$)-sep%))
      if top(x%)=H% and left(x%)=G%
        cpte%=cpte%+1
      end_if
  next x%
  if cpte%=24
      gagne%=1
      gosub arreter
  end_if
return
' ------------------------------------------------------------------------------
Chrono:
  Tps%=Tps%+1
  heure%=int(Tps%/3600)
  minute%=int(Tps%/60)-(heure%*60)
  secd%=Tps% -((heure%*3600)+(minute%*60))
    if len(str$(heure%))<2
    heure$="0"+str$(heure%)
  else
    heure$=str$(heure%)
  end_if
  if len(str$(minute%))<2
    minute$="0"+str$(minute%)
  else
    minute$=str$(minute%)
  end_if
  if len(str$(secd%))<2
    secd$="0"+str$(secd%)
  else
    secd$=str$(secd%)
  end_if
  Chrono$=heure$+" : "+minute$+" : "+secd$
  caption 800,Chrono$
return
' ------------------------------------------------------------------------------
Visu_Score:
  if object_exists(600)=1
    show 600
    caption 600,def$(9):caption 602,def$(13)
    for x%=1 to 5:grid_write 601,1,x% ,def$(x%+13):next x%
  else
    form 600:width 600,425:height 600,210:caption 600,def$(9)
    font_name 600,"Times new roman":font_size 600,10
    command_target_is 600
    grid 601:top 601,15:left 601,5:width 601,398
    grid_column 601,5:grid_row 601,2:grid_row_height 601,20
    grid_one_column_width 601,3,80
    grid_one_column_width 601,4,100
    for x%=1 to 5:grid_write 601,1,x% ,def$(x%+13):next x%
    button 602:top 602,140:left 602,327:caption 602,def$(13):cursor_point 602
    on_double_click 601,Selection_Cellule
    on_click 602,Quit_Score
  end_if
  gosub Remp_Grid
return
' ------------------------------------------------------------------------------
Remp_Grid:
  if count(402)>0
      grid_row 601,count(402)+2
      for x%=1 to count(402)
        Donnee$=item_read$(402,x%)
        sep%=instr(Donnee$,";")
        grid_write 601,x%+1,1,left$(Donnee$,sep%-1)
        Donnee$=right$(Donnee$,len(Donnee$)-sep%)
        sep%=instr(Donnee$,";")
        grid_write 601,x%+1,2,left$(Donnee$,sep%-1)
        Donnee$=right$(Donnee$,len(Donnee$)-sep%)
        sep%=instr(Donnee$,";")
        grid_write 601,x%+1,3,left$(Donnee$,sep%-1)
        Donnee$=right$(Donnee$,len(Donnee$)-sep%)
        sep%=instr(Donnee$,";")
        grid_write 601,x%+1,4,file_extract_name$(left$(Donnee$,sep%-1))
        grid_write 601,x%+1,5,right$(Donnee$,len(Donnee$)-sep%)
      next x%
  end_if
return
' ------------------------------------------------------------------------------
Selection_Cellule:
  pos_y%=mouse_y_left_down(601):pos_x%=mouse_x_left_down(601)
  lign_sel%=GRID_Y_TO_ROW(601,pos_y%):col_sel%=GRID_X_TO_COLUMN(601,pos_x%)
  if lign_sel%=1 and col_sel%=3 then gosub Tri_Grid_Joueur
  if lign_sel%=1 and col_sel%=4 then gosub Tri_Grid_Image
  if lign_sel%=1 and col_sel%=5 then gosub Tri_Grid_record
return
' ------------------------------------------------------------------------------
Tri_Grid_Joueur:
  for x%=0 to 100:List_Nom$(x%)="":next x%
  clear 404:clear 403
  if file_exists(Dossier$+"\Joueur.Bdd")=1
      file_load 403,Dossier$+"\Joueur.Bdd"
      for x%=1 to count(403)
        Nom$=item_read$(403,x%)
        List_Nom$(x%)=Nom$
      next x%
      if count(402)>0
        Num%=0
        repeat
            Num%=Num%+1
            for x%=1 to count(402)
              Donnee$=item_read$(402,x%)
              sep%=instr(Donnee$,";")
              Tri$(1)=left$(Donnee$,sep%-1)
              Donnee$=right$(Donnee$,len(Donnee$)-sep%)
              sep%=instr(Donnee$,";")
              Tri$(2)=left$(Donnee$,sep%-1)
              Donnee$=right$(Donnee$,len(Donnee$)-sep%)
              sep%=instr(Donnee$,";")
              Tri$(3)=left$(Donnee$,sep%-1)
              Donnee$=right$(Donnee$,len(Donnee$)-sep%)
              sep%=instr(Donnee$,";")
              Tri$(4)=file_extract_name$(left$(Donnee$,sep%-1))
              Tri$(5)=right$(Donnee$,len(Donnee$)-sep%)
              if List_Nom$(Num%)=Tri$(3)
              item_add 404,Tri$(1)+";"+Tri$(2)+";"+Tri$(3)+";"+Tri$(4)+";"+Tri$(5)
              end_if
            next x%
        until Num%=count(403)
      else
        message "Il n'y a pas assez de données pour faire un tri !"
      end_if
  else
      message "La liste des joueurs n'est pas créée !"
  end_if
  gosub Remp_Grid2
return
' ------------------------------------------------------------------------------
Tri_Grid_Record:
  for x%=0 to 100:List_Nom$(x%)="":next x%
  clear 404:clear 403
  if count(402)>0
      for x%=1 to count(402)
        Donnee$=item_read$(402,x%)
        Donnee$=right$(Donnee$,12)
        sep%=instr(Donnee$,":")
        v%(1)=val(left$(trim$(Donnee$),sep%-1))*3600
        Donnee$=right$(Donnee$,len(Donnee$)-sep%)
        sep%=instr(Donnee$,":")
        v%(2)=val(trim$(left$(Donnee$,sep%-1)))*60
        v%(3)=val(trim$(right$(Donnee$,len(Donnee$)-sep%)))
        Donnee%=v%(1)+v%(2)+v%(3)
        Donnee$=str$(Donnee%)
        item_add 403,Donnee$
      next x%
      for x%=1 to count(403)
      v_record%=86400
        for z1%=1 to count(403)
            v_ligne%=item_read$(403,z1%)
            if v_ligne% < v_record%
              v_record% = v_ligne%
              v_record_Lign% = z1%
            end_if
        next z1%
        item_add 404,item_read$(402,v_record_Lign%)
        item_delete 403,v_record_Lign%
        item_insert 403,v_record_Lign%,"86400"
      next x%
  end_if
  gosub Remp_Grid2
return
' ------------------------------------------------------------------------------
Tri_Grid_Image:
  for x%=0 to 100:List_Nom$(x%)="":next x%
  clear 404:clear 403
  if count(9)>0
      for x%=1 to count(9)
        Nom$=item_read$(9,x%)
        List_Nom$(x%)=Nom$
      next x%
      if count(402)>0
        Num%=0
        repeat
            Num%=Num%+1
            for x%=1 to count(402)
              Donnee$=item_read$(402,x%)
              sep%=instr(Donnee$,";")
              Tri$(1)=left$(Donnee$,sep%-1)
              Donnee$=right$(Donnee$,len(Donnee$)-sep%)
              sep%=instr(Donnee$,";")
              Tri$(2)=left$(Donnee$,sep%-1)
              Donnee$=right$(Donnee$,len(Donnee$)-sep%)
              sep%=instr(Donnee$,";")
              Tri$(3)=left$(Donnee$,sep%-1)
              Donnee$=right$(Donnee$,len(Donnee$)-sep%)
              sep%=instr(Donnee$,";")
              Tri$(4)=file_extract_name$(left$(Donnee$,sep%-1))
              Tri$(5)=right$(Donnee$,len(Donnee$)-sep%)
              if List_Nom$(Num%)=Tri$(4)
              item_add 404,Tri$(1)+";"+Tri$(2)+";"+Tri$(3)+";"+Tri$(4)+";"+Tri$(5)
              end_if
            next x%
        until Num%=count(9)
      else
        message "Il n'y a pas assez de données pour faire un tri !"
      end_if
  else
      message "La liste des joueurs n'est pas créée !"
  end_if
  gosub Remp_Grid2
return
' ------------------------------------------------------------------------------
Remp_Grid2:
  if count(404)>0
      grid_row 601,count(404)+2
      for x%=1 to count(404)
        Donnee$=item_read$(404,x%)
        sep%=instr(Donnee$,";")
        grid_write 601,x%+1,1,left$(Donnee$,sep%-1)
        Donnee$=right$(Donnee$,len(Donnee$)-sep%)
        sep%=instr(Donnee$,";")
        grid_write 601,x%+1,2,left$(Donnee$,sep%-1)
        Donnee$=right$(Donnee$,len(Donnee$)-sep%)
        sep%=instr(Donnee$,";")
        grid_write 601,x%+1,3,left$(Donnee$,sep%-1)
        Donnee$=right$(Donnee$,len(Donnee$)-sep%)
        sep%=instr(Donnee$,";")
        grid_write 601,x%+1,4,file_extract_name$(left$(Donnee$,sep%-1))
        grid_write 601,x%+1,5,right$(Donnee$,len(Donnee$)-sep%)
      next x%
  end_if
return
' ------------------------------------------------------------------------------
Quit_Score:
  Hide 600
return
' ------------------------------------------------------------------------------
Quitter:
terminate

Sous_Creation:
  for x%=11 to 35
      if file_exists(Doss_Sprite$+"\"+str$(x%)+".bmp")=1
        file_delete Doss_Sprite$+"\"+str$(x%)+".bmp"
      end_if
  next x%
  form 600:hide 600:width 600,307:height 600,335
  command_target_is 600
  dll_on Dossier$+"\PrintScreen.dll"
  picture 606:width 606,290:height 606,290
  j%=0
  for x%=1 to 5
      if x%=1
        e%=0:f%=5:T2%=0:T3%=57
      else
        if x%=2
        e%=5:f%=10:T2%=58:T3%=115
        else
            if x%=3
            e%=10:f%=15:T2%=116:T3%=173
            else
              if x%=4
              e%=15:f%=20:T2%=174:T3%=231
              else
              e%=20:f%=25:T2%=232:T3%=289
              end_if
            end_if
        end_if
      end_if
      repeat
        e%=e%+1
        j%=j%+1
        position 701,(j% *4)
        caption 702,str$(j%*4)+" %"
        file_load 606,view$
        clipboard_copy 606
        pause 20
        res_dll2% = dll_call0("LoadPicture")
        if e%=((x%-1)*5)+1
            L2%=0
            L3%=57
        else
            if e%=((x%-1)*5)+2
              L2%=58
              L3%=115
            else
              if e%=((x%-1)*5)+3
                  L2%=116
                  L3%=173
              else
                  if e%=((x%-1)*5)+4
                    L2%=174
                    L3%=231
                  else
                    if e%=((x%-1)*5)+5
                        L2%=232
                        L3%=289
                    end_if
                  end_if
              end_if
            end_if
        end_if
        x0% = L2%
        y0% = T2%
        x1% = L3%
        y1% = T3%
        res_dll2% = dll_call4("ExtractRectangleFromPicture",x0%,y0%,x1%,y1%)
        pause 20
        res_dll2%=dll_call0("SavePicture")
        clipboard_paste 606
        file_save 606,Doss_Sprite$+"\"+str$(e%+10)+".bmp"
        pause 20
      until e%=f%
      next x%
  dll_off
if j%=25 then gosub Creation
return