[Grid_Load] petit souci

Init()
Interface()
end
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub Init()
  NbreJ_Annee()
  Init_Constantes()
  Init_Var()
  Init_Cache()
End_Sub
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub Interface()
  ' Création du formulaire
  Formulaire(0,1,"Planing Ecurie",800,500,0,0)
  ' Création du Main_menu
  Menu(0,1,6)
  ' Première ligne de sous menu
  Ss_Menu(8,2,4):Ss_Menu(12,4,3):Ss_Menu(15,5,1)
  ' Deuxième niveau de Sous menu
  Ss_Menu(16,8,3):Ss_Menu(19,9,3)
  ' Attribution des captions du menu
  Caption_Menu(1,20)
  ' Création des frames
  Frame(100,0,"Planing Ecurie",775,420,15,5)
End_Sub
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' #include "Init.bas"
' #include "Interface.bas"
' #include "MenuClic.bas"
' #include "Menu2Clic.bas"
' #include "Data.bas"
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub Conchita()
  Dim_Local x%,s$
  for x%=1 to 6:if file_exists(F$(x%))=1 then file_delete F$(x%):Next x%
  dir_change D$(4)
  s$=file_find_first$
  while s$<>"_"
      file_delete s$
      s$=file_find_first$
  end_while
  file_find_close
  dir_change D$(1)
  for x%=2 to 4:dir_remove D$(x%):next x%
  Quitter()
End_Sub
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' ¤                                INIT                                      ¤
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub Init_Constantes()
  Dim D$(4),F$(10)
  Dim_Local x%
 
  D$(1)=Dir_Current$ :D$(2)=D$(1)+"\Bdd":D$(3)=D$(1)+"\Photos":D$(4)=D$(1)+"\Sauvegardes"
  F$(1)=D$(2)+"\Effectif.Bdd":F$(2)=D$(2)+"\Personnel.Bdd":F$(3)=D$(2)+"\Annexes.Bdd"
  F$(4)=D$(2)+"\Planing.Bdd":F$(5)=D$(2)+"\Commentaires.Bdd":F$(6)=D$(2)+"\Materiel.Bdd"

  For x%=2 to 4 :if Dir_Exists(D$(x%))=0 Then Dir_Make D$(x%):Next x%
  For x%=1 to 3 :If File_Exists(F$(x%))=0 :File_Open_Write 9000,F$(x%):File_Close 9000:End_If:Next x%
  For x%=5 to 6 :If File_Exists(F$(x%))=0 :File_Open_Write 9000,F$(x%):File_Close 9000:End_If:Next x%
  If File_Exists(F$(4))=0
  File_Open_Write 9000,F$(4):File_Writeln 9000,"2":File_Writeln 9000,str$(NJ%+2):File_Close 9000
  End_If
End_Sub
' ==============================================================================
Sub Init_Var()
  Dim Tab%,CellCol%,CellLig%
  Dim Cle$,Cheval$,Site$,Tete$,Corp$,Ant$,Post$,Sulky$,Resp$
End_Sub
' ==============================================================================
Sub Init_Cache()
  Dim_Local x%
  Dlist 9001 :' Effectif
  Dlist 9002 :' personnel
  Dlist 9003 :' Annexes
  Dlist 9004 :' Planing
  Dlist 9005 :' Commentaires
  Dlist 9006 :' Materiel
  For x%=1 to 6:File_Load 9000+x%,F$(x%):Next x%
End_Sub
' ==============================================================================
Sub NbreJ_Annee()
  Dim NJ%
  Dim_Local An%
  An%=right$(Date$,4)
  If Frac(An%/4)>0 or (Frac(An%/100)>0 and Frac(An%/400)>0)
    NJ%=366
  else
    NJ%=365
  End_If
End_Sub
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' ¤                              INTERFACE                                    ¤
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub Formulaire(No%,V%,Titre$,W%,H%,T%,L%)
  if No% > 0 then Form No%
  If V%=0 then hide No%
  Command_Target_Is No%
  Width No%,W% :Height No%,H%
  if T%=0 :Top No%,(Screen_y-H%)/2 :else :Top No%,T% :end_if
  if L%=0 :Left No%,(Screen_x-W%)/2:else :Left No%,L%:end_if
  Font_Name No%,"Times new roman":Font_Size No%,10:Caption No%,Titre$
End_Sub
' ==============================================================================
Sub Menu(No%,Num%,Nbre%)
  If Label("Clic")=0 Then Label Clic
  If Variable("M%")=0 Then Dim M%
  Dim_local x%
  Command_target_is No%
  Main_menu Num%
  For x% =Num%+1 to Num%+Nbre% :Sub_menu x% :Parent x%,Num% :on_click x%,Clic
  Next x%
End_Sub
' ==============================================================================
Sub Ss_Menu(dep%,Par%,Nbre%)
    Dim_local x%
    For x%= dep% to dep%+(Nbre%-1) :Sub_menu x% : Parent x%,Par% :on_click x%,Clic
    Next x%
End_Sub
' ==============================================================================
Sub Frame(No%,V%,Titre$,W%,H%,T%,L%)
  Container No%
  if V%=1 :Show No% : Else:Hide No%:End_If
  If Titre$<>"" Then Caption No%,chr$(32)+chr$(32)+Titre$+chr$(32)+chr$(32)
  Width No%,W% :Height No%,H% :Top No%,T% :Left No%,L% :Font_Color No%,120,20,10
  Create_Grid(No%+1,100,760,300,20,5)
End_Sub
' ==============================================================================
Sub Create_Grid(No%,P%,W%,H%,T%,L%)
  If Label("Clic2")=0 then Label Clic2
  Dim_Local x%
  Grid No% : Parent No%,P% :Width No%,W% :Height No%,46+17 :Top No%,T% :Left No%,L%
  color No%,238,230,206
  Grid_Column_WIdth No%,30:Grid_Row_Height No%,20:grid_column_fixed No%,2
  Grid_One_Column_Width No%,1,100:Grid_One_Column_Width No%,2,150
  Init_Tableur(101,H%)
  On_Click No%,Clic :On_Double_Click No%,Clic2 :cursor_point No%
End_Sub
' ==============================================================================
Sub Init_Tableur(No%,H%)
  Dim_Local x$(2),x%(2)
  File_open_read 9000,F$(4):File_readln 9000,x$(1):File_readln 9000,x$(2):File_Close 9000
  x%(1)=Val(x$(1)):x%(2)=Val(x$(2))
  if x%(1)>2
    Grid_Row No%,x%(1):Grid_Column No%,x%(2):Grid_Row_Fixed No%,1
    if x%(1)<H% :height No%,(x%(1)*20)+32:else:height No%,300:end_if
    Grid_Load No%,F$(4)
  Else
    Grid_Row No%,x%(1):Grid_Column No%,x%(2):Grid_Row_Fixed No%,1
    if count(9004)>2 then Grid_Load No%,F$(4)
    Remp_GridR1(101,760)
  End_If
End_Sub
' ==============================================================================
Sub Remp_GridR1(No%,W%)
  Dim_Local x%,C12$,J$(8),y%,LongMax%,I$
  Dim_Local JSD$,JSJ%,JSM%,JSA%,JSM1%,JSA1%,JSns%,JSas%,JSf%,JSnumero%,JStext$

  grid_write No%,1,1,"Station"
  grid_write No%,1,2,"Cheval"

  C12$="01/01/"+right$(Date$,4)
  JSD$=C12$
  JSJ%=Val(Left$(JSD$,2)):JSM%=Val(Mid$(JSD$,4,2)):JSA%=Val(Right$(JSD$,4))
  if JSM%<3
        JSM1% = JSM% + 10
        JSA1% = JSA% - 1
  else
        JSM1% = JSM% - 2
        JSA1% = JSA%
  end_if
  JSns% = int(JSA1%/100)
  JSas% = JSA1% - JSns%*100
  JSf% = JSJ% + JSas% + int(JSas%/4) - 2* JSns% + int(JSns%/4) + int((26*JSM1%-2)/10)
  JSnumero% = JSf% - int(JSf%/7)*7
  select JSnumero%
  case 0: JStext$ = "D"
  case 1: JStext$ = "L"
  case 2: JStext$ = "M"
  case 3: JStext$ = "M"
  case 4: JStext$ = "J"
  case 5: JStext$ = "V"
  case 6: JStext$ = "S"
  end_select
  if JStext$="D":J$(1)="D":J$(2)="L":J$(3)="M":J$(4)="M":J$(5)="J":J$(6)="V":J$(7)="S":End_If
  if JStext$="L":J$(1)="L":J$(2)="M":J$(3)="M":J$(4)="J":J$(5)="V":J$(6)="S":J$(7)="D":End_If
  if JStext$="M":J$(1)="M":J$(2)="M":J$(3)="J":J$(4)="V":J$(5)="S":J$(6)="D":J$(7)="L":End_If
  if JStext$="M":J$(1)="M":J$(2)="J":J$(3)="V":J$(4)="S":J$(5)="D":J$(6)="L":J$(7)="M":End_If
  if JStext$="J":J$(1)="J":J$(2)="V":J$(3)="S":J$(4)="D":J$(5)="L":J$(6)="M":J$(7)="M":End_If
  if JStext$="V":J$(1)="V":J$(2)="S":J$(3)="D":J$(4)="L":J$(5)="M":J$(6)="M":J$(7)="J":End_If
  if JStext$="S":J$(1)="S":J$(2)="D":J$(3)="L":J$(4)="M":J$(5)="M":J$(6)="J":J$(7)="V":End_If
  x%=2
  LongMax%=3
  While x%<NJ%+2
      y%=0
      repeat
        x%=x%+1
        y%=y%+1
        IF LEN(J$(y%))<LongMax%
          I$=STRING$(INT((LongMax%-LEN(J$(y%))/2))," ")+J$(y%)
          GRID_WRITE No%,1,x%,I$
        ELSE
          GRID_WRITE No%,1,x%,J$(y%)
        END_IF
        If x% =Nj%+2 then exit_repeat
      until y%=7
  End_While
End_Sub
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' ¤                            MENU CLIC                                      ¤
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Clic:
  M%=Number_Click
  Select M%
      Case 3
        Affichage(100)
      Case 6
        Message "En cours de codage"
      Case 7
        if message_information_yes_no("En attendant la création du fichier Aide"+chr$(13)+"Vous êtes dans la procédure 'Conchita' qui fait le ménage derrière moi"+chr$(13)+"Etes vous sûr de vouloir tout effacer ?")=1
        Conchita()
        end_if
      Case 11
        Quitter()
      Case 12
        Message "En cours de codage"
      Case 13
        Message "En cours de codage"
      Case 14
        Message "En cours de codage"
      Case 15
        Message "En cours de codage"
      Case 16
        Ajout_Cheval(9001,101)
      Case 17
        Selection_551()
      Case 18
        Selection_501()
      Case 19
        Message "En cours de codage"
      Case 20
        Message "En cours de codage"
      Case 21
        Message "En cours de codage"
      Case 101
        Click_Grid(101)
      Case 205
        EnrgtCase()
      Case 305
        Ajout_Site(9003)
      Case 319
        Valid_Ajout_Chev(9001)
      Case 419
        Valid_Modif_400(9001)
      Case 501
        Cheval$=item_index$(501)
        hide 500
        Modif_Cheval()
      Case 551
        Cheval$=item_index$(551)
        hide 550
        Supprim_Cheval()
  End_Select
Return
' ==============================================================================
' Case 3
Sub Affichage(No%)
  if show(100)=1:hide 100:else: show 100:end_if
End_Sub
' ==============================================================================
' Case 11
Sub Quitter()
  Terminate
End_Sub
' ==============================================================================
' Case 16
Sub Ajout_Cheval(Liste%,Tableau%)
  Dim_Local x%
  If Object_Exists(300)=0
      Formulaire(300,1,"Ajouter un pensionnaire",500,530,0,0)
      alpha 301:top 301,15:left 301,10:caption 301,"Nom du cheval"
      font_color 301,120,20,10
      Edit 302 :top 302,30:left 302,10:width 302,150
      alpha 303:top 303,60:left 303,10:caption 303,"Site de stationnement"
      font_color 303,120,20,10
      Combo 304:top 304,75:left 304,10:width 304,150
      Button 305:top 305,75:left 305,165:width 305,22:height 305,22:caption 305,"+"
      cursor_point 305:on_click 305,clic
      alpha 306:top 306,60:left 306,200:caption 306,"Lad attitré":font_color 306,120,20,10
      Combo 307:top 307,75:left 307,200:width 307,150
      Alpha 308:top 308,110:left 308,10:caption 308,"Matériel":font_color 308,120,20,10
      Alpha 309:top 309,125:left 309,15:caption 309,"Tête":Font_Italic 309
      Font_name 309,"Arial":font_size 309,8:font_color 309,0,0,250
      Memo 310 :top 310,140:left 310,10:width 310,464:height 310,50
      Alpha 311:top 311,190:left 311,15:caption 311,"Corps":Font_Italic 311
      Font_name 311,"Arial":font_size 311,8:font_color 311,0,0,250
      Memo 312 :top 312,205:left 312,10:width 312,464:height 312,50
      Alpha 313:top 313,255:left 313,15:caption 313,"Antérieurs":Font_Italic 313
      Font_name 313,"Arial":font_size 313,8:font_color 313,0,0,250
      Memo 314 :top 314,270:left 314,10:width 314,464:height 314,50
      Alpha 315:top 315,320:left 315,15:caption 315,"Postèrieurs":Font_Italic 315
      Font_name 315,"Arial":font_size 315,8:font_color 315,0,0,250
      Memo 316 :top 316,335:left 316,10:width 316,464:height 316,50
      Alpha 317:top 317,385:left 317,15:caption 317,"Sulky":Font_Italic 317
      Font_name 317,"Arial":font_size 317,8:font_color 317,0,0,250
      Memo 318 :top 318,400:left 318,10:width 318,464:height 318,50
      Button 319:top 319,460:left 319,398:caption 319,"Enregistrer":cursor_point 319
      on_click 319,clic
  Else
      Show 300
  End_If
  Remp_Liste_Annexes(304)
  Remp_Liste_Lads(307)
End_Sub
' ------------------------------------------------------------------------------
Sub Remp_Liste_Annexes(No%)
  Dim_Local x%
  Clear No%
  If count(9003)>0
      For x%=1 to count(9003):Item_add No%,Item_read$(9003,x%):Next x%
  End_If
End_Sub
' ------------------------------------------------------------------------------
Sub Remp_Liste_Lads(No%)
  Dim_Local x%
  Clear No%
  If count(9002)>0
      For x%=1 to count(9002):Item_add No%,Item_read$(9002,x%):Next x%
  End_If
End_Sub
' ==============================================================================
' Case 17
Sub Selection_551()
  if object_exists(550)=0
      formulaire(550,1,"Choix",200,300,0,0)
      List 551:width 551,184:height 551,260:cursor_point 551:font_color 551,0,0,250
      on_click 551,clic
  else
      show 550
  end_if
  Clear 551
  Remp_Liste_Chevaux(551)
  Sort_on 551
End_Sub
' ==============================================================================
' case 551
Sub Supprim_Cheval()
  dim_local x%,line_L%,line_G%,sep%,i$,jj$,mm$,aa$,Save$,Sg$,Snum%,Sd$
  if count(9001)>0
      for x%=1 to count(9001)
        i$=item_read$(9001,x%):sep%=instr(i$,"|"):i$=right$(i$,len(i$)-sep%):sep%=instr(i$,"|"):i$=left$(i$,sep%-1)
        if i$=Cheval$ :Line_L%=x% :exit_for:end_if
      next x%
      for x%=1 to count(9001)
        if grid_read$(101,x%+1,2)=Cheval$:Line_G%=x%+1:exit_for:end_if
      next x%
      jj$=left$(date$,2):mm$=mid$(date$,4,2):aa$=right$(date$,4)

      Save$=D$(4)+"\Save_"+jj$+"_"+mm$+"_"+aa$+".Bdd"
      if file_exists(Save$)=1
        Save$=left$(Save$,len(save$)-4)+"(2).Bdd"
        if file_exists(Save$)=1
            sep%=instr(Save$,"(")
            Sg$=left$(Save$,Sep%-1)
            Sd$=right$(Save$,len(Save$)-sep%)
            sep%=instr(Sd$,")")
            Snum%=val(left$(Sd$,sep%-1))
            Snum%=Snum%+1
            Save$=Sg$+"("+str$(Snum%)+").Bdd"
        end_if
      end_if
      Grid_Save 101,Count(9001)+1,NJ%+2,Save$
     
      Item_delete 9001,Line_L%
      Grid_row_delete 101,Line_G%

      file_save 9001,F$(1)
      Grid_Save 101,Count(9001)+1,NJ%+2,F$(4)
      Cheval$=""

      pause 1000
      if count(9001)=0
        clear 9004:message count(9004) :' effacement du dlist contenant le contenu du grid
        file_delete F$(4):if file_exists(F$(4))=0 then message "Ok" : ' destruction du fichier F$(4) qui est le save du grid
        item_add 9004,2:item_add 9004,NJ%+2:file_save 9004,F$(4):pause 1000: ' remise en mémoire des infos initiales du grid et sauvegarde en F$(4)
        Init_Tableur(101,300) :' Je repasse par l'init du grid qui lit les deux premières lignes du fichier F$(4) pour les dimensions et si plus de deux lignes load la sauvegarde F$(4)
      end_if
  End_if
End_Sub
' ==============================================================================
' Case 18
Sub Selection_501()
  if object_exists(500)=0
      formulaire(500,1,"Choix du pensionnaire",200,300,0,0)
      List 501:width 501,184:height 501,260:cursor_point 501:font_color 501,0,0,250
      on_click 501,clic
  else
      show 500
  end_if
  Clear 501
  Remp_Liste_chevaux(501)
  sort_on 501
End_Sub
' ------------------------------------------------------------------------------
Sub Remp_Liste_chevaux(No%)
  Dim_Local x% ,i$,sep%,t$
  if count(9001)>0
      for x%=1 to count(9001)
        i$=item_read$(9001,x%)
        sep%=instr(i$,"|")
        i$=right$(i$,len(i$)-sep%)
        sep%=instr(i$,"|")
        i$=left$(i$,sep%-1)
        item_add No%,i$
      next x%
  end_if
ENd_Sub
' ==============================================================================
' case 501
Sub Modif_Cheval()
  Dim_Local Titre$
      Titre$="Modifier la fiche d'un pensionnaire"
  if object_exists(400)=0
      formulaire(400,1,Titre$,500,530,0,0)
      alpha 401:top 401,20:left 401,10:caption 401,"Nom du cheval"
      font_size 401,14:font_color 401,120,20,10
      alpha 403:top 403,60:left 403,10:caption 403,"Site de stationnement"
      font_color 403,120,20,10
      Combo 404:top 404,75:left 404,10:width 404,150
      alpha 406:top 406,60:left 406,200:caption 406,"Lad attitré":font_color 406,120,20,10
      Combo 407:top 407,75:left 407,200:width 407,150
      Alpha 408:top 408,110:left 408,10:caption 408,"Matériel":font_color 408,120,20,10
      Alpha 409:top 409,125:left 409,15:caption 409,"Tête":Font_Italic 409
      Font_name 409,"Arial":font_size 409,8:font_color 409,0,0,250
      Memo 410 :top 410,140:left 410,10:width 410,464:height 410,50
      Alpha 411:top 411,190:left 411,15:caption 411,"Corps":Font_Italic 411
      Font_name 411,"Arial":font_size 411,8:font_color 411,0,0,250
      Memo 412 :top 412,205:left 412,10:width 412,464:height 412,50
      Alpha 413:top 413,255:left 413,15:caption 413,"Antérieurs":Font_Italic 413
      Font_name 413,"Arial":font_size 413,8:font_color 413,0,0,250
      Memo 414 :top 414,270:left 414,10:width 414,464:height 414,50
      Alpha 415:top 415,320:left 415,15:caption 415,"Postèrieurs":Font_Italic 415
      Font_name 415,"Arial":font_size 415,8:font_color 415,0,0,250
      Memo 416 :top 416,335:left 416,10:width 416,464:height 416,50
      Alpha 417:top 417,385:left 417,15:caption 417,"Sulky":Font_Italic 417
      Font_name 417,"Arial":font_size 417,8:font_color 417,0,0,250
      Memo 418 :top 418,400:left 418,10:width 418,464:height 418,50
      Button 419:top 419,460:left 419,398:caption 419,"Enregistrer":cursor_point 419
      on_click 419,clic
  Else
      Show 400
  End_if
  Remp_Liste_Annexes(404)
  Remp_Liste_Lads(407)
  Remp_Form_400()
End_Sub
' ------------------------------------------------------------------------------
Sub Remp_Form_400()
  dim_local x%,line%,i$,sep%
  for x% =1 to count(9001)
      i$=item_read$(9001,x%):sep%=instr(i$,"|"):i$=right$(i$,len(i$)-sep%):sep%=instr(i$,"|"):i$=left$(i$,sep%-1)
      If i$=Cheval$
        Line%=x%
        i$=item_read$(9001,x%) :sep%=instr(i$,"|"):cle$=left$(i$,sep%-1)
        i$=right$(i$,len(i$)-sep%):sep%=instr(i$,"|"):Cheval$=left$(i$,sep%-1)
        i$=right$(i$,len(i$)-sep%):sep%=instr(i$,"|"):Site$=left$(i$,sep%-1)
        i$=right$(i$,len(i$)-sep%):sep%=instr(i$,"|"):Tete$=left$(i$,sep%-1)
        i$=right$(i$,len(i$)-sep%):sep%=instr(i$,"|"):Corp$=left$(i$,sep%-1)
        i$=right$(i$,len(i$)-sep%):sep%=instr(i$,"|"):Ant$=left$(i$,sep%-1)
        i$=right$(i$,len(i$)-sep%):sep%=instr(i$,"|"):Post$=left$(i$,sep%-1)
        i$=right$(i$,len(i$)-sep%):sep%=instr(i$,"|"):Sulky$=left$(i$,sep%-1)
        i$=right$(i$,len(i$)-sep%):sep%=instr(i$,"|"):Resp$=left$(i$,sep%-1)
        Exit_for
      end_if
  next x%
  Caption 401,Cheval$
  text 404,Site$
  if Resp$<>"0" then text 407,Resp$
  if Tete$<>"0" then text 410,Tete$
  if Corp$<>"0" then text 412,Corp$
  if Ant$<>"0" then text 414,Ant$
  if Post$<>"0" then text 416,Post$
  if Sulky$<>"0" then text 418,Sulky$
End_Sub
' ==============================================================================
' Case 19

' ==============================================================================
' Case 101
Sub Click_Grid(No%)
  Dim_Local x%,y%,lig%,col%,G%
  y% = mouse_y_left_down(No%)
  x% = mouse_x_left_down(No%)
  lig% = grid_y_to_row(No%,y%)
  col% = grid_x_to_column(No%,x%)
  G%=No%
  If col%>2 and lig%>1 Then Modif_Cell(G%,lig%,col%)
End_Sub
' ------------------------------------------------------------------------------
Sub Modif_Cell(G%,R%,C%)
  Datejour(C%)
  if object_exists(200)=0
    formulaire(200,1,"Modifier",310,240,0,0)
    Alpha 201:Top 201,5:Left 201,210:font_color 201,0,0,255
    Alpha 202:Top 202,30:Left 202,10:font_color 202,130,20,10:font_size 202,14
    Alpha 203:Top 203,55:Left 203,10:Caption 203,"Activité(s)"
    Combo 204:Top 204,75:Left 204,30:Width 204,50
    Item_add 204,""
    item_add 204,"T"
    item_add 204,"P"
    item_add 204,"J"
    item_add 204,"B"
    item_add 204,"C"
    memo 206:top 206,75:left 206,90 :Width 206,200:bar_vertical 206
    Alpha 207:top 207,55:left 207,90:caption 207,"Commentaires"
    Button 205:Top 205,170:Left 205,213:Caption 205,"Enregistrer":On_Click 205,Clic
    Cursor_Point 205
  Else
    Show 200
  End_If
  Caption 201,dd$ :Caption 202,Grid_Read$(G%,R%,2)
  Tab%=G% :CellCol%=C% :CellLig%=R%
End_Sub
' ------------------------------------------------------------------------------
Sub DateJour(numjour%)
    dim_local jj%,mm%,aa%,jj$,mm$,aa$,c%,d%
    if variable("dd$")=0 then dim dd$
    numjour%=numjour%-2
    if NJ%=365
      if numjour% >0 and numjour% <=31:jj%=numjour% :mm%=1:end_if
      if numjour% >31 and numjour% <=59:jj%=numjour%-31:mm%=2:end_if
      if numjour% >59 and numjour% <=90:jj%=numjour%-59:mm%=3:end_if
      if numjour% >90 and numjour% <=120:jj%=numjour%-90:mm%=4:end_if
      if numjour% >120 and numjour% <=151:jj%=numjour%-120:mm%=5:end_if
      if numjour% >151 and numjour% <=181:jj%=numjour%-151:mm%=6:end_if
      if numjour% >181 and numjour% <=212:jj%=numjour%-181:mm%=7:end_if
      if numjour% >212 and numjour% <=243:jj%=numjour%-212:mm%=8:end_if
      if numjour% >243 and numjour% <=273:jj%=numjour%-243:mm%=9:end_if
      if numjour% >273 and numjour% <=304:jj%=numjour%-273:mm%=10:end_if
      if numjour% >304 and numjour% <=334:jj%=numjour%-304:mm%=11:end_if
      if numjour% >334 and numjour% <=365:jj%=numjour%-334:mm%=12:end_if
    else
      if numjour% >=1 and numjour% <=31:jj%=numjour% :mm%=1:end_if
      if numjour% >=32 and numjour% <=60:jj%=numjour%-31:mm%=2:end_if
      if numjour% >=61 and numjour% <=91:jj%=numjour%-60:mm%=3:end_if
      if numjour% >=92 and numjour% <=121:jj%=numjour%-91:mm%=4:end_if
      if numjour% >=122 and numjour% <=152:jj%=numjour%-121:mm%=5:end_if
      if numjour% >=153 and numjour% <=182:jj%=numjour%-152:mm%=6:end_if
      if numjour% >=183 and numjour% <=213:jj%=numjour%-182:mm%=7:end_if
      if numjour% >=214 and numjour% <=244:jj%=numjour%-213:mm%=8:end_if
      if numjour% >=245 and numjour% <=274:jj%=numjour%-244:mm%=9:end_if
      if numjour% >=275 and numjour% <=305:jj%=numjour%-274:mm%=10:end_if
      if numjour% >=306 and numjour% <=335:jj%=numjour%-305:mm%=11:end_if
      if numjour% >=336 and numjour% <=366:jj%=numjour%-335:mm%=12:end_if
    end_if

    if len(str$(jj%))<2 :jj$="0"+str$(jj%):else:jj$=str$(jj%):end_if
    if len(str$(mm%))<2 :mm$="0"+str$(mm%):else:mm$=str$(mm%):end_if
    aa$=Right$(date$,4)
    dd$=jj$+"/"+mm$+"/"+aa$
End_Sub
' ==============================================================================
' Case 205
Sub EnrgtCase()
  Dim_Local T$
  T$=Text$(204)
  Grid_Write Tab%,CellLig%,CellCol%,T$
  Tab%=0 :CellLig%=0 :CellCol%=0 :T$=""
  if Grid_read$(101,2,2)=""
      If message_warning_yes_no("La 'base effectif' est vide !"+chr$(13)+"Vous devez commencer par ajouter un pensionnaire,"+Chr$(13)+"Voulez vous l'ajouter maintenant ?")=1
        Ajout_Cheval(9001,101)
      End_If
  Else
      Grid_Save 101,Count(9001)+1,NJ%+2,F$(4)
  End_If
  Hide 200
End_Sub
' ==============================================================================
' Case 305
Sub Ajout_Site(Liste%)
  Dim_Local Lieu$
  if message_input("Sites de Stationnement","Site :","")=1
      Lieu$=message_text$
      item_add Liste%,Lieu$
      file_save Liste%,F$(3)
      Remp_Liste_Annexes(304)
  End_If
End_Sub
' ==============================================================================
' Case 319
Sub Valid_Ajout_Chev(Liste%)
  Dim_Local x%,r%,H%
  if count(Liste%)=0: r%=2: else: r%=count(Liste%)+2:end_if
  x%=count(Liste%)+1

  Cle$=Str$(x%):Cheval$=Text$(302)
  if text$(304)<>"":Site$=text$(304) :else:Site$="Ecurie" :End_If
  if text$(310)<>"":Tete$=text$(310) :else:Tete$="0" :End_If
  if text$(312)<>"":Corp$=text$(312) :else:Corp$="0" :End_If
  if text$(314)<>"":Ant$=text$(314)  :else:Ant$="0"  :End_If
  if text$(316)<>"":Post$=text$(316) :else:Post$="0" :End_If
  if text$(318)<>"":Sulky$=text$(318):else:Sulky$="0":End_If
  if text$(307)<>"":Resp$=text$(307) :else:Resp$="0" :End_If
 
  Item_Add Liste%,Cle$+"|"+Cheval$+"|"+Site$+"|"+Tete$+"|"+Corp$+"|"+Ant$+"|"+Post$+"|"+Sulky$+"|"+Resp$+"|0|"

  If Object_Exists(101)=1
      Grid_row 101,r% :Grid_write 101,r%,2,Cheval$:Grid_Write 101,r%,1,Site$
      H%=(r%*20)+32 :if H%<300:height 101,H%:else:Height 101,300:end_if
  end_if

  File_Save Liste%,F$(1)
  Grid_Save 101,Count(9001)+1,NJ%+2,F$(4)
  Cle$="":Cheval$="":Site$="":Tete$="":Corp$="":Ant$="":Post$="":Sulky$=""
  Hide 300
End_Sub
' ==============================================================================
' Case 419
Sub Valid_Modif_400(liste%)
  dim_local x%
  if text$(404)<>"":Site$=text$(404) :else:Site$="Ecurie" :End_If
  if text$(410)<>"":Tete$=text$(410) :else:Tete$="0" :End_If
  if text$(412)<>"":Corp$=text$(412) :else:Corp$="0" :End_If
  if text$(414)<>"":Ant$=text$(414)  :else:Ant$="0"  :End_If
  if text$(416)<>"":Post$=text$(416) :else:Post$="0" :End_If
  if text$(418)<>"":Sulky$=text$(418):else:Sulky$="0":End_If
  if text$(407)<>"":Resp$=text$(407) :else:Resp$="0" :End_If
  For x%=1 to count(9001)
      if grid_read$(101,x%+1,2)=Cheval$
        Grid_write 101,x%+1,1,Site$
        exit_for
      end_if
  next x%
  File_Save Liste%,F$(1)
  Grid_Save 101,Count(9001)+1,NJ%+2,F$(4)
  Cle$="":Cheval$="":Site$="":Tete$="":Corp$="":Ant$="":Post$="":Sulky$=""
  Hide 400
End_SUb
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' ¤                            MENU 2 CLIC                                    ¤
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Clic2:
Return
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' ¤                            DATA MENU                                      ¤
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub Caption_Menu(R%,N%)
  Dim_local M$,x%,def$(N%)
  Restore
  Read M$
  While M$<>"Menu"+str$(R%)
  Read M$
  End_While
  For x%=1 to N% :Read def$(x%): caption R%+x%,def$(x%):Next x%
End_Sub

Data "Menu1"
Data "Fichiers"
Data "Planing"
Data "Outils"
Data "Options"
Data "A Propos..."
Data "Aide"
Data "Effectif"
Data "Personnel"
Data "---------"
Data "Quitter"
Data "Créer une fiche de travail"
Data "Exporter une fiche"
Data "Imprimer une Fiche"
Data "Langue"
Data "Ajouter"
Data "Supprimer"
Data "Modifier"
Data "Ajouter"
Data "Supprimer"
Data "Modifier"

' case 551
Sub Supprim_Cheval()
  dim_local x%,line_L%,line_G%,sep%,i$,jj$,mm$,aa$,Save$,Sg$,Snum%,Sd$
  if count(9001)>0
      for x%=1 to count(9001)
        i$=item_read$(9001,x%):sep%=instr(i$,"|"):i$=right$(i$,len(i$)-sep%):sep%=instr(i$,"|"):i$=left$(i$,sep%-1)
        if i$=Cheval$ :Line_L%=x% :exit_for:end_if
      next x%
      for x%=1 to count(9001)
        if grid_read$(101,x%+1,2)=Cheval$:Line_G%=x%+1:exit_for:end_if
      next x%
      jj$=left$(date$,2):mm$=mid$(date$,4,2):aa$=right$(date$,4)

      Save$=D$(4)+"\Save_"+jj$+"_"+mm$+"_"+aa$+".Bdd"
      if file_exists(Save$)=1
        Save$=left$(Save$,len(save$)-4)+"(2).Bdd"
        if file_exists(Save$)=1
            sep%=instr(Save$,"(")
            Sg$=left$(Save$,Sep%-1)
            Sd$=right$(Save$,len(Save$)-sep%)
            sep%=instr(Sd$,")")
            Snum%=val(left$(Sd$,sep%-1))
            Snum%=Snum%+1
            Save$=Sg$+"("+str$(Snum%)+").Bdd"
        end_if
      end_if
      Grid_Save 101,Count(9001)+1,NJ%+2,Save$
      if count(9001)=1
        item_delete 9001,Line_L%
        clear 9004:file_delete F$(4):item_add 9004,2:item_add 9004,NJ%+2:file_save 9004,F$(4)
        delete 101
        Create_Grid(101,100,760,300,20,5)
      else
        Item_delete 9001,Line_L%
        Grid_row_delete 101,Line_G%
        file_save 9001,F$(1)
        Grid_Save 101,Count(9001)+1,NJ%+2,F$(4)
        Cheval$=""
      end_if
  End_if
End_Sub

n_lignes% = 1
s$ = GRID_READ$(g%,n_lignes%,1)
while s$<>""
  n_lignes% = n_lignes% + 1
  s$ = GRID_READ$(g%,n_lignes%,1)
end_while
n_lignes% = n_lignes% - 1