Probleme avec une procedure

Sujet: Probleme avec une procedure Dim 28 Oct 2012 - 1:02

J' utilise 2 fois la procédure Remp_GridR1(No%,W%)

la première fois pour remplir la première ligne du Grid 101 (Planing)
la deuxième fois pour celle du Grid 801 (Options/Sauvegarde/Visualiser).

la première fois tout ce passe bien mais la deuxième...
affraid

"Not logical expression : -line 187"

Quelqu' un voit il quelque chose qui m'échappe ?

Code:: 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,2):Ss_Menu(21,10,2):Ss_Menu(23,15,2)
' Attribution des captions du menu
Caption_Menu(1,23)
' 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
APP()
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 16
Ajout_Cheval(9001,101)
Case 17
Selection_551()
Case 18
Selection_501()
Case 19
Ajout_Item_Liste(9002)
Case 20
Supprim_Item_List(9002," un Salarié")
Case 21
Ajout_Item_Liste(9003)
Case 22
Supprim_Item_List(9003," une Annexe")
Case 23
Sauvegarde_grid(101)
Case 24
Visu_Save_Grid()
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()
Case 601
Clear_Liste(601,Listing%)
Case 756
Valid_756()
End_Select
Return
' ==============================================================================
' Case 3
Sub Affichage(No%)
if show(100)=1:hide 100:else: show 100:end_if
End_Sub
' ==============================================================================
' Case 6
Sub APP()
if object_exists(610)=0
Formulaire(610,1,"A Propos...",350,200,0,0)
Alpha 611:top 611,20:left 611,10:caption 611,"Cette application a été créée avec :"
font_color 611,120,20,10
Alpha 612:top 612,50:left 612,50:Caption 612,"PANORAMIC EDITOR"
font_size 612,16:font_name 612,"Arial":font_bold 612:font_color 612,0,0,250
Alpha 613:top 613,95:left 613,120:caption 613,"Par Ygeronimi"
alpha 614:top 614,120:left 614,70:caption 614,"Avec le concours des Panoramiciens"
else
show 610
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$
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
' ==============================================================================
' 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 et Case 21
Sub Ajout_item_Liste(Liste%)
dim_local t$
if Liste%=9003:t$="Nom du Site :":else:t$="Nom du Salarié :":End_if
if message_input("Ajouter un salarié",t$,"")=1
item_add Liste%,message_text$
file_save Liste%,F$(Liste%-9000)
end_if
End_Sub
' ==============================================================================
' Case 20 et Case 22
Sub Supprim_Item_List(Liste%,Titre$)
if variable("Listing%")=0 then dim Listing%
Listing%=Liste%
if object_exists(600)=0
Formulaire(600,1,"Supprimer"+Titre$,200,300,0,0)
List 601:width 601,184:height 601,260:cursor_point 601:font_color 601,0,0,250
on_click 601,clic
else
show 600:Caption 600,"Supprimer"+Titre$
end_if
Remp_List_601(601,Liste%)
End_Sub
' ------------------------------------------------------------------------------
Sub Remp_List_601(No%,Liste%)
dim_local x%
Clear No%
If count(Liste%)>0
for x%=1 to count(Liste%):item_add No%,item_read$(Liste%,x%):next x%
end_if
End_Sub
' ==============================================================================
' Case 23
Sub Sauvegarde_Grid(No%)
Dim_local Save$,jj$,mm$,aa$,sep%,Snum%,Sg$,Sd$
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$
End_Sub
' ==============================================================================
Sub Visu_Save_Grid()
Dim_local Fichier$,Col%,Lig%,nom$
open_dialog 9000
dir_dialog 9000,D$(4)
filter 9000,"*.Bdd|*.Bdd"
Fichier$=File_name$(9000)
delete 9000
file_open_read 9000,Fichier$ :file_readln 9000,Lig% :file_readln 9000,Col% :file_close 9000
nom$=file_extract_name$(Fichier$)
nom$=mid$(nom$,6,2)+"/"+mid$(nom$,9,2)+"/"+mid$(nom$,12,4)
if object_exists(800)=0
Formulaire(800,1,"Archive du "+nom$,700,350,0,0)
grid 801
else
Show 800
end_if
Init_grid_801(Col%,Lig%)
Remp_GridR1(801,684)
grid_load 801,Fichier$
End_Sub
' ------------------------------------------------------------------------------
Sub Init_grid_801(Col%,Lig%)
width 801,684:height 801,312:grid_row_height 801,20:grid_column_width 801,30
grid_row 801,Lig% :Grid_column 801,Col% :grid_column_fixed 801,2
grid_one_column_width 801,1,100:grid_one_column_width 801,2,150
End_Sub
' ==============================================================================
' 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$="":Resp$=""
Hide 400
End_Sub
' ==============================================================================
' Case 601
Sub Clear_Liste(No%,Listing%)
dim_local Item$,x%
Item$=item_index$(No%)
for x% =1 to count(Listing%)
If item_read$(Listing%,x%)=Item$
Item_delete Listing%,x%
File_save Listing%,F$(Listing%-9000)
exit_for
end_if
next x%
hide 600
End_Sub
' ==============================================================================
' Case 756
Sub Valid_756()
dim_local i$
Site$=text$(755)
i$=Cle$+"|"+Cheval$+"|"+Site$+"|"+Tete$+"|"+Corp$+"|"+Ant$+"|"+Post$+"|"+Sulky$+"|"+Resp$+"|0|"
Grid_write 101,L%,C%,Site$
Grid_Save 101,Count(9001)+1,NJ%+2,F$(4)
Item_delete 9001,L1%
Item_insert 9001,L1%,i$
file_save 9001,F$(1)
Cle$="":Cheval$="":Site$="":Tete$="":Corp$="":Ant$="":Post$="":Sulky$="":Resp$=""
hide 750
End_Sub
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' ¤ MENU 2 CLIC ¤
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Clic2:
If Variable("DClic%")=0 Then Dim DClic%
DClic%=Number_Double_Click
Select DClic%
case 101
Selection_101(101)
End_Select
Return
' ------------------------------------------------------------------------------
Sub Selection_101(No%)
Dim_Local x%,y%,lig%,col%,G%,Nom$
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
Nom$=Grid_Read$(No%,lig%,col%)
Materiel(Nom$)
end_if
if col%=1 and lig%>1
Nom$=Grid_Read$(No%,lig%,col%)
Change_site(Nom$,col%,lig%)
end_if
End_Sub
' ==============================================================================
' Case entête colonne 1 (en cours de reflexion)
' ==============================================================================
' Case entête colonne 2 (en cours de reflexion)
' ==============================================================================
' Case colonne1
Sub Change_Site(Nom$,Col%,lig%)
if variable("C%")= 0 then dim C%
if variable("L%")= 0 then dim L%
C%=col% :L%=lig%
If object_exists(750)=0
formulaire(750,1,"Changement de station",350,200,0,0)
Alpha 751:top 751,15:left 751,10:font_color 751,120,20,10:font_size 751,14
Alpha 752:top 752,40:left 752,10:font_color 752,0,0,250:caption 752,"Station actuelle :"
Alpha 753:top 753,40:left 753,110
Alpha 754:top 754,70:left 754,75:font_color 754,0,0,250:caption 754,"Nouvelle station"
Combo 755:top 755,85:left 755,75:width 755,200
Button 756:top 756,130:left 756,250:caption 756,"Enregistrer":on_click 756,clic
else
show 750
end_if
Remp_Liste_Annexes(755)
Selection_Cheval(lig%)
End_Sub
' ------------------------------------------------------------------------------
Sub Selection_Cheval(lig%)
if variable("L1%")= 0 then dim L1%
dim_local item$,i$,sep%,x%
item$=grid_read$(101,lig%,2)
if count(9001)>0
for x%=1 to count(9001)
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)
if item$=Cheval$ then exit_for
next x%
caption 751,Cheval$
caption 753,Site$
L1%=x%
end_if
End_Sub
' ==============================================================================
' Case colonne2
Sub Materiel(Nom$)
if label("Activation")=0 then label Activation
Dim_Local C$,titre$
C$=Nom$
if object_exists(700)=0
titre$="Matériel "+C$
Formulaire(700,1,titre$,450,700,0,0)
font_color 700,130,20,10
alpha 701:top 701,7:Left 701,10:caption 701,"Tête"
Memo 702 :top 702,25:left 702,10:width 702,414:height 702,100:color 702,238,230,206
font_color 702,0,0,255:on_change 702,Activation
alpha 703:top 703,132:left 703,10:caption 703,"Corps"
memo 704:top 704,150:left 704,10:width 704,414:height 704,100:color 704,238,230,206
font_color 704,0,0,255:on_change 704,Activation
alpha 705:top 705,257:left 705,10:caption 705,"Anterieurs"
memo 706:top 706,275:left 706,10:width 706,414:height 706,100:color 706,238,230,206
font_color 706,0,0,255:on_change 706,Activation
alpha 707:top 707,382:left 707,10:caption 707,"Posterieurs"
memo 708:top 708,400:left 708,10:width 708,414:height 708,100:color 708,238,230,206
font_color 708,0,0,255:on_change 708,Activation
alpha 709:top 709,507:left 709,10:caption 709,"Sulky"
memo 710:top 710,525:left 710,10:width 710,414:height 710,100:color 710,238,230,206
font_color 710,0,0,255:on_change 710,Activation
Button 711:top 711,630:left 711,262:width 711,160
Caption 711,"Enregistrer les modifications":cursor_point 711
on_click 711,Clic
Else
Show 700
End_If
Remp_matos(700,C$,702,704,706,708,710)
hide 711:inactive 711
End_Sub
' ------------------------------------------------------------------------------
Activation:
show 711:Active 711
return
' ------------------------------------------------------------------------------
Sub Remp_Matos(No%,C$,Tete%,Corp%,Ant%,Post%,Sulky%)
Dim_Local x% ,I$,sep%
While count(9001)>x%
x%=x%+1
If x% >count(9001) then exit_while
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)
if Cheval$=C$ Then Exit_While
End_While
if Tete$<>"0" then Item_add Tete%,Tete$
if Corp$<>"0" then Item_add Corp%,Corp$
if Ant$<>"0" then Item_add Ant%,Ant$
if Post$<>"0" then Item_add Post%,Post$
if Sulky$<>"0" then Item_add Sulky%,Sulky$
End_Sub
' ------------------------------------------------------------------------------
Sub Chgt_matos(No%)
Dim_Local x%,sep%,I$
if Tete$<>"" :Tete$=text$(Tete%) :else:Tete$="0" :end_if
if Corp$<>"" :Corp$=text$(Corp%) :else:Corp$="0" :end_if
if Ant$<>"" :Ant$=text$(Ant%) :else:Ant$="0" :end_if
if Post$<>"" :Post$=text$(Post%) :else:Post$="0" :end_if
if Sulky$<>"":Sulky$=text$(Sulky%) :else:Sulky$="0":end_if
while count(9000)>x%
x%=x%+1
I$=item_read$(9001,x%)
sep%=instr(I$,"|")
I$=left$(I$,sep%-1)
if Cle$=I$
I$=Cle$+"|"+Cheval$+"|"+Site$+"|"+Tete$+"|"+Corp$+"|"+Ant$+"|"+Post$+"|"+Sulk$+"|"+Resp$+"|0|"
item_delete 9001,x%
item_insert 9001,x%,I$
file_save 9001,file$(1)
exit_while
end_if
end_while
End_Sub
' ==============================================================================
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' ¤ 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 "Annexes"
Data "Quitter"
Data "Créer une fiche de travail"
Data "Exporter une fiche"
Data "Imprimer une Fiche"
Data "Sauvegardes"
Data "Ajouter"
Data "Supprimer"
Data "Modifier"
Data "Ajouter"
Data "Supprimer"
Data "Ajouter"
Data "Supprimer"
Data "Créer"
Data "Visualiser"

Sujet: re Dim 28 Oct 2012 - 1:17

J'ai mis un "message JSText$" juste avant la ligne incriminée
pour connaitre la valeur de cette variable avant mon premier "if"

Premier message ( pour grid 101 ) "D" : Normal
Deuxième message ( pour grid 801 ) "D" : Normal

mais là affraid

Troisième message ( je ne sais pourquoi ou pour qui scratch

) "JSText$" Suspect

Edit : Et, je ne suis pas victime d'un double processus ... Suspect

Edit : J'ai trouvé un palliatif avec un "On_Error_Goto Vide" avec "Vide: Return" mais c'est louche cette histoire Suspect

Sujet: Re: Probleme avec une procedure Dim 28 Oct 2012 - 10:11

Bonjour ygeronimi,
J'ai copié ton code, j'ai fais collé dans l'éditeur et j'ai lancé...
que faut-il faire ensuite pour avoir ton message ?
Car là, je suis un peu paumé...

Sujet: Re: Probleme avec une procedure Dim 28 Oct 2012 - 10:27

Dur, dur, en effet.
Tu balances un code de presque 1000 lignes en disant "il y a une erreur"

Comme Nardo,
1 - j'ai mis "message JSText$" à la ligne 186,
2 - je l'ai lancé,
3 - j'ai obtenu "D" par le message,
mais après, que doit-on faire pour reproduire ton erreur ?

Tout ce que je peux dire, c'est que JSText$ est une variable locale à Sub Remp_GridR1.
Que si message JSText$ te donne JSText$, c'est que la variable locale a disparu (par exécution de END_SUB ou EXIT_SUB)

En effet,
message JSText$ donne:
- le CONTENU de la variable JSText$ si elle existe,
- et dans le cas contraire, la chaine de caractères JSText$

Invité

Bonjour,
Voila un code que j'aurai pu examiné avant, mais maintenant je ne le fais plus. Pourquoi?
Tu nous mets un source, sans nous dire ce qu'il contient. J'ai ordi tout neuf que je veux gardé propre, et tu donnes du code avec je crois des créations de fichiers et de dossiers sans nous prévenir, et sans savoir où ils ont étés créés.
Il faut dès le départ faire une analyse , aller dans tout le programme, pour essayer de comprendre ce que fait le programme. Je sais que tu suis les directives de Klaus, quant à la méthode des déclarations. C'est très bien, mais je ne l'aime pas. (la méthode bien sûre, et non Klaus qui se donne bien du mal). Car elle ne facilite pas la lecture. On ne voit pas les variables avec les noms des fichiers qui y sont déclarées. On a un envoi à un sub, qui lui-même envoi à un sub, ..., donc dès le départ il faut parcourir le code. Pour pagiciel, j'ai fait ainsi: les variables et les labels sont visibles de suite. On voit les noms des fichiers et des dossiers. Si on lance celui-ci, et qu'il ne plait pas, on supprime simplement le dossier pagiciel. Dans un programme comme le tien il faudrait pouvoir faire pareil. Peut-être que c'est le cas, mais ce n'est pas précisé.

Je suis désolé pour ces remarques, mais tu comprendras pourquoi je n'intervient plus.

Sujet: re Dim 28 Oct 2012 - 14:35

On se calme!... Laughing

le code source est un gestionnaire d' écurie multi station.
Il arrive, et les fannas du turf le savent, qu'un entraineur aient des chevaux sur plusieurs endroits
avec des responsables qui appliquent ses "ordres" pendant que lui est ailleurs.
Le plus dur est la communication, malgrès les portables, et j'ai créé cet utilitaire pour pouvoir laisser
en poste restante sur un compte mydrive un fichier qui contienne le planing de travail de l'écurie
avec le matériel propre à chaque cheval ainsi, l' écurie distante peut récupérer la fiche de travail
et un nouvel employé n'a pas à attendre la présence d'un ancien pour savoir quel est le matériel ( harnachement )
est nécessaire pour le travail d'un cheval.

@ Nardo26 et Cosmos70,

J'ai inclus une procédure "Conchita" que l'on atteint par "Aide" en attendant que j'ai créé celle ci.
"Conchita" nettoie tout les fichiers et dossiers créés dans le répertoire utilisé .
on place le source dans (par exemple) Ygeronimi_sources, on force comme d'hab... l'éditeur en ré enregistrant par sauver
et on lance.
on fait ce que l'on a à faire et si on veut se débarasser des fichiers et dossiers on clic sur Aide dans le menu et là
"Conchita" se met au boulot, il ne reste plus que le source.

@ Jack,

On lance le source
on a un premier message qui donne "D" en créant le premier Grid qui est l'objet n° 101
on crée un cheval dans sa base (Fichier/Effectif/Ajouter)
on crée une sauvegarde par (Options/Sauvegardes/Créer)
puis on veut l'atteindre et la visualiser ( Options/Sauvegardes /Visualiser)
la on a la création d'une fenêtre avec un deuxième grid pour visualiser la sauvegarde (créée avec grid_save)
mais là...mais là.... affraid

on a bien notre message qui renvoie "D"
mais un autre ( qui n'a aucune raison d'être) qui renvoie non pas le contenu de JSText$ mais le nom de la variable c'est à dire JSText$ scratch

@ Tous les panoramiciens

Je ne suis un fou du hacking donc je ne crée pas de virus
et mon PC fait un bruit de bagnole volée dès que j'écris une connerie dangereuse pour lui même. Laughing

En attendant de retrouver un boulot, je vie avec le RSA et j'ai dû bouffer des pâtes pendant trois mois pour
remplacer mon ancien, et continuer à faire parti de cette communauté.
Tout çà pour dire que je connais la valeur des choses et que je ne m'amuserait pas à envoyer un programme
nuisible, sachant ce que peut représenter l'effort pour avoir une de ces machines et la soupape d'évasion que représente
cette communauté.
Vous êtes un peu mon rayon de soleil dans mon quotidien d'emmerde.

Sujet: re Dim 28 Oct 2012 - 15:01

@ Jack,

tu me dis

Message JSText$ renvoie soit
- le contenu si JSText$ existe et contient une chaine de caractères
- JSText$ si la variable n'existe pas ou plus

Dans le cas présent, le message est placé dans la procédure où se situe la variable local JSText$
donc celle ci est créé et pas encore détruite.
le message devrait au pire être vide.

le fait de voir une troisième fois ce message implique que la procédure est appelée une troisième fois
et que la variable n'est pas créée par ce troisième appel... Laughing

Invité

Ygeronimi
Tu ne m'as pas compris. Il n'y a pas d'attaque de ma part. Je veux seulement savoir ce qui se passe lorsque j'essaye un programme du forum. Je suis sûre qu'il n'y a pas de virus dans tes codes. Je veux seulement savoir qu'est-ce qui s'installe sur mon ordi, pour pouvoir le supprimer après. Suite à une de tes demandes il y a quelques temps, j'ai lancé le programme incriminé, et je sais que celui-ci a créé des dossiers. Mais étant tout neuf sur W7 que je ne connaissais pas alors, je n'ai pas retrouvé les dossiers. Cela m'a rafraîchi depuis, et je veux savoir ce qui a été installé. Arrange toi pour que tout s'installe dans un même dossier, cela permettra de tout effacer après. J'ai voulu te faire comprendre quel était le problème, mais comme tu sais, je ne suis pas fort en communication.
Bonne chance!

Sujet: Re: Probleme avec une procedure Dim 28 Oct 2012 - 18:23

Voici ce que j'ai fait, en suivant tes instructions :

- j'ai mis "message JSText$" à la ligne 186
- je lance avec l'éditeur
- j'obtiens "D" qui vient de "message JSText$"
- je crée un cheval : Fichiers/Effectif/Ajouter
- je remplis chaque champ par une lettre (je ne sais pas quoi mettre d'autre):
a dans "Nom du cheval"
b dans "Site de stationnement"
c dans "Lad attitré"
d dans "Tête"
e dans "Corps"
f ans "Antérieurs"
g dans "Postérieurs"
h dans "Sulky"
- je clique sur le bouton "Enregistrer"
- je crée une sauvegarde par Options/Sauvegardes/Créer

Et là, j'ai une erreur : "Invalid filename"
L'éditeur m'indique la ligne en cause:
568 file_open_read 9000,Fichier$ :file_readln 9000,Lig% :file_readln 9000,Col% :file_close 9000

Bizarre.
Il n'y a eu aucune maifestation de l' open_dialog de numéro 9000 par la ligne 566 Fichier$=File_name$(9000)
et donc Fichier$ n'est pas rempli ...

Sujet: re Dim 28 Oct 2012 - 18:30

Ben...v'là autre chose.... scratch

Sujet: re Dim 28 Oct 2012 - 18:55

J'ai mis sur mon webdav le dossier "PlaningEcurie"

Il suffit de le charger, forcer l'éditeur, de le lancer
puis d'aller sur "Options/Sauvegardes/Visualiser

Invité

J'ai fait ce que tu as dis, et j'ai modifié la ligne en question:

Code:: 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
message jstext$
====>>>> if JStext$="D" <<<<==== ligne d'erreur ??
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

L'erreur se produit à la ligne 188, effectivement la 2ème appel avec le message de JStext$, qui est: JStext$ et c'est surprenant. Pourquoi on reçoit JStext$ comme contenu? Y-a-t-il un bug?

C'est à revoir plus profondément.

Invité

Je pense qu'on est pas au bout des problèmes.
Si je mets cette variable: JStext$ dans un dim au début du programme, je me trouve avec un autre problème: ici:
if JStext$="D"
J$(1)="D": ' <<<<======= variable non définie alors que le tableau est défini dans dim_local

Sujet: re Dim 28 Oct 2012 - 22:48

en fait l' appel à la procédure sur le grid principale (n°101)
est placé après la vérif sur l'existence de la fenêtre et elle est donc appelé
plusieurs fois par le grid principal. Que celui ci soit créer (object_exists(100)=0) ou
qu'il soit seulement showed (else show 100).

la bizzarerie tient du fait que là où est placé cette variable, et quelque soit le cas,
elle est créée et pleine.

bon j'ai fait depuis un peu d'élagage dans mon code et je n'ai plus de problème sur ce source,
du moins à ce niveau là, mais cela peut se reproduire dans un autre source.

Invité

Je viens de modifier la routine: Sub Remp_GridR1(No%,W%)
Car au lieu de faire un teste après, cela revient au même de mettre les lignes avec case.
JStext$ ne provoque plus d'erreur, mais maintenant c'est x% qui perd sa notion de variable, comme si cela n'avait pas était fait. Il y a un problème avec les déclarations avec dim_local, et le soutient de celles-ci pendant la SUB. Pourtant je ne vois rien qui supprime comme free(). Il n'y a même pas de traitement extérieur pendant l'exécution, qui pourrait enlever ce statue.

Entre-nous cette façon de déclarer les jours selon le 1er jour, pourrait-être revu par une lecture de positionnement comme "DLMMJVSDLMMJVS", un décalage de lecture dans la chaine.

Code:: Sub Remp_GridR1(No%,W%)
Dim_Local x%
dim_local C12$,y%,LongMax%,I$
dim_local j$(8)
Dim_Local JSD$,JSJ%,JSM%,JSA%,JSM1%,JSA1%,JSns%,JSas%,JSf%,JSnumero%

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" :J$(1)="D":J$(2)="L":J$(3)="M":J$(4)="M":J$(5)="J":J$(6)="V":J$(7)="S"
case 1: JStext$ = "L" :J$(1)="L":J$(2)="M":J$(3)="M":J$(4)="J":J$(5)="V":J$(6)="S":J$(7)="D"
case 2: JStext$ = "M" :J$(1)="M":J$(2)="M":J$(3)="J":J$(4)="V":J$(5)="S":J$(6)="D":J$(7)="L"
case 3: JStext$ = "M" :J$(1)="M":J$(2)="J":J$(3)="V":J$(4)="S":J$(5)="D":J$(6)="L":J$(7)="M"
case 4: JStext$ = "J" :J$(1)="J":J$(2)="V":J$(3)="S":J$(4)="D":J$(5)="L":J$(6)="M":J$(7)="M"
case 5: JStext$ = "V" :J$(1)="V":J$(2)="S":J$(3)="D":J$(4)="L":J$(5)="M":J$(6)="M":J$(7)="J"
case 6: JStext$ = "S" :J$(1)="S":J$(2)="D":J$(3)="L":J$(4)="M":J$(5)="M":J$(6)="J":J$(7)="V"
end_select

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

Sujet: re Dim 28 Oct 2012 - 23:25

@ Cosmos70,

Pour l'instant, je suis dans la première phase de mon application.
Celle où j'essaie que tout fonctionne Laughing

.

Quand j'aurai fini cette phase, et c'est pas parti pour être demain,
je verrai pour la phase d'optimisation. J'ai déjà testé, séparément,
une procédure pour le remplissage de combo ou list à partir de dlist
qui soit portable. J'intégrerai celle ci lors de l'optimisation du code.

Mais je voie que je ne suis pas le seul à avoir mon lot de bizzarerie ce soir... lol!

Sujet: Re: Probleme avec une procedure Dim 28 Oct 2012 - 23:52

@Ygreonimi:
Je ne vois rien qui pourrait perturber ta variable locale x%. Tu l'utilises dans la boucle pour déterminer la colonne du grid à écrire, et donc tu l'incrémentes en conséquence. Mais elle doit rester définie. Elle n'est supprimée nulle part. Et lorsque tu rentres à nouveau dans la procédure, elle est recréée et réinitialisée.

Sujet: re Lun 29 Oct 2012 - 0:35

Encore un chapître dans le grand livre "Les mystère de Bill"
lol!

» Problème avec GetWindowsVersion.
» Problème avec select case Probleme réglé merci
» Problème avec SearchStringList.
» Problème avec la 3D.
» Problème avec KGF.CHM.