CFP les codes

rem cfpsufca

label quit,aide,tf,addlist,sel,cont,fin,sup,continue
label sauvefam,chargefam,chargecat

dim n,nu,l,nf
dim nu$,a$,afam$,fi$
dim proga$,nomutil$,motutil$,gradutil$
dim fam$(20),fifam$(20)
dim cat$(15)

left 0,150
top 0,180
width 0,550
height 0,492
caption 0,"COMPTE FAMILIALE * Suppression d'un Famille de Catégories *"

alpha 1
left 1,67
top 1,31
width 1,158
caption 1,"Liste des Familles de Catégories"

list 2
left 2,41
top 2,61
width 2,209
height 2,270
on_click 2,sel

button 3
left 3,452
top 3,10
width 3,20
height 3,20
caption 3,"?"
on_click 3,aide

button 6
left 6,98
top 6,361
width 6,100
caption 6,"Retour au Menu"
on_click 6,quit

button 8
left 8,352
top 8,381
caption 8,"Supprimer"
on_click 8,sup
hide 8

memo 9
left 9,290
top 9,80
width 9,209
height 9,210
hide 9

button 10
left 10,352
top 10,381
caption 10,"Continuer"
on_click 10,continue
hide 10

form 11
left 11,720
top 11,180
width 11,460
height 11,490
caption 11,"COMPTE FAMILIALE *  Aide *"
color 11,255,255,255
font_color 11,0,0,255
hide 11

alpha 12
left 12,270
top 12,50
width 12,158

gosub tf:gosub chargefam: gosub addlist

end
rem ----------------------------------------------------------------------------
aide:
show 11
print_target_is 11
print_locate 10,10:print "Une Famille de Catégories est un fichier qui contient des catégories: (sous-famille)"
print_locate 30,30:print "Exemple: dans la Famille de Catégorie IMPÔTS vous pouvez avoir 3 catégories"
print_locate 30,50:print "comme Sur le revenu, Locaux, Fonciers etc..."
print_locate 10,70:print "Ces Familles de Catégories serviront pour les Statistiques"
print_locate 10,110:print "Cette partie du programme vous permet de Supprimer des Familles."
print_locate 30,130:print "Leurs Catégories respectives sera automatiquement Supprimer"
print_locate 10,170:print "Vous pouvez aussi les Créer ou les Modifier dans les sections de programme prévues"
print_locate 10,210:print "MISE EN GARDE: il est déconseillé de Supprimer une Famille de Catégories, car vous ne"
print_locate 102,230:print "pourrez plus avoir les Statistiques correspondantes"
print_target_is 0
return

sup:
hide 11
file_delete fi$
fam$(nf)="":fifam$(nf)=""
gosub sauvefam
hide 8:show 10
return

continue:
execute cfpsufca.exe
goto fin
return

sel:
hide 11
n=item_index(2):nf=n
a$=item_index$(2)
if a$="" then message "Sélection Vide":return
if n<8 then message "La Famille "+a$+" ne peut pas être Supprimée":return
show 8:show 9:show 12
l=len(fam$(n)):afam$=left$(fam$(n),l-1)
caption 12,"Liste des Catégories de la famille: "+afam$
fi$=fifam$(nf)
gosub chargecat
for n=1 to 15
item_add 9,cat$(n)
next n
print_locate 280,300:print string$(35," ")
print_locate 280,300:print "La Suppression de: "+afam$
print_locate 280,320:print "effacera également les catégories"
print_locate 280,340:print "ci-dessus"
gosub aide
return

addlist:
for n=1 to 20
if fam$(n)="" then goto cont
l=len(fam$(n)):afam$=left$(fam$(n),l-1)
cont:
item_add 2,afam$
afam$=""
next n
return

rem ----------------------------------------------------------------------------
chargecat:
file_open_read 1,fi$
for n=1 to 15
file_readln 1,cat$(n)
next n
file_close 1
return

chargefam:
file_open_read 1,"cfplisfa.cfp"
for n=1 to 20
file_readln 1,fifam$(n)
file_readln 1,fam$(n)
next n
file_close 1
return

sauvefam:
file_open_write 1,"cfplisfa.cfp"
for n=1 to 20
file_writeln 1,fifam$(n)
file_writeln 1,fam$(n)
next n
file_close 1
return

tf:
file_open_read 1,"cfptf01.cfp"
file_readln 1,proga$
file_readln 1,nu
file_readln 1,nomutil$
file_readln 1,motutil$
file_readln 1,gradutil$
file_close 1
print_locate 10,440:print "UTILISATEUR: "+nomutil$
print_locate 460,440:print date$
return

rem ---------------------------------------------------------------------------
quit:
execute cfpgfca.exe
fin:
terminate

rem cfptrcod

label sauvecode,chargecode,quit,prog,p1,p2,fin,insertk,bascule,printage

dim cdc$(99),libc$(99),mrc$(99),opc$(99),famc$(99),catc$(99),desc$(99),utilc$(99),oac$(99),cbkc$(99),dvc$(99),mecc$(99),mefc$(99),mtc$(99)
dim cdck$(99),libck$(99),mrck$(99),opck$(99),famck$(99),catck$(99),desck$(99),utilck$(99),oack$(99),cbkck$(99),dvck$(99),mecck$(99),mefck$(99),mtck$(99)

dim n,k,a,x,y
dim r$

caption 0,"COMPTE FAMILILIALE  *  Tri des Codes *"
print_locate 50,50:print "VEUILLEZ PATIENTEZ"

gosub chargecode

prog:
a=47:r$="":n=0
p1:
n=0:a=a+1
if a>90 then goto fin
r$=chr$(a)
rem print_locate 150,150:print r$
rem wait 400
p2:
n=n+1
if n>99 then n=0:goto p1
if cdc$(n)="" then goto p2
if cdc$(n)=r$ then gosub insertk:goto p2
if left$(cdc$(n),1)=r$ then gosub insertk
goto p2



fin:
gosub bascule
rem gosub printage
gosub sauvecode
execute cfpgcod.exe
goto quit
end

rem -------------------------------------
printage:
for n=1 to 99
x=x+20
print_locate y,x:print cdc$(n)+" "+libc$(n)+" "+mrc$(n)+" "+opc$(n)+" "+famc$(n)+" "+catc$(n)+" "+desc$(n)+" "+utilc$(n)+" "+oac$(n)+" "+cbkc$(n)+" "+dvc$(n)+" "+mecc$(n)+" "+mefc$(n)+" "+mtc$(n)
next n
return

bascule:
n=0
for k=1 to 99
n=n+1
cdc$(n)=cdck$(k):libc$(n)=libck$(k):mrc$(n)=mrck$(k):opc$(n)=opck$(k)
famc$(n)=famck$(k):catc$(n)=catck$(k):desc$(n)=desck$(k)
utilc$(n)=utilck$(k):oac$(n)=oack$(k):cbkc$(n)=cbkck$(k)
dvc$(n)=dvck$(k):mecc$(n)=mecck$(k):mefc$(n)=mefck$(k):mtc$(n)=mtck$(k)
next k
return

insertk:
k=k+1
cdck$(k)=cdc$(n):libck$(k)=libc$(n):mrck$(k)=mrc$(n):opck$(k)=opc$(n)
famck$(k)=famc$(n):catck$(k)=catc$(n):desck$(k)=desc$(n)
utilck$(k)=utilc$(n):oack$(k)=oac$(n):cbkck$(k)=cbkc$(n)
dvck$(k)=dvc$(n):mecck$(k)=mecc$(n):mefck$(k)=mefc$(n):mtck$(k)=mtc$(n)
return

chargecode:
file_open_read 1,"cfpcodes.cfp"
for n=1 to 99
file_readln 1,cdc$(n)
file_readln 1,libc$(n)
file_readln 1,mrc$(n)
file_readln 1,opc$(n)
file_readln 1,famc$(n)
file_readln 1,catc$(n)
file_readln 1,desc$(n)
file_readln 1,utilc$(n)
file_readln 1,oac$(n)
file_readln 1,cbkc$(n)
file_readln 1,dvc$(n)
file_readln 1,mecc$(n)
file_readln 1,mefc$(n)
file_readln 1,mtc$(n)
next n
file_close 1
return

sauvecode:
file_open_write 1,"cfpcodes.cfp"
for n=1 to 99
file_writeln 1,cdc$(n)
file_writeln 1,libc$(n)
file_writeln 1,mrc$(n)
file_writeln 1,opc$(n)
file_writeln 1,famc$(n)
file_writeln 1,catc$(n)
file_writeln 1,desc$(n)
file_writeln 1,utilc$(n)
file_writeln 1,oac$(n)
file_writeln 1,cbkc$(n)
file_writeln 1,dvc$(n)
file_writeln 1,mecc$(n)
file_writeln 1,mefc$(n)
file_writeln 1,mtc$(n)
next n
file_close 1
return
rem  ---------------------------------------
quit:
terminate

rem cfpvisop

label tf,chargetf03,chargeliste,datfich,chargeoper,addlist,sauveoper,mt,pas,pa
label quit,fin,verificour,rose,vert,afi1,modipiece,modpiece,modpiec,modival
label jour,mois,ans,confdat,valid,autre

dim cpt$(9),lcpt$(9),fec$(9),rec$(9),sldcpt$(9)
dim cod$(111),nlig$(111),datoper$(111),lib$(111),mr$(111),op$(111),piece$(111),util$(111),dest$(111),fam$(111),cat$(111),dv$(111),mt$(111),sld$(111),ctr$(111)
dim proga$,nomutil$,motutil$,gradutil$
dim n,no,nu,ncpt,l,li,lt,lp,lc,lr,ls,p
dim a$,b$,c$,d$,e$,f$,an$,moi$,nu$,fi$,fil$,liba$,mec$,mef$,pcat$,pmt$,psld$
dim jou$

left 0,9:top 0,60:width 0,1270:height 0,850
gosub tf
font_name 0,"Impact"
font_size 0,9
gosub chargetf03:fil$=fi$:gosub chargeliste:gosub datfich
caption 0,"COMPTE FAMILIALE  *  Visualisation/Modif sur le Compte:  "+lcpt$(ncpt)+"  *  "+a$+"  *"

list 1
left 1,10:top 1,50:width 1,1190:height 1,550
color 1,190,255,255
on_click 1,afi1

button 2
left 2,10:top 2,630:width 2,100:height 2,25:caption 2,"RETOUR"
on_click 2,quit

button 3
left 3,350:top 3,630:width 3,120:height 3,25:caption 3,"Modifier  N°  de  Piece"
on_click 3,modipiece
hide 3

edit 4
left 4,480:top 4,633:width 4,100:height 4,20
on_change 4,modpiece
hide 4

button 5
left 5,590:top 5,633:width 5,20:height 5,20:caption 5,"OK"
on_click 5,modpiec
hide 5

button 6
left 6,1000:top 6,630:width 6,130:height 6,25:caption 6,"Modifier  Date de Valeur"
on_click 6,modival
hide 6

button 11
left 11,140:top 11,630:width 11,150:height 11,25:caption 11,"Valider les Modifications"
on_click 11,valid
hide 11

button 12
left 12,990:top 12,730:width 12,150:height 12,25:caption 12,"Visualiser un Autre Fichier"
on_click 12,autre

gosub rose
gosub verificour:gosub chargeoper:gosub addlist:no=n
gosub vert
end
rem -----------------------------------------------------------------------------
autre:
execute "cfpviop2.exe" :goto fin
return

valid:
gosub sauveoper:gosub quit
return

modival:
inactive 6
combo 7:left 7,660:top 7,630:width 7,40
rem caption 7,"JOUR"
for n=1 to 31
item_add 7,n
next n
jou$=left$(dv$(no),2)
text 7,jou$

combo 8
left 8,710:top 8,630:width 8,40
rem caption 8,"MOIS"
for n=1 to 12
item_add 8,n
next n
moi$=mid$(dv$(no),4,2)
text 8,moi$

combo 9
left 9,760:top 9,630:width 9,40
rem caption 9,"ANS"
for n=0 to 99
item_add 9,n
next n
an$=right$(dv$(no),2)
text 9,an$

button 10:top 10,633:left 10,810:width 10,150:height 10,20:caption 10,"Confirmation Date de Valeur"
gosub rose
on_click 7,jour
on_click 8,mois
on_click 9,ans
on_click 10,confdat
2d_fill_color 240,245,120
2d_rectangle 640,660,985,605
print_locate 655,610:print "  JOUR    /    MOIS    /    ANNEE"
return
return

confdat:
a$=jou$:b$=moi$:c$=an$
dv$(no)=a$+"/"+b$+"/"+c$
inactive 7:inactive 8:inactive 9:inactive 10:show 11
gosub afi1
2d_fill_color 240,245,120
2d_rectangle 640,660,985,605
return

jour:
jou$=text$(7)
if val(jou$)<10 then jou$="0"+jou$
return
mois:
moi$=text$(8)
if val(moi$)<10 then moi$="0"+moi$
return
ans:
an$=text$(9)
if val(an$)<10 then an$="0"+an$
return

modipiece:
if mr$(no)="CH" then message "Option non autorisée pour les Chèques":return
show 4:set_focus 4
return

modpiece:
a$=text$(4)
if len(a$)>8 then message "8 caractères Maximum":return
show 5
return

modpiec:
if len(a$)>8 then message "8 caractères Maximum":return
piece$(no)=a$:clear 1:gosub addlist
inactive 3:inactive 4:inactive 5:inactive 6::show 11
return

afi1:
gosub vert
no=item_index(1):a$=item_index$(1)
print_locate 20,710:print "INFORMATIONS  COMPLEMENTAIRES  DE  LA  LIGNE :  "+nlig$(no)+"  "+cod$(no)+"  "+lib$(no)
print_locate 20,730:print "UTILISATEUR :  "+util$(no)+string$(16," ")+"DESTINATAIRE :  "+dest$(no)
print_locate 20,750:print "DATE  DE  VALEUR :  "+dv$(no)
print_locate 20,770:print "FAMILLE  DE  CATEGORIE :  "+fam$(no)
show 3:show 6
return

vert:
print_target_is 0
print_locate 10,800:print "  UTILISATEUR :  "+nomutil$+"  "
print_locate 1180,800:print "  "+date$+"  "
2d_fill_color 200,255,200
2d_rectangle 10,790,1200,700
return

rose:
2d_fill_color 255,235,235
2d_rectangle 10,15,1200,45
print_locate 24,20:print " LIGNE  |"
print_locate 64,20:print "DATE OPERATION |"
print_locate 147,20:print "                                                  LIBELLE    ou    MOTIF                                                    |"
print_locate 458,20:print " MR +/-  |"
print_locate 515,20:print "N °  de  PIECE    |"
print_locate 605,18:print "MIN /  MAX    |"
print_locate 754,18:print "Catégorie                                  |"
print_locate 904,18:print "MONTANT                    |"
print_locate 1054,18:print "  SOLDE            |"
print_locate 1134,18:print "CTR          |"
return

verificour:
fi$=fec$(ncpt)
n=file_exists(fi$)
if n=0 then Message "Le fichier "+fi$+" n'existe pas.":goto fin
if n=1 then return
return

addlist:
for n=1 to 111
font_name 1,"Fixedsys"
if nlig$(n)="" then return
lt=len(lib$(n)):li=36-lt:liba$=lib$(n)
if lt>35 then liba$=left$(lib$(n),35):li=1
lt=len(piece$(n)):lp=10-lt
if mid$(piece$(n),4,1)<>"/" then mec$="000":mef$="000"
if mid$(piece$(n),4,1)="/" then mec$=left$(piece$(n),3):mef$=right$(piece$(n),3)
pcat$=left$(cat$(n),23)
lt=len(pcat$):lc=24-lt
a$=mt$(n):ls=9:gosub mt:pmt$=b$
a$=sld$(n):ls=9:gosub mt:psld$=b$
lt=len(ctr$(n)):lr=5-lt
a$=" "+nlig$(n)+" | "+datoper$(n)+" | "+liba$+string$(li," ")+"| "+mr$(n)+op$(n)+" | "+piece$(n)+string$(lp," ")+"| "+mec$+"/"+mef$+" |"+pcat$+string$(lc," ")+" | "+pmt$+ psld$+string$(lr," ")+ctr$(n)+" |"
print_target_is 1
print a$
next n
return

mt:
lt=0:l=0:p=0:d$="":b$=""
if a$="" then b$="        0.00 | ":return
lt=len(a$):l=ls-lt
if lt=1 then b$=string$(l," ")+a$+".00 | ":return
gosub pas
return

pas:
p=0:d$="":b$="":e$=""
pa:
p=p+1
if p>lt then b$=string$(l," ")+a$+".00 | ":return
d$=mid$(a$,p,1)
if d$<>"." then goto pa
e$=mid$(a$,p+1,1)
f$=mid$(a$,p+2,1)
if e$="" and f$="" then b$=string$(l+1," ")+a$+"00 | ":return
if e$<>"" and f$="" then b$=string$(l+2," ")+a$+"0 | ":return
if e$<>"" and f$<>"" then b$=string$(l+3," ")+a$+" | ":return
message "Cas non prévu à l'etiquette pa":terminate

datfich:
an$=mid$(fec$(ncpt),5,2):moi$=mid$(fec$(ncpt),7,2)
if moi$="01" then a$="JANVIER / "+an$
if moi$="02" then a$="FEVRIER / "+an$
if moi$="03" then a$="MARS / "+an$
if moi$="04" then a$="AVRIL / "+an$
if moi$="05" then a$="MAI / "+an$
if moi$="06" then a$="JUIN / "+an$
if moi$="07" then a$="JUILLET / "+an$
if moi$="08" then a$="AOUT / "+an$
if moi$="09" then a$="SEPTEMBRE / "+an$
if moi$="10" then a$="OCTOBRE / "+an$
if moi$="11" then a$="NOVEMBBRE / "+an$
if moi$="12" then a$="DECEMBRE / "+an$
return

rem -----------------------------------------------------------------------------
chargeliste:
file_open_read 1,fil$
for n=1 to 9
file_readln 1,cpt$(n)
file_readln 1,lcpt$(n)
file_readln 1,fec$(n)
file_readln 1,rec$(n)
file_readln 1,sldcpt$(n)
next n
file_close 1
return

chargetf03:
file_open_read 1,"cfptf03.cfp"
file_readln 1,proga$
file_readln 1,fi$
file_readln 1,ncpt
file_close 1
return

tf:
file_open_read 1,"cfptf01.cfp"
file_readln 1,proga$
file_readln 1,nu
file_readln 1,nomutil$
file_readln 1,motutil$
file_readln 1,gradutil$
file_close 1
return

chargeoper:
file_open_read 1,fi$
for n=1 to 111
file_readln 1,cod$(n)
file_readln 1,nlig$(n)
file_readln 1,datoper$(n)
file_readln 1,lib$(n)
file_readln 1,mr$(n)
file_readln 1,op$(n)
file_readln 1,piece$(n)
file_readln 1,util$(n)
file_readln 1,dest$(n)
file_readln 1,fam$(n)
file_readln 1,cat$(n)
file_readln 1,dv$(n)
file_readln 1,mt$(n)
file_readln 1,sld$(n)
file_readln 1,ctr$(n)
next n
file_close 1
return

sauveoper:
file_open_write 1,fi$
for n=1 to 111
file_writeln 1,cod$(n)
file_writeln 1,nlig$(n)
file_writeln 1,datoper$(n)
file_writeln 1,lib$(n)
file_writeln 1,mr$(n)
file_writeln 1,op$(n)
file_writeln 1,piece$(n)
file_writeln 1,util$(n)
file_writeln 1,dest$(n)
file_writeln 1,fam$(n)
file_writeln 1,cat$(n)
file_writeln 1,dv$(n)
file_writeln 1,mt$(n)
file_writeln 1,sld$(n)
file_writeln 1,ctr$(n)
next n
file_close 1
return
rem ----------------------------------------------------------------------------

quit:
execute "cfpeomen.exe"
fin:
terminate

rem cfpvisu2

label cherchfich,quit,tf,sel,chargecheque,visu,strig,mt,pas,pa,rec,vis

dim n,nu,a,b,l,ls,lt,p
dim a$,b$,c$,d$,e$,nu$,fik$
dim proga$,nomutil$,motutil$,gradutil$
dim nchk$(50),mtchk$(50),datoperchk$(50),datvalchk$(50),ordrechk$(50),sitchk$(50)

left 0,100:top 0,100:width 0,900:height 0,750
caption 0,"COMPTE FAMILIALE  *  Visualisation des chèquiers éffacés  *"
font_name 0,"Fixedsys"

list 1:top 1,120:left 1,25:width 1,115:height 1,400
on_click 1,sel

list 2:top 2,120:left 2,170:width 2,690:height 2,400

button 3:top 3,585:left 3,690:width 3,100:caption 3,"Quitter"
on_click 3,quit

button 4:top 4,80:left 4,30:width 4,100:caption 4,"NOUVEAU"
on_click 4,rec
hide 4

gosub tf:nu$=str$(nu)
gosub cherchfich

end
rem ---------------------------------------------------------------------------
rec:
execute cfpvisu2.exe
goto quit
return

visu:
print_locate 168,105:print "|N°CHEQUE|  MONTANT  | DATE OPER. | DATE VAL.. |        ORDRE        | SITUATION | |"
for n=1 to 50
if nchk$(n)="" then goto vis
c$=" "+nchk$(n)+" |"
a$=mtchk$(n):ls=9:gosub mt:c$=c$+b$
a$=datoperchk$(n):ls=12:gosub strig
a$=datvalchk$(n):ls=12:gosub strig
a$=ordrechk$(n):ls=22:gosub strig
a$=sitchk$(n):ls=14:gosub strig
item_add 2,c$:c$=""
vis:
next n
return

strig:
if a$="" then d$=string$(ls," ")+"|":c$=c$+d$:a$="":b$="":d$="":lt=0:l=0:ls=0:return
lt=len(a$):l=ls-lt:b$=left$(a$,lt)+string$(l," ")+"|"
c$=c$+b$:a$="":b$="":lt=0:l=0:ls=0
return

mt:
lt=0:l=0:p=0:d$="":b$=""
if a$="" then b$="        0.00 |":return
if val(a$)=0 then b$="        0.00 |":return
lt=len(a$):l=ls-lt
if lt=1 then b$=string$(l," ")+a$+".00 |":return
gosub pas
return

pas:
p=0:d$="":b$="":e$=""
pa:
p=p+1
if p>lt then b$=string$(l," ")+a$+".00 | ":return
d$=mid$(a$,p,1)
if d$<>"." then goto pa
e$=mid$(a$,p+1,1):f$=mid$(a$,p+2,1)
if e$="" and f$="" then b$=string$(l+1," ")+a$+"00 |":return
if e$<>"" and f$="" then b$=string$(l+2," ")+a$+"0 |":return
if e$<>"" and f$<>"" then b$=string$(l+3," ")+a$+" |":return
message "Cas non prévu à l'etiquette pa":terminate

sel:
a$=item_index$(1)
if a$="" then message "Sélection Vide":return
fik$=a$
gosub chargecheque
gosub visu
show 4:inactive 1
return

cherchfich:
a$=file_find_first$
if mid$(a$,3,3)=nu$+"cA" then item_add 1,a$
while a$<>"_"
a$=file_find_next$
if mid$(a$,3,3)=nu$+"cA" then item_add 1,a$
end_while
file_find_close
return

rem ----------------------------------------------------------------------------
chargecheque:
file_open_read 1,fik$
for n=1 to 50
file_readln 1,nchk$(n)
file_readln 1,mtchk$(n)
file_readln 1,datoperchk$(n)
file_readln 1,datvalchk$(n)
file_readln 1,ordrechk$(n)
file_readln 1,sitchk$(n)
next n
file_close 1
return

tf:
file_open_read 1,"cfptf01.cfp"
file_readln 1,proga$
file_readln 1,nu
file_readln 1,nomutil$
file_readln 1,motutil$
file_readln 1,gradutil$
file_close 1
print_locate 9,695:print "UTILISATEUR: "+nomutil$
print_locate 800,695:print date$
return

quit:
execute cfpgchq.exe
terminate

rem cfpcrlv

label tf,quit,fin,chargeliste,sauveliste,chargetf03,nrlv,demar,chargeoper,sauveoper
label fichdep,rech,suit,suit2,suit3,nouvfich,nouvan,mtopnp,pmt,pas,pa,valid

dim sc%
dim a,b,c,n,nu,ncpt,nrlv,mtonp,mt,sldactu,result,l,lt,p
dim a$,b$,c$,d$,nu$,fi$,fil$,nrlvp$,fin$,mtonp$,sldactu$,result$,mtp$,mtr$
dim proga$,nomutil$,motutil$,gradutil$,cbkcmod$,afam$
dim cpt$(9),lcpt$(9),fec$(9),rec$(9),sldcpt$(9)
dim cod$(111),nlig$(111),datoper$(111),lib$(111),mr$(111),op$(111),piece$(111),util$(111),dest$(111),fam$(111),cat$(111),dv$(111),mt$(111),sld$(111),ctr$(111)

left 0,350:top 0,278:width 0,550:height 0,492
caption 0,"COMPTE FAMILIALE  *  Vérification du relevé  *"
 
button 1:left 1,30:top 1,20:caption 1,"Démarrer"
on_click 1,demar

button 2:left 2,30:top 2,400:caption 2,"Abandon"
on_click 2,quit

button 3:left 3,425:top 3,400:caption 3,"Validation"
inactive 3

memo 4:left 4,60:top 4,80:width 4,410:height 4,195
color 4,200,255,250
font_name 4,"Fixedsys"

list 5:left 5,180:top 5,23:width 5,210:height 5,20
color 5,255,255,120
font_name 5,"Fixedsys"

memo 6:left 6,60:top 6,300:width 6,410:height 6,70
color 6,255,200,200
font_name 6,"Fixedsys"

gosub tf
if gradutil$="INACTIF" then message "Vous nêtes pas autorisé":terminate
nu$=str$(nu):gosub chargetf03:fil$=fi$:gosub chargeliste
sldactu$=sldcpt$(ncpt):gosub nrlv
caption 0,"COMPTE FAMILIALE  *  Vérification d'un Relevé sur le Compte : "+lcpt$(ncpt)+"    *    Relevé numéro:  "+nrlvp$+"    *"

item_add 6,"Si votre relevé est complètement pointé, cliquez sur démarrer"
item_add 5,"Controle du Relevé N° "+nrlvp$

set_focus 1
end
rem ----------------------------------------------------------------------------
valid:
rec$(ncpt)=nrlvp$
gosub sauveliste
goto quit
return

demar:
mtonp=0:inactive 1:clear 6
gosub fichdep
rech:
if file_exists(fi$)=1 then goto suit
if file_exists(fi$)=0 then gosub nouvfich
goto rech
suit:
gosub chargeoper
for n=1 to 111
if n>111 then goto suit2
if ctr$(n)="" then gosub mtopnp
next n
suit2:
if fin$="O" then goto suit3
gosub nouvfich
goto suit
suit3:
mtonp$=str$(mtonp):mtr$=mtonp$:gosub pmt:mtonp$=mtp$
sldactu=val(sldactu$):mtr$=sldactu$:gosub pmt:sldactu$=mtp$
result=sldactu-mtonp
result$=str$(result):mtr$=result$:gosub pmt:result$=mtp$
lt=len(sldactu$):l=16-lt
item_add 4,"                    Solde Actuel:"+string$(l," ")+sldactu$
lt=len(mtonp$):l=16-lt
item_add 4,"Total des opérations non pointées:"+string$(l," ")+mtonp$
item_add 4," "
item_add 4," "
lt=len(result$):l=16-lt
item_add 4,"                  Solde du Relevé:"+string$(l," ")+result$
active 3
item_add 6,"Si le résultat est bon validez sinon cliquez sur Abandon pour corriger les erreurs"
item_add 6,"Si vous validez le N° de relevé augmentera de 1"
on_click 3, valid
return

pmt:
p=0:lt=0
if a=0 then mtp$="0.00"
lt=len(mtr$)
gosub pas
return

pas:
p=p+1
if p>lt then mtp$=mtr$+".00":return
b$=mid$(mtr$,p,1)
if b$="." then goto pa
goto pas
pa:
c$=mid$(mtr$,p+1,1):d$=mid$(mtr$,p+2,1)
if c$<>"" and d$="" then mtp$=mtr$+"0":return
mtp$=mtr$
return

mtopnp:
if mt$(n)="" then return
b$=mt$(n):mt=val(b$)
if op$(n)="+" then mtonp=mtonp+mt
if op$(n)="-" then mtonp=mtonp-mt
return

nouvfich:
a$=mid$(fi$,7,2)
a=val(a$)
if a=12 then a$="01":gosub nouvan:return
if a<12 then a=a+1
if a<10 then a$="0"+str$(a)
if a>9 then a$=""+str$(a)
b$=left$(fi$,6)+a$+right$(fi$,4):fi$=b$
if fi$=fec$(ncpt)then fin$="O"
return

nouvan:
c$=mid$(fi$,5,2)
c=val(c$)
if c=99 then c=0
if c<99 and c>0 then c=c+1
if c<10 then c$="0"+str$(c)
if c>9 then c$=""+str$(c)
b$=left$(fi$,4)+c$+a$+right$(fi$,4):fi$=b$
if fi$=fec$(ncpt)then fin$="O"
return

fichdep:
a$=mid$(fec$(ncpt),5,2)
a=val(a$)
if a=0 then a=98
if a=1 then a=99
if a>1 then a=a-2
if a<10 then a$="0"+str$(a)
if a>9 then a$=""+str$(a)
b$=left$(fec$(ncpt),4)+a$+right$(fec$(ncpt),6)
fi$=b$
return

nrlv:
nrlv=val(rec$(ncpt))
nrlv=nrlv+1
if nrlv<10 then nrlvp$="00"+str$(nrlv):return
if nrlv>9 and nrlv<100 then nrlvp$="0"+str$(nrlv):return
if nrlv>99 then nrlvp$=""+str$(nrlv):return
return

rem ----------------------------------------------------------------------------
chargeoper:
file_open_read 1,fi$
for n=1 to 111
file_readln 1,cod$(n)
file_readln 1,nlig$(n)
file_readln 1,datoper$(n)
file_readln 1,lib$(n)
file_readln 1,mr$(n)
file_readln 1,op$(n)
file_readln 1,piece$(n)
file_readln 1,util$(n)
file_readln 1,dest$(n)
file_readln 1,fam$(n)
file_readln 1,cat$(n)
file_readln 1,dv$(n)
file_readln 1,mt$(n)
file_readln 1,sld$(n)
file_readln 1,ctr$(n)
next n
file_close 1
return

sauveoper:
file_open_write 1,fi$
for n=1 to 111
file_writeln 1,cod$(n)
file_writeln 1,nlig$(n)
file_writeln 1,datoper$(n)
file_writeln 1,lib$(n)
file_writeln 1,mr$(n)
file_writeln 1,op$(n)
file_writeln 1,piece$(n)
file_writeln 1,util$(n)
file_writeln 1,dest$(n)
file_writeln 1,fam$(n)
file_writeln 1,cat$(n)
file_writeln 1,dv$(n)
file_writeln 1,mt$(n)
file_writeln 1,sld$(n)
file_writeln 1,ctr$(n)
next n
file_close 1
return

chargetf03:
file_open_read 1,"cfptf03.cfp"
file_readln 1,proga$
file_readln 1,fi$
file_readln 1,ncpt
file_close 1
return

tf:
file_open_read 1,"cfptf01.cfp"
file_readln 1,proga$
file_readln 1,nu
file_readln 1,nomutil$
file_readln 1,motutil$
file_readln 1,gradutil$
file_close 1
print_locate 5,445:print "UTILISATEUR :  "+nomutil$
print_locate 465,445:print date$
return

chargeliste:
file_open_read 1,fil$
for n=1 to 9
file_readln 1,cpt$(n)
file_readln 1,lcpt$(n)
file_readln 1,fec$(n)
file_readln 1,rec$(n)
file_readln 1,sldcpt$(n)
next n
file_close 1
return

sauveliste:
file_open_write 1,fil$
for n=1 to 9
file_writeln 1,cpt$(n)
file_writeln 1,lcpt$(n)
file_writeln 1,fec$(n)
file_writeln 1,rec$(n)
file_writeln 1,sldcpt$(n)
next n
file_close 1
return

rem ----------------------------------------------------------------------------
quit:
execute "cfpmenug.exe"
fin:
terminate

rem cfpeomen

label quit,fin,jaune,bleu,rose,vert,tf,chargetf03,datfich,co,fen2,nouvfich
label chargeliste,sauveliste,chargeoper,sauveoper,verificour,pasfich,addlist
label mt,pa,pas,demar,nouvmoi,nouvan,chargecode,sauvecode,selcode,aficode,strig
label scod,scod2,scod3,scod4,scod5,continue,ct,rec,piece,chekm,chargechequiers,chqprincip
label chargecheque,rpcb,datoper,jour,mois,ans,confdat,atm,modidest,chargedest,seldest
label minmax,adollar,montant,montan,monta,enregop,modilib,modlib,molib,modimr,modmr
label modicat,selfam,cnb,chargefam,addfam,cont,chargecat,selcat,solde,gestioncheque,ctrchq
label sauvechequiers,sauvecheque,visu,changemois,modich,visuch,vch,modic
label preparvir,addvir,sauvevir,chqpr,choichq,choicq,choic,choi,cho,crch,vchoi

dim sc%,a,b,c,n,nb,n1c,nc,nf,nu,ncpt,l,lt,lp,l2,lc,ls,lr,p,li,no,nbch,pas,mt,nch,ncq
dim a$,b$,c$,d$,e$,f$,fi$,fif$,fil$,an$,moi$,jou$,liba$,mec$,mef$,pcat$,pmt$,psld$,nu$,fic$,fik$
dim proga$,nomutil$,motutil$,gradutil$,cbkcmod$,afam$,nch$,vir$,choi$,at$
dim cpt$(9),lcpt$(9),fec$(9),rec$(9),sldcpt$(9)
dim cod$(111),nlig$(111),datoper$(111),lib$(111),mr$(111),op$(111),piece$(111),util$(111),dest$(111),fam$(111),cat$(111),dv$(111),mt$(111),sld$(111),ctr$(111)
dim codv$(111),datoperv$(111),libv$(111),mrv$(111),opv$(111),piecev$(111),utilv$(111),destv$(111),famv$(111),catv$(111),dvv$(111),mtv$(111)
dim cdc$(99),libc$(99),mrc$(99),opc$(99),famc$(99),catc$(99),desc$(99),utilc$(99),oac$(99),cbkc$(99),dvc$(99),mecc$(99),mefc$(99),mtc$(99)
dim numchq$(10),bkchq$(10),utilchq$(10),typchq$(10),npchk$(10),ndchk$(10),sitchq$(10)
dim nchk$(50),mtchk$(50),datoperchk$(50),datvalchk$(50),ordrechk$(50),sitchk$(50)
dim fifam$(20)


left 0,9
top 0,60:width 0,1264:height 0,834

gosub tf:gosub chargetf03:fil$=fi$:gosub chargeliste:gosub datfich

caption 0,"COMPTE FAMILIALE  *  Enregistrement d'une Opérations sur le Compte:  "+lcpt$(ncpt)+"  *  "+a$+"  *"
font_name 0,"Impact"
font_size 0,9

list 1
left 1,10:top 1,50:width 1,1180:height 1,300
color 1,190,255,255

picture 3
left 3,10:top 3,384:width 3,1180:height 3,50

combo 4
left 4,32:top 4,470:width 4,40
rem caption 4,"JOUR"
for n=1 to 31
item_add 4,n
next n

button 5
left 5,230:top 5,470
caption 5,"Motif"

button 6
left 6,340:top 6,470
caption 6,"MR"

button 2
left 2,420:top 2,470
caption 2,"N° de Chèque"

button 8
left 8,640:top 8,470
caption 8,"Destinataire"

button 9
left 9,725:top 9,470
caption 9,"Montant"

button 10
left 10,810:top 10,470:width 10,80
caption 10,"Date de Valeur"
hide 10

button 11
left 11,15:top 11,354:width 11,150
caption 11,"Démarrer un Enregistrement"
font_size 11,9
on_click 11,demar
hide 11

combo 12
left 12,80:top 12,470:width 12,40
rem caption 12,"MOIS"
for n=1 to 12
item_add 12,n
next n

combo 13
left 13,130:top 13,470:width 13,40
rem caption 13,"ANS"
for n=0 to 99
item_add 13,n
next n

button 14
left 14,500:top 14,470
caption 14,"Catégorie"

button 15
left 15,315:top 15,530:width 15,150
caption 15,"Visualisation de la Page"
on_click 15,visu

button 16
left 16,489:top 16,530:width 16,150
caption 16,"Changement de Mois"
on_click 16,changemois

button 17
left 17,665:top 17,530:width 17,150
caption 17,"Retour au Menu général"
on_click 17,quit

list 18:top 18,600:left 18,80:width 18,1050:height 18,170
inactive 18
on_click 18,continue

edit 19:top 19,550:left 19,80:width 19,30:height 19,25
inactive 19
on_change 19,scod

alpha 20:top 20,530:left 20,54
caption 20,"Entrez la premiere lettre du code"
inactive 20

button 21:top 21,552:left 21,120:width 21,20:height 21,20:caption 21,"OK"
inactive 21
on_click 21,scod2

print_locate 10,780:print "UTILISATEUR :  "+nomutil$
print_locate 1190,780:print date$

gosub fen2:gosub verificour
inactive 2:inactive 4:inactive 5:inactive 6:inactive 8:inactive 9
inactive 12:inactive 13:inactive 14

button 22
left 22,15:top 22,354:width 22,150
caption 22,"Recommencer"
font_size 22,9
on_click 22,rec
hide 22

edit 23:top 23,540:left 23,980:width 23,80:height 23,25
hide 23

button 24:top 24,544:left 24,1065:width 24,20:height 24,20:caption 24,"OK"
hide 24

button 25:top 25,510:left 25,25:width 25,150:height 25,20:caption 25,"Confirmation Date Opération"
hide 25

button 26
left 26,200:top 26,354:width 26,150
caption 26,"VALIDER  l ' Opération"
font_size 26,9
on_click 26,enregop
hide 26

edit 27:top 27,650:left 27,155:width 27,225:height 27,20
hide 27

button 31:top 31,652:left 31,395:width 31,20:height 31,20:caption 31,"OK"
hide 31

combo 32:top 32,650:left 32,155:width 32,50:height 32,20
item_add 32,"CB":item_add 32,"CH":item_add 32,"VI":item_add 32,"ES":item_add 32,"AU":item_add 32,"RG"
hide 32

combo 33:top 33,200:left 33,500:width 33,340
list 34:top 34,200:left 34,900:width 34,300:height 34,400
hide 33:hide 34

combo 35:top 35,450:left 35,840:width 35,340
hide 35

list 36:top 36,450:left 36,850:width 36,220:height 36,300
hide 36

option 37::top 37,510:left 37,980:width 37,220:caption 37,"Créer un nouveau Chèquier"
option 38::top 38,540:left 38,980:width 38,220:caption 38,"Sélectionner un Chèquier"
on_click 37,crch
on_click 38,choichq
hide 37:hide 38

gosub bleu:gosub jaune:gosub rose
gosub chargeoper:gosub addlist:no=n
show 11:set_focus 11

end
rem ----------------------------------------------------------------------------
modich:
if mr$(no)<>"CH" then message "Le règlement n'est pas un Chèque":gosub jaune:return
gosub visuch
show 34
on_click 34,modic
return

modic:
hide 34:gosub bleu:gosub vert:gosub jaune
nch$=left$(item_index$(34),6)
nch=val(nch$)
piece$(no)="N°"+nch$
print_locate 15,400:print "  "+nlig$(no)+"    |        "
print_locate 60,400:print datoper$(no)+"        |      "
print_locate 130,400:print cod$(no)+"  |              "
print_locate 160,400:print string$(110," ")+"  | "
print_locate 160,400:print lib$(no)
print_locate 390,400:print string$(8," ")+"  | "
print_locate 390,400:print mr$(no)+op$(no)
print_locate 415,400:print string$(57," ")
print_locate 420,400:print piece$(no)+"  | "
print_locate 480,400:print string$(107," ")
print_locate 485,400:print cat$(no)+"  |"
print_locate 645,400:print string$(50," ")
print_locate 653,400:print dest$(no)+"  |  "
return

visuch:
show 33
print_locate 15,80:print "Sélectionnez le Chèquier"
for n1c=1 to 10
item_add 33,numchq$(n1c)+" "+bkchq$(n1c)+" "+typchq$(n1c)+" "+npchk$(n1c)+"/"+ndchk$(n1c)+" "+sitchq$(n1c)
next n1c
on_click 33,vch
return

vch:
n1c=item_index(33):ncq=n1c
if numchq$(n1c)="" then message "Sélection Vide":return
hide 33
rem print_locate 96,105:print "|N°CHEQUE|  MONTANT  | DATE OPER. | DATE VAL.. |        ORDRE        | SITUATION | |"
fik$="cf"+nu$+"ch"+numchq$(n1c)+".cfp"
a=val(npchk$(n1c)):b=val(ndchk$(n1c)):nbch=1+(b-a)
gosub chargecheque
for n1c=1 to nbch
c$=nchk$(n1c)+" |"
a$=mtchk$(n1c):ls=9:gosub mt:c$=c$+b$
a$=datoperchk$(n1c):ls=12:gosub strig
a$=datvalchk$(n1c):ls=12:gosub strig
a$=ordrechk$(n1c):ls=22:gosub strig
a$=sitchk$(n1c):ls=14:gosub strig
item_add 34,c$:c$=""
next n1c
return

changemois:
execute "cfpnvmoi.exe":goto fin
return

visu:
execute "cfpvisop.exe":goto fin
return

enregop:
rem clear 1:n=0:gosub addlist
hide 26:hide 2:hide 5:hide 6:hide 8:hide 9:hide 10:hide 14
gosub jaune
gosub solde
if mr$(no)="CH" and op$(no)="-" then gosub gestioncheque
mt$(no)=str$(mt)
gosub preparvir
if vir$="O" then gosub sauvevir
gosub sauveoper
gosub sauvecode
gosub sauveliste
if vir$="O" then execute "cfpvir.exe":goto fin
if proga$="cfpprlv.exe" then execute proga$:goto fin
print "Votre  opération  est  enregistrée.  Cliquez  sur  [ Recommencer ]  ou  [ Retour au Menu ]"
active 15
return

preparvir:
n=0:vir$=""
if nlig$(no)="" then return
if left$(cod$(no),2)="VI" then gosub addvir
return

addvir:
n=n+1:vir$="O"
codv$(n)=cod$(no):datoperv$(n)=datoper$(no):libv$(n)=lib$(no):mrv$(n)=mr$(no):opv$(n)="+"
piecev$(n)=piece$(no):utilv$(n)=util$(no):destv$(n)=dest$(no):famv$(n)=fam$(no)
catv$(n)=cat$(no):dvv$(n)=dv$(no):mtv$(n)=mt$(no)
return

gestioncheque:
mtchk$(nch)=str$(mt):datoperchk$(nch)=datoper$(no):datvalchk$(nch)=dv$(no)
ordrechk$(nch)=dest$(no):sitchk$(nch)="EMIS"
if cod$(no)="CHA" then sitchk$(nch)="ANNULE"
print numchq$(ncq)+" "+bkchq$(ncq)+" "+utilchq$(ncq)+" "+typchq$(ncq)+" "+npchk$(ncq)+" "+ndchk$(ncq)+" "+sitchq$(ncq)
gosub ctrchq
print nchk$(nch)+" "+mtchk$(nch)+" "+datoperchk$(nch)+" "+datvalchk$(nch)+" "+ordrechk$(nch)+" "+sitchk$(nch)
gosub sauvechequiers
gosub sauvecheque
return

ctrchq:
for n=1 to nbch
if n>nbch then sitchq$(ncq)="PAS TOUT POINTE":typchq$(ncq)="SECONDAIRE":return
if sitchk$(n)="BLANC" then sitchq$(ncq)="A FINIR": return
next n

continue:
gosub vert:gosub rose
hide 20:hide 19:hide 21
inactive 15:inactive 16
a$=item_index$(18):b$=right$(a$,3):nc=val(b$)
if left$(cbkc$(nc),2)="9T" then goto ct
if cbkc$(nc)<>cpt$(ncpt)  then message "Ce Code ne peut pas être utilisé sur ce Compte":return
ct:
if oac$(nc)="O" then message "Code réservé aux Opérations Automatiques":return: rem <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< a verifier
gosub datoper
cod$(no)=cdc$(nc):lib$(no)=libc$(nc):mr$(no)=mrc$(nc):op$(no)=opc$(nc)
util$(no)=utilc$(nc):dest$(no)=desc$(nc):fam$(no)=famc$(nc):cat$(no)=catc$(nc):dv$(no)=dvc$(nc):mt$(no)=mtc$(nc)
mt=val(mt$(no))
gosub minmax
gosub piece
print_locate 15,400:print "  "+nlig$(no)+"    |        "
print_locate 60,400:print datoper$(no)+"        |      "
print_locate 130,400:print cod$(no)+"  |              "
print_locate 160,400:print string$(110," ")+"  | "
print_locate 160,400:print lib$(no)
print_locate 390,400:print string$(8," ")+"  | "
print_locate 390,400:print mr$(no)+op$(no)
print_locate 415,400:print string$(57," ")
print_locate 420,400:print piece$(no)+"  | "
print_locate 480,400:print string$(107," ")
print_locate 485,400:print cat$(no)+"  |"
print_locate 645,400:print string$(50," ")
print_locate 653,400:print dest$(no)+"  |  "
if val(mt$(no))=0 then gosub montant
print_locate 758,400:print string$(25," ")
print_locate 758,400:print mt$(no)+"  |  "
dv$(no)=datoper$(no)
print_locate 780,400:print string$(20," ")
print_locate 815,400:print "  "+dv$(no)+"        |"
if mr$(no)="CH" then active 2
active 5:active 6:active 8:active 9:active 14
gosub vert:print_locate 60,600:print " Modifiez les éléments de l'opération avec les bouttons si nécéssaire, puis Valider ou Retour au Menu "
show 26
gosub jaune
on_click 9,montant
on_click 5,modilib
on_click 6,modimr
on_click 8,modidest
on_click 14,modicat
on_click 2,modich
return

solde:
a= val(sldcpt$(ncpt))
if op$(no)="-" then c=a-mt
if op$(no)="+" then c=a+mt
a$=str$(c)
sld$(no)=a$:sldcpt$(ncpt)=a$
gosub vert:print_locate 60,600:print "Nouveau Solde: "+sld$(no)
return

modicat:
list 39:left 39,830:top 39,520:width 39,170:height 39,250
gosub chargefam: gosub addfam
on_click 39,selfam
list 40:left 40,1010:top 40,520:width 40,190:height 40,250
on_click 40,selcat
gosub rose
return

selcat:
n=item_index(40)
a$=item_index$(40)
if cat$(n)="" then message "Sélection Vide":return
cat$(no)=a$:gosub jaune
print_locate 480,400:print string$(62," ")
print_locate 485,400:print cat$(no)+"  |"
hide 39:hide 40:inactive 14:gosub vert:gosub jaune
return

selfam:
pas=pas+1:if pas >1 then clear 40
n=item_index(39):nf=n:a$=item_index$(39)
if a$="" then message "Sélection Vide":return
l=len(fam$(n)):afam$=left$(fam$(n),l-1):fif$=fifam$(nf)
gosub chargecat
for n=1 to 15
item_add 40,cat$(n)
next n
gosub cnb
return

cnb:
for n=1 to 15
nb=nb+1
if cat$(n)="" then nb=nb-1
next n
return

addfam:
nf=0
for n=1 to 20
if fam$(n)="" then goto cont
l=len(fam$(n)):afam$=left$(fam$(n),l-1)
nf=nf+1
cont:
item_add 39,afam$
afam$=""
next n
return

modidest:
gosub chargedest
list 7:left 7,950:top 7,445:width 7,178:height 7,330
gosub rose:gosub vert:gosub jaune
for n=1 to 99
item_add 7,dest$(n)
next n
on_click 7,seldest
return

seldest:
dest$(no)=item_index$(7)
print_locate 635,400:print string$(40," ")
print_locate 643,400:print dest$(no)+"  |"
hide 7:inactive 8:gosub vert:gosub jaune
return

modimr:
show 32:set_focus 32
on_click 32,modmr
return

modmr:
mr$(no)=text$(32)
print_locate 390,400:print string$(7," ")+"  | "
print_locate 390,400:print mr$(no)+op$(no)
hide 32:gosub vert
gosub piece
gosub jaune
print_locate 415,400:print string$(17," ")
print_locate 420,400:print piece$(no)+"  | "
rem <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< if mr$(no)="CH" and op$(no)="-" then active 10
return

modilib:
text 27,lib$(no)
on_change 27,modlib
show 27:set_focus 27
return

modlib:
a$=text$(27)
if len(a$)>36 then message "36 caractères Maximum":return
show 31
on_click 31,molib
return

molib:
if len(a$)<3 then message "3 caractères Minimum":return
lib$(no)=a$
gosub jaune
print_locate 160,400:print string$(109," ")+"  | "
print_locate 160,400:print lib$(no)
hide 27:hide 31:gosub vert:gosub jaune
return

montant:
if at$="O" then at$="":return
if cod$(no)="CHA" then mt=0:mt$(no)="0.00":return
show 23:set_focus 23
on_change 23,montan
print_locate 980,520:print "Entrez le Montant"
return

montan:
a$=text$(23)
if numeric(a$)=0 then text 23,"":return
if len(a$)>10 then text 23,"":return
show 24
on_click 24,monta
return

monta:
mt=val(a$)
a$=str$(mt)
mt$(no)=a$
gosub mt
hide 23:hide 24
gosub jaune
print_locate 980,520:print string$(41," ")
print_locate 738,400:print string$(15," ")
print_locate 743,400:print mt$(no)
return

minmax:
a=val(mecc$(nc)):b=val(mefc$(nc))
if b=0 then return
if b>0 then a=a+1
a$=str$(a):gosub adollar
b$=mefc$(nc)
mecc$(nc)=a$
if a>b then piece$(no)="Terminé":mt=0:mt$(no)="0,00"
piece$(no)=a$+"/"+b$
return

adollar:
a=val(a$)
if a<10 then a$="00"+a$:return
if a>9 and a<100 then a$="0"+a$:return
return

piece:
if cod$(no)="CHA" then piece$(no)="ANNULE":ctr$(no)="CHA"
if mid$(piece$(no),4,1)="/" then return
if mr$(no)="CH" and op$(no)="-" then gosub chekm:return
if mr$(no)="CH" and op$(no)="+" then piece$(no)=datoper$(no):return
if mr$(no)="ES" and op$(no)="-" then piece$(no)=datoper$(no):return
if mr$(no)="ES" and op$(no)="+" then piece$(no)=datoper$(no):return
if mr$(no)="VI" or mr$(no)="AU" and op$(no)="-" then piece$(no)=datoper$(no):return
if mr$(no)="VI" or mr$(no)="AU" and op$(no)="+" then piece$(no)=datoper$(no):return
if mr$(no)="CB" and op$(no)="-" then piece$(no)=datoper$(no):return
if mr$(no)="DB" and op$(no)="-" then piece$(no)=datoper$(no):return
if mr$(no)="RG" and op$(no)="-" then piece$(no)=datoper$(no):ctr$(no)="REG":return
if mr$(no)="RG" and op$(no)="+" then piece$(no)=datoper$(no):ctr$(no)="REG":return
return

datoper:
active 4:active 12:active 13:show 22:show 25:hide 18:gosub vert:gosub rose
on_click 4,jour
on_click 12,mois
on_click 13,ans
on_click 25,confdat
print_locate 60,600:print " Modifier si nécéssaire la date d'opération, puis confirmer "
gosub atm
return

jour:
jou$=text$(4)
if val(jou$)<10 then jou$="0"+jou$
set_focus 25:gosub vert:gosub jaune
gosub atm
return
mois:
moi$=text$(12)
if val(moi$)<10 then moi$="0"+moi$
set_focus 25:gosub vert:gosub jaune
gosub atm
return
ans:
an$=text$(13)
if val(an$)<10 then an$="0"+an$
set_focus 25:gosub vert:gosub jaune
gosub atm
return

confdat:
a$=jou$:b$=moi$:c$=an$
datoper$(no)=a$+"/"+b$+"/"+c$
inactive 4:inactive 12:inactive 13:hide 25:gosub vert:gosub jaune
print_locate 415,400:print string$(27," ")+"  | "
return

atm:
a$=inkey$:if a$="" then goto atm
return

chekm:
nu$=str$(nu)
fic$="cfp"+nu$+"chq.cfp"
n=0:gosub chargechequiers
n=0:gosub chqprincip
if numchq$(1)="" then message "il n'y a aucun chèquiers ouvert. vous devez le créer.":execute "cfpgchq.exe":goto fin
if choi$="O" then choi$="":return
a=val(npchk$(n)):b=val(ndchk$(n)):nbch=1+(b-a)
ncq=n
fik$="cf"+nu$+"ch"+a$+".cfp"
gosub chargecheque
a$="":gosub rpcb
piece$(no)="N°"+a$
nch=n
gosub jaune
return

rpcb:
for n=1 to nbch
if n>nbch then message "il n'y a plus de Chèque sur le chèquier "+fik$+" Vous allez être redirigé vers la gestion des chèques.":execute "cfpgchq.exe":goto fin
if sitchk$(n)="BLANC" then a$=nchk$(n): return
next n
return

chqprincip:
for n= 1 to 10
if typchq$(n)="" then goto chqpr
if typchq$(n)="SECONDAIRE" then goto chqpr
if typchq$(n)="PRINCIPAL" then a$=numchq$(n):return
chqpr:
next n
message "il n'y a pas de chèquier principale. vous pouvez choisir dans la liste ou créer un nouveau chèquier."
choi$="O":gosub jaune:gosub choi
return

choi:
show 37:show 38
cho:
if scancode<>0 then goto cho
at$="O"
return

crch:
execute cfpgchq.exe:goto fin
return

choichq:
hide 37:hide 38:show 35
for n=1 to 10
item_add 35,numchq$(n)+" "+bkchq$(n)+" "+typchq$(n)+" "+npchk$(n)+"/"+ndchk$(n)+" "+sitchq$(n)
next n
on_click 35,choicq
a$=inkey$:if a$="" then goto choichq
return

choicq:
n=item_index(35)
if numchq$(n)="" then message "Sélection Vide":goto choichq
a$=numchq$(n)
hide 35
a=val(npchk$(n)):b=val(ndchk$(n)):nbch=1+(b-a)
ncq=n
fik$="cf"+nu$+"ch"+a$+".cfp"
gosub chargecheque
show 36
for n=1 to nbch
c$=" "+nchk$(n)+" |"
item_add 36," "+nchk$(n)+" | "+ordrechk$(n)+" | "+sitchk$(n)
next n

choic:
on_click 36,vchoi
a$=inke$:if a$="" then goto choic
return

vchoi:
n=item_index(36)
if sitchk$(n)<>"BLANC" then message "Vous devez sélectionner un chèque blanc":goto choic
if nchk$(n)="" then message "Vous devez sélectionner une ligne pour modifier":goto choic
piece$(no)="N°"+nchk$(n)
nch=n
hide 36:gosub vert:gosub jaune
print_locate 420,400:print piece$(no)+"  | "
at$="":gosub montant
print_locate 15,400:print "  "+nlig$(no)+"    |        "
print_locate 60,400:print datoper$(no)+"        |      "
print_locate 130,400:print cod$(no)+"  |              "
print_locate 160,400:print string$(110," ")+"  | "
print_locate 160,400:print lib$(no)
print_locate 390,400:print string$(8," ")+"  | "
print_locate 390,400:print mr$(no)+op$(no)
print_locate 415,400:print string$(57," ")
print_locate 420,400:print piece$(no)+"  | "
print_locate 480,400:print string$(107," ")
print_locate 485,400:print cat$(no)+"  |"
print_locate 645,400:print string$(50," ")
print_locate 653,400:print dest$(no)+"  |  "
inactive 2
return

demar:
inactive 11:active 18
print_target_is 0
if no<10 then nlig$(no)="00"+str$(no)
if no>9 and no<100 then nlig$(no)="0"+str$(no)
if no>100 then nlig$(no)=str$(no)
print_locate 15,400:print "  "+nlig$(no)+"    |        "
jou$=left$(date$,2):moi$=mid$(date$,4,2):an$=mid$(date$,9,2):datoper$(no)=jou$+"/"+moi$+"/"+an$
text 4,jou$:text 12,moi$:text 13,an$
print_locate 60,400:print datoper$(no)+"        |      "
gosub chargecode:gosub selcode
gosub vert:gosub rose
return

selcode:
nc=1:gosub aficode
active 20:active 19
font_name 19,"Courier New"
set_focus 19
return

scod:
active 21:set_focus 21
return
scod2:
a$=upper$(text$(19))
gosub scod3
return

scod3:
nc=0:n=0:b$=""
scod4:
n=n+1
if n>99 then b$="":n=1:goto scod5
b$=mid$(cdc$(n),1,1)
if b$="" then goto scod4
if b$=a$ then goto scod5
goto scod4

scod5:
if b$="" then message "Pas de Code Qui Commence par "+a$
clear 18
nc=n:gosub aficode
set_focus 18
hide 20:hide 19:hide 21
return

aficode:
font_name 18,"Fixedsys"
for n=nc to 99-(nc+1)
c$="":a$="":b$="":d$="":lt=0:l=0:ls=0
a$=cdc$(n):ls=4:gosub strig
a$=libc$(n):if len(a$)>36 then a$=left$(a$,36)
ls=37:gosub strig
c$=c$+" "+mrc$(n)
if mrc$(n)="" then c$=c$+"  "
c$=c$+opc$(n)+" |"
a$=catc$(n):ls=32:gosub strig
if oac$(n)=""then oac$(n)=" "
c$=c$+" "+oac$(n)+" | "
cbkcmod$=left$(cbkc$(n),2)
if cbkc$(n)="" then c$=c$+"  "
c$=c$+""+cbkcmod$+" | "
a$=dvc$(n):ls=5:gosub strig
a$=mecc$(n):ls=4:gosub strig
a$=mefc$(n):ls=4:gosub strig
a$=mtc$(n):ls=9:gosub mt:c$=c$+b$
a$=str$(n)
if len(a$)=1 then b$="00"+a$
if len(a$)=2 then b$="0"+a$
if len(a$)=3 then b$=a$
c$=c$+b$
item_add 18,c$
next n
return

strig:
if a$="" then d$=string$(ls," ")+"|":c$=c$+d$:a$="":b$="":d$="":lt=0:l=0:ls=0:return
lt=len(a$):l=ls-lt:b$=left$(a$,lt)+string$(l," ")+"|"
c$=c$+b$:a$="":b$="":lt=0:l=0:ls=0
return

addlist:
for n=1 to 111
font_name 1,"Fixedsys"
if nlig$(n)="" then return
lt=len(lib$(n)):li=36-lt:liba$=lib$(n)
if lt>35 then liba$=left$(lib$(n),35):li=1
lt=len(piece$(n)):lp=10-lt
if mid$(piece$(n),4,1)<>"/" then mec$="000":mef$="000"
if mid$(piece$(n),4,1)="/" then mec$=left$(piece$(n),3):mef$=right$(piece$(n),3)
pcat$=left$(cat$(n),23)
lt=len(pcat$):lc=24-lt
a$=mt$(n):ls=9:gosub mt:pmt$=b$
a$=sld$(n):ls=9:gosub mt:psld$=b$
lt=len(ctr$(n)):lr=5-lt
a$=" "+nlig$(n)+" | "+datoper$(n)+" | "+liba$+string$(li," ")+"| "+mr$(n)+op$(n)+" | "+piece$(n)+string$(lp," ")+"| "+mec$+"/"+mef$+" |"+pcat$+string$(lc," ")+" | "+pmt$+ psld$+string$(lr," ")+ctr$(n)+" |"
print_target_is 1
print a$
next n
return

rose:
2d_fill_color 255,235,235
2d_rectangle 10,15,1190,45
print_locate 24,20:print " LIGNE  |"
print_locate 64,20:print "DATE OPERATION |"
print_locate 147,20:print "                                                  LIBELLE    ou    MOTIF                                                    |"
print_locate 458,20:print " MR +/-  |"
print_locate 515,20:print " N °  de  PIECE        |"
print_locate 605,18:print "  MIN /  MAX      |"
print_locate 754,18:print "CATEGORIE                                    |"
print_locate 904,18:print "    MONTANT                    |"
print_locate 1054,18:print "  SOLDE              |"
print_locate 1134,18:print "CTR          |"
return

mt:
lt=0:l=0:p=0:d$="":b$=""
if a$="" then b$="        0.00 | ":return
lt=len(a$):l=ls-lt
if lt=1 then b$=string$(l," ")+a$+".00 | ":return
gosub pas
return

pas:
p=0:d$="":b$="":e$=""
pa:
p=p+1
if p>lt then b$=string$(l," ")+a$+".00 | ":return
d$=mid$(a$,p,1)
if d$<>"." then goto pa
e$=mid$(a$,p+1,1)
f$=mid$(a$,p+2,1)
if e$="" and f$="" then b$=string$(l+1," ")+a$+"00 | ":return
if e$<>"" and f$="" then b$=string$(l+2," ")+a$+"0 | ":return
if e$<>"" and f$<>"" then b$=string$(l+3," ")+a$+" | ":return
message "Cas non prévu à l'etiquette pa":terminate

datfich:
an$=mid$(fec$(ncpt),5,2):moi$=mid$(fec$(ncpt),7,2)
if moi$="01" then a$="JANVIER / "+an$
if moi$="02" then a$="FEVRIER / "+an$
if moi$="03" then a$="MARS / "+an$
if moi$="04" then a$="AVRIL / "+an$
if moi$="05" then a$="MAI / "+an$
if moi$="06" then a$="JUIN / "+an$
if moi$="07" then a$="JUILLET / "+an$
if moi$="08" then a$="AOUT / "+an$
if moi$="09" then a$="SEPTEMBRE / "+an$
if moi$="10" then a$="OCTOBRE / "+an$
if moi$="11" then a$="NOVEMBBRE / "+an$
if moi$="12" then a$="DECEMBRE / "+an$
return

co:
hide 28:hide 29:hide 30
print_target_is 0
command_target_is 0
inactive 5:inactive 6:inactive 8:inactive 9:inactive 11:inactive 12:inactive 13:inactive 14:inactive 15
cod$(1)="DEP":nlig$(1)="001"
jou$=left$(date$,2):moi$=mid$(date$,4,2):an$=mid$(date$,9,2):datoper$(1)=jou$+"/"+moi$+"/"+an$
lib$(1)="Démarrage du Compte":mr$(1)="AU":op$(1)="§":piece$(1)="Dépard":util$(1)=nomutil$
dest$(1)="":fam$(1)="FONCTION":cat$(1)="FONCTION: Neutre":dv$(1)=datoper$(1):mt$(1)="0.00"
sld$(1)=sldcpt$(ncpt):ctr$(1)="DEP"
for n=2 to 111
nlig$(n)=""
next n
gosub nouvfich
return

nouvfich:
print_locate 50,550:print fec$(ncpt)
a$=left$(fec$(ncpt),4)
an$=mid$(fec$(ncpt),5,2):moi$=mid$(fec$(ncpt),7,2)
rem <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< gosub nouvmoi
fi$=a$+an$+moi$+".cfp"
fec$(ncpt)=fi$
print_locate 50,600:print fec$(ncpt)
gosub sauveliste
gosub sauveoper
execute "cfpeomen.exe"
return

nouvmoi:
n=val(moi$)
if n=12 then n=0:gosub nouvan
n=n+1
if n<10 then moi$="0"+str$(n):return
moi$=str$(n)
return

nouvan:
a=val(an$)
if a=99 then an$="00":return
a=a+1
if a<10 then an$="0"+str$(a):return
an$=str$(a)
return

vert:
2d_fill_color 200,255,200
2d_rectangle 10,580,1190,780
return

jaune:
2d_fill_color 240,245,120
2d_rectangle 10,500,1190,440
print_locate 30,446:print "  JOUR    /    MOIS    /    ANNEE"
return

bleu:
2d_fill_color 140,235,255
2d_rectangle 310,562,820,522
return
rem ----------------------------------------------------------------------------
pasfich:
show 30
print_target_is 30
print_locate 350,10:print "Le fichier "+fi$+" n'existe pas"
print_locate 10,50:print "1er CAS:"
print_locate 30,90:print "Si vous enregistrez une Opération pour la première fois, c'est normal."
print_locate 30,130:print "Attention: dans ce cas, vous devrez faire une fin de mois, pour permettre aux Opérations Automatiques Mensuelles de se faire"
print_locate 30,170:print "Car si vous regardez dans le bandeau de cette fenêtre vous vous apercevrez que le fichier date du mois précédent"
print_locate 30,210:print "Si vos codes d'Opérations Automatiques ne sont pas fait, cliquez sur [abandon] et allez les faire."
print_locate 30,250:print "Si vos Codes Automatiques sont prêts, Cliquez sur [Continuer] et Faite un Changement de mois."
print_locate 10,350:print "2ème CAS:"
print_locate 30,380:print "Ce n'est pas normal, Cliquez sur [Abandon] pour rechercher l'erreur"
show 28:show 29
end
return

verificour:
fi$=fec$(ncpt)
n=file_exists(fi$)
if n=0 then Message "Le fichier "+fi$+" n'existe pas. Suivez les instrutions qui vous seront données.":gosub pasfich:return
if n=1 then return
return
rem ----------------------------------------------------------------------------
sauvevir:
file_open_write 1,"cfpvir.cfp"
for n=1 to 111
file_writeln 1,codv$(n)
file_writeln 1,datoperv$(n)
file_writeln 1,libv$(n)
file_writeln 1,mrv$(n)
file_writeln 1,opv$(n)
file_writeln 1,piecev$(n)
file_writeln 1,utilv$(n)
file_writeln 1,destv$(n)
file_writeln 1,famv$(n)
file_writeln 1,catv$(n)
file_writeln 1,dvv$(n)
file_writeln 1,mtv$(n)
next n
file_close 1
return

chargeoper:
file_open_read 1,fi$
for n=1 to 111
file_readln 1,cod$(n)
file_readln 1,nlig$(n)
file_readln 1,datoper$(n)
file_readln 1,lib$(n)
file_readln 1,mr$(n)
file_readln 1,op$(n)
file_readln 1,piece$(n)
file_readln 1,util$(n)
file_readln 1,dest$(n)
file_readln 1,fam$(n)
file_readln 1,cat$(n)
file_readln 1,dv$(n)
file_readln 1,mt$(n)
file_readln 1,sld$(n)
file_readln 1,ctr$(n)
next n
file_close 1
return

sauveoper:
file_open_write 1,fi$
for n=1 to 111
file_writeln 1,cod$(n)
file_writeln 1,nlig$(n)
file_writeln 1,datoper$(n)
file_writeln 1,lib$(n)
file_writeln 1,mr$(n)
file_writeln 1,op$(n)
file_writeln 1,piece$(n)
file_writeln 1,util$(n)
file_writeln 1,dest$(n)
file_writeln 1,fam$(n)
file_writeln 1,cat$(n)
file_writeln 1,dv$(n)
file_writeln 1,mt$(n)
file_writeln 1,sld$(n)
file_writeln 1,ctr$(n)
next n
file_close 1
return

chargeliste:
file_open_read 1,fil$
for n=1 to 9
file_readln 1,cpt$(n)
file_readln 1,lcpt$(n)
file_readln 1,fec$(n)
file_readln 1,rec$(n)
file_readln 1,sldcpt$(n)
next n
file_close 1
return

sauveliste:
file_open_write 1,fil$
for n=1 to 9
file_writeln 1,cpt$(n)
file_writeln 1,lcpt$(n)
file_writeln 1,fec$(n)
file_writeln 1,rec$(n)
file_writeln 1,sldcpt$(n)
next n
file_close 1
return

chargetf03:
file_open_read 1,"cfptf03.cfp"
file_readln 1,proga$
file_readln 1,fi$
file_readln 1,ncpt
file_close 1
return

tf:
file_open_read 1,"cfptf01.cfp"
file_readln 1,proga$
file_readln 1,nu
file_readln 1,nomutil$
file_readln 1,motutil$
file_readln 1,gradutil$
file_close 1
print_locate 10,780:print "UTILISATEUR :  "+nomutil$
print_locate 1190,780:print date$
return

chargecode:
file_open_read 1,"cfpcodes.cfp"
for n=1 to 99
file_readln 1,cdc$(n)
file_readln 1,libc$(n)
file_readln 1,mrc$(n)
file_readln 1,opc$(n)
file_readln 1,famc$(n)
file_readln 1,catc$(n)
file_readln 1,desc$(n)
file_readln 1,utilc$(n)
file_readln 1,oac$(n)
file_readln 1,cbkc$(n)
file_readln 1,dvc$(n)
file_readln 1,mecc$(n)
file_readln 1,mefc$(n)
file_readln 1,mtc$(n)
next n
file_close 1
return

sauvecode:
file_open_write 1,"cfpcodes.cfp"
for n=1 to 99
file_writeln 1,cdc$(n)
file_writeln 1,libc$(n)
file_writeln 1,mrc$(n)
file_writeln 1,opc$(n)
file_writeln 1,famc$(n)
file_writeln 1,catc$(n)
file_writeln 1,desc$(n)
file_writeln 1,utilc$(n)
file_writeln 1,oac$(n)
file_writeln 1,cbkc$(n)
file_writeln 1,dvc$(n)
file_writeln 1,mecc$(n)
file_writeln 1,mefc$(n)
file_writeln 1,mtc$(n)
next n
file_close 1
return

chargechequiers:
file_open_read 1,fic$
for n=1 to 10
file_readln 1,numchq$(n)
file_readln 1,bkchq$(n)
file_readln 1,utilchq$(n)
file_readln 1,typchq$(n)
file_readln 1,npchk$(n)
file_readln 1,ndchk$(n)
file_readln 1,sitchq$(n)
next n
file_close 1
return

sauvechequiers:
file_open_write 1,fic$
for n=1 to 10
file_writeln 1,numchq$(n)
file_writeln 1,bkchq$(n)
file_writeln 1,utilchq$(n)
file_writeln 1,typchq$(n)
file_writeln 1,npchk$(n)
file_writeln 1,ndchk$(n)
file_writeln 1,sitchq$(n)
next n
file_close 1
return

sauvecheque:
file_open_write 1,fik$
for n=1 to 50
file_writeln 1,nchk$(n)
file_writeln 1,mtchk$(n)
file_writeln 1,datoperchk$(n)
file_writeln 1,datvalchk$(n)
file_writeln 1,ordrechk$(n)
file_writeln 1,sitchk$(n)
next n
file_close 1
return

chargecheque:
file_open_read 1,fik$
for n=1 to 50
file_readln 1,nchk$(n)
file_readln 1,mtchk$(n)
file_readln 1,datoperchk$(n)
file_readln 1,datvalchk$(n)
file_readln 1,ordrechk$(n)
file_readln 1,sitchk$(n)
next n
file_close 1
return

chargedest:
file_open_read 1,"cfpdest.cfp"
for n=1 to 99
file_readln 1,dest$(n)
next n
file_close 1
return

chargecat:
file_open_read 1,fif$
for n=1 to 15
file_readln 1,cat$(n)
next n
file_close 1
return

chargefam:
file_open_read 1,"cfplisfa.cfp"
for n=1 to 20
file_readln 1,fifam$(n)
file_readln 1,fam$(n)
next n
file_close 1
return

rem --------------------------------

fen2:
form 30
top 30,100:left 30,150:width 30,1040:height 30,600
caption 30,"COMPTE FAMILIALE  *  Enregistrement d'une Opérations sur le Compte:  "+lcpt$(ncpt)+"  *  "+a$+"  *"
color 30,200,240,255
font_name 30,"Fixedsys"
hide 30
command_target_is 30
button 28
left 28,315:top 28,500:width 28,150
caption 28,"Continuer"
on_click 28,co
hide 28
button 29
left 29,580:top 29,500:width 29,150
caption 29,"Abandon"
on_click 29,quit
hide 29
command_target_is 0
return

rem ----------------------------------------------------------------------------
rec:
execute "cfpeomen.exe":goto fin
return

quit:
execute "cfpmenug.exe"
fin:
terminate

rem cfpgcat

label quit,tf,aide,creation,suppression,modification

dim n,nu
dim nomutil$,motutil$,gradutil$
dim fi$,proga$

left 0,223
top 0,182
width 0,382
height 0,301
caption 0,"COMPTE FAMILIALE * Gestion des Catégories *"
 
button 1
left 1,30
top 1,30
width 1,218
caption 1,"Créer une nouvelle Catégorie"
on_click 1,creation

button 2
left 2,30
top 2,80
width 2,218
caption 2,"Modifier une Catégorie"
on_click 2,modification

button 3
left 3,30
top 3,130
width 3,218
caption 3,"Supprimer une Catégorie"
on_click 3,suppression

button 4
left 4,30
top 4,180
width 4,218
caption 4,"Retour au Menu Général"
on_click 4,quit

button 5
left 5,298
top 5,30
width 5,30
caption 5,"?"
on_click 5,aide

form 6
left 6,640
top 6,182
width 6,400
height 6,301
caption 6,"COMPTE FAMILIALE *  Aide *"
color 6,255,255,255
font_color 6,0,0,255
hide 6

gosub tf
end
rem -------------------------------------------------------------------------
aide:
show 6
print_target_is 6
print_locate 10,10:print "Sélectionnez l'option choisie"
print_target_is 6
return

modification:
execute cfpmocat.exe
terminate
return

suppression:
execute cfpsucat.exe
terminate
return

creation:
execute cfpcrcat.exe
terminate
return

tf:
file_open_read 1,"cfptf01.cfp"
file_readln 1,proga$
file_readln 1,nu
file_readln 1,nomutil$
file_readln 1,motutil$
file_readln 1,gradutil$
file_close 1
print_locate 10,250:print "UTILISATEUR: "+nomutil$
if gradutil$="INACTIF" then message " "+nomutil$+" Votre statut ne vous permet pas d'accèder à ce programme":gosub quit
return

quit:
execute cfpmenug.exe
terminate

rem cfptride

label sauvedest,chargedest,add,ignore,recrefiche

dim n,maxn
dim dest$(100)
dim fi$,destp$,des$


left 0,219
top 0,182
width 0,408
height 0,492
caption 0,"COMPTE FAMILIALE * Tri des Destinataires *"
 
list 1
left 1,39
top 1,13
width 1,157
height 1,420

fi$= "cfpdest.cfp"
gosub chargedest
gosub add
sort 1
gosub recrefiche

end
rem -----------------------------------------------------
recrefiche:
maxn=count(1)
for n=1 to maxn
des$=item_read$(1,n)
dest$(n)=des$
next n
gosub sauvedest
execute cfpgdest.exe
terminate
return

add:
for n=1 to 100
if dest$(n)="" then goto ignore
destp$=dest$(n)
item_add 1,destp$
ignore:
next n
return
rem -----------------------------------------------------
chargedest:
file_open_read 1,fi$
for n=1 to 100
file_readln 1,dest$(n)
next n
file_close 1
return

sauvedest:
fi$= "cfpdest.cfp"
file_open_write 1,fi$
for n=1 to 100
file_writeln 1,dest$(n)
next n
file_close 1
return

rem cfpsmcod

label quit,tf,fin,addlist,strig,mt,pas,afireste,aide,code,efen,verifcode
label lib,veriflib,mr,op,oam,bk,chcptutil,fam,cat,dest,util,jv,montant,verifmontant
label mec,mef,enreg,choix,sup,mod,deux,afi2,afi3,activation,pa,adollar
label sauvecode,chargecode,chargeliste,chargefam,chargecat,chargedest,chargeutil


dim a,n,nc,nu,l,lt,ls,p,fe,t,lv
dim a$,b$,c$,d$,e$,f$,nu$,fi$,cbkcmod$,sup$
dim proga$,nomutil$,motutil$,gradutil$
dim cdc$(99),libc$(99),mrc$(99),opc$(99),famc$(99),catc$(99),desc$(99),utilc$(99),oac$(99),cbkc$(99),dvc$(99),mecc$(99),mefc$(99),mtc$(99)
dim cpt$(9),lcpt$(9),fec$(9),rec$(9),sldcpt$(9)
dim fam$(20),fifam$(20)
dim cat$(15)
dim dest$(99),cdct$(99)
dim util$(10),mdp$(10),grad$(10)

left 0,100:top 0,100:width 0,1071:height 0,500
caption 0,"COMPTE FAMILIALE  *  Suppresion ou Modification d'un Code  *"

button 1:left 1,940:top 1,380:width 1,90:height 1,20
caption 1,"Retour au MENU"
on_click 1,quit

form 2:left 2,98:top 2,615:width 2,1071:height 2,290
caption 2,"COMPTE FAMILIALE *  Aide *"
color 2,255,255,255
font_size 2,10:font_color 2,0,0,255

list 3:left 3,2:top 3,40:width 3,1058:height 3,121
on_click 3,afireste

alpha 4:left 4,9:top 4,178:width 4,33
caption 4,"CODE:"
inactive 4

edit 5:left 5,46:top 5,175:width 5,48
inactive 5

button 6:left 6,99:top 6,176:width 6,20:height 6,20
caption 6,"OK"
inactive 6

alpha 7:left 7,134:top 7,178:width 7,49
caption 7,"LIBELLE:"
inactive 7

edit 8:left 8,182:top 8,175:width 8,248
on_change 8,lib
inactive 8

button 9:left 9,436:top 9,176:width 9,20:height 9,20
caption 9,"OK"
inactive 9
on_click 9,veriflib

alpha 10:left 10,469:top 10,178
caption 10,"MODE DE REGLEMENT:"
inactive 10

combo 11:left 11,595:top 11,175:width 11,40
item_add 11,"CB"
item_add 11,"CH"
item_add 11,"VI"
item_add 11,"ES"
item_add 11,"AU"
on_click 11,mr
inactive 11

alpha 12:left 12,657:top 12,178
caption 12,"OPERATEUR:"
inactive 12

combo 13:left 13,730:top 13,175:width 13,40
font_bold 13
item_add 13,"+"
item_add 13,"-"
inactive 13
on_click 13,op

alpha 14:left 14,780:top 14,178:width 14,56
caption 14,"OP AUTOMATIQUE:"
inactive 14

combo 15:left 15,885:top 15,175:width 15,53
item_add 15,"OUI"
item_add 15,"NON"
on_click 15,oam
inactive 15

alpha 16:left 16,9:top 16,219:width 16,50
caption 16,"BANQUE:"
inactive 16

combo 17:left 17,60:top 17,215
gosub tf:gosub chcptutil: rem chargement utilisateur et comptes <<<<<<
for n=1 to 9
item_add 17,lcpt$(n)
next n
inactive 17
on_click 17,bk
if gradutil$="INACTIF" then message " "+nomutil$+" Vous ne pouvez pas créer de code vu votre statut":terminate

alpha 18:left 18,216:top 18,219:width 18,52
caption 18,"FAMILLE:"
inactive 18

combo 19:left 19,268:top 19,215
gosub chargefam
for n=1 to 20
item_add 19,fam$(n)
next n
inactive 19
on_click 19,fam

alpha 20:left 20,421:top 20,219:width 20,52
caption 20,"CATEGORIE:"
inactive 20

combo 21:left 21,490:top 21,215
on_click 21,cat
inactive 21
hint 21,"vous devez d'abord resélectionner la famille pour changer la catégorie"

alpha 22:left 22,644:top 22,219:width 22,52
caption 22,"DESTINATAIRE/EMETTEUR:"
inactive 22

combo 23:left 23,794:top 23,215
gosub chargedest:rem chargement et remplissage des destinataires <<<<<<<<<
for n=1 to 99
item_add 23,dest$(n)
next n
inactive 23
on_click 23,dest

alpha 24:left 24,9:top 24,259:width 24,52
caption 24,"UTILISATEUR:"
inactive 24

combo 25:left 25,88:top 25,255
gosub chargeutil:rem chargement et remplissage des Utlisateurs <<<<<<<<<
for n=1 to 10
item_add 25,util$(n)
next n
inactive 25
on_click 25,util

alpha 26:left 26,244:top 26,259:width 26,52
caption 26,"JOUR DE VALEUR:"
inactive 26

combo 27:left 27,344:top 27,255:width 27,40
for n=0 to 31
item_add 27,n
next n
inactive 27
on_click 27,jv

alpha 28:left 28,394:top 28,259:width 28,52
caption 28,"MONTANT:"
inactive 28

edit 29:left 29,455:top 29,255:width 29,110
inactive 29
on_change 29,montant

button 30:left 30,570:top 30,256:width 30,20:height 30,20
caption 30,"OK"
inactive 30
on_click 30,verifmontant

alpha 31:left 31,599:top 31,259:width 31,52
caption 31,"MENSUALITE ACTUELLE:"
inactive 31

combo 32:left 32,731:top 32,255:width 32,45
for n=0 to 999
item_add 32,n
next n
inactive 32
on_click 32,mec

alpha 33:left 33,780:top 33,259:width 33,52
caption 33,"MENSUALITE FINALE:"
inactive 33

combo 34:left 34,894:top 34,255:width 34,45
for n=0 to 999
item_add 34,n
next n
inactive 34
on_click 34,mef

button 35:left 35,940:top 35,414:width 35,90:height 35,25
caption 35,"ENREGISTRER"
inactive 35
on_click 35,enreg

gosub efen
gosub chargecode:gosub addlist:nc=n
gosub aide

end
rem ----------------------------------------------------------------------------
choix:
hide 2:inactive 0
if cdc$(n)="" then message "Sélection Vide":active 0:return
if left$(cdc$(n),2)="SA" then message "Vous ne pouvez pas Modifier ou Supprimer ce Code":active 0:return
if cdc$(n)="D" or cdc$(n)="CHA" or cdc$(n)="RG+" or cdc$(n)="RG-" then message "Vous ne pouvez pas Modifier ou Supprimer ce Code":active 0:return
if cdc$(n)="RD" or cdc$(n)="DDC" or cdc$(n)="DDB" or cdc$(n)="CPA" then message "Vous ne pouvez pas Modifier ou Supprimer ce Code":active 0:return
if cdc$(n)="MUT" or cdc$(n)="RCH" or cdc$(n)="VEB" then message "Vous ne pouvez pas Modifier ou Supprimer ce Code":active 0:return
form 36:top 36,620:left 36,500
border_small 36
caption 36, "Votre Choix ?"
command_target_is 36
check 37:top 37,50:left 37,120:caption 37,Supprimer
on_click 37,sup
check 38:top 38,70:left 38,120:caption 38,Modifier
on_click 38,mod
print_target_is 36
print_locate 32,150:print "Le Code =>  "+cdc$(n)+"  "+libc$(n)
print_target_is 0
gosub afi3
command_target_is 0
nc=n
print_locate 40,10:print "  ":print_locate 40,22:print nc
return

sup:
active 0
hide 36:caption 35,SUPPRIMER:active 35
gosub afi3
cdc$(nc)="":libc$(nc)="":mrc$(nc)="":opc$(nc)="":famc$(nc)="":catc$(nc)="":desc$(nc)="":utilc$(nc)="":oac$(nc)="":cbkc$(nc)="":dvc$(nc)="":mecc$(nc)="":mefc$(nc)="":mtc$(nc)=""
sup$="O"
return

mod:
active 0
hide 36:caption 35,MODIFIER:active 35
gosub activation:gosub afi2
gosub efen
print_locate 220,350:print "Faites vos Modifications et Cliquez sur Modifier"
return

activation:
active 7:active 8:active 10:active 11:active 12:active 13:active 14:active 15
active 16:active 17:active 18:active 19:active 20:active 21:active 22:active 23
active 24:active 25:active 26:active 27:active 28:active 29:active 31:active 32
active 33:active 34
return

afi2:
gosub deux
a$=""
if oac$(nc)="N" then a$="NON"
if oac$(nc)="O" then a$="OUI"
text 15,a$
text 32,mecc$(nc):text 34,mefc$(nc)
text 11,mrc$(nc):text 13,opc$(nc):text 17,cbkc$(nc):text 19,famc$(nc)
text 21,catc$(nc):text 23,desc$(nc):text 25,utilc$(nc):text 27,dvc$(nc)
text 29,mtc$(nc)
return

deux:
text 5,cdc$(nc):text 8,libc$(nc)
return

enreg:
gosub sauvecode
goto quit
return

mef:
a$=text$(34)
gosub adollar
mefc$(nc)=a$
return

adollar:
a=val(a$)
if a<10 then a$="00"+a$:return
if a>9 and a<100 then a$="0"+a$:return
return

mec:
a$=text$(32)
gosub adollar
mecc$(nc)=a$
return


montant:
a$=text$(29)
mtc$(nc)=a$
active 30
return

verifmontant:
n=numeric(a$)
if n=0 then message "Vous devez saisir un valeur numérique":return
inactive 30
return

jv:
a$=text$(27):a=val(a$)
if a<10 then a$="0"+a$
if a>9  then a$=""+a$
dvc$(nc)=a$
return

util:
n=item_index(25)
utilc$(nc)=util$(n)
return

dest:
n=item_index(23)
if dest$(n)="" then message "Sélection vide":return
desc$(nc)=dest$(n)
return

cat:
n=item_index(21)
if cat$(n)="" then message "Sélection vide":return
catc$(nc)=cat$(n)
return

fam:
n=item_index(19)
if fam$(n)="" then message "Sélection vide":return
famc$(nc)=fam$(n)
fi$=fifam$(n):gosub chargecat
for n=1 to 15
item_add 21,cat$(n)
next n
catc$(nc)=""
text 21,catc$(nc)
return

bk:
n=item_index(17)
if cpt$(n)="" then message "Sélection vide":return
cbkc$(nc)=cpt$(n)
return

oam:
a$=text$(15)
if mrc$(nc)="CB" and a$="OUI" then message "il ne peut pas y avoir une OAM pour une Carte Bancaire":return
if mrc$(nc)="ES" and a$="OUI" then message "il ne peut pas y avoir une OAM pour une opération en espèce":return
oac$(nc)=left$(a$,1)
return

op:
a$=text$(13)
if mrc$(nc)="CB" and a$="+" then message "L'opérateur pour une Carte Bancaire ne peut pas être +":return
if mrc$(nc)="CH" and a$="+" then message "Attention: il s'agit d'une remise de Chèque"
opc$(nc)=a$
return

mr:
a$=text$(11)
mrc$(nc)=a$
return

lib:
active 9
a$=text$(8)
if len(a$)>36 then message "36 caractères maximum":text 8,"":return
return

veriflib:
if len(a$)<2 then message "2 caractères minimum":text 8,"":return
libc$(nc)=a$
inactive 9
return

code:
a$=upper$(text$(5))
hide 2:active 6
print_locate 40,10:print "  ":print_locate 40,10:print nc
if len(a$)>3 then message "3 caractères maximum":text 5,"":return
return

verifcode:
if a$="" then message "1 caractères minimum":text 5,"":return
if a$="" then text 5,"":return
cdc$(nc)=a$
inactive 5:hide 6:active 7:active 36:active 8:set_focus 8
return

efen:
2d_fill_color 240,235,235
2d_rectangle 50,300,900,440
return

aide:
print_target_is 2
print_locate 10,10:print "Quelques Conseils pour Modifier ou Supprimer un Code:"
print_locate 10,30:print "La modification de certains éléments (comme la catégorie) peut perturber les Stats"
print_locate 10,50:print "La suppression d'un code peut gêner les autres utilisateurs"
print_locate 10,70:print ""
print_locate 10,90:print "Pour changer la Catégorie vous devez d'abord sélectionner une famille pour charger les catégories de la famille"
print_locate 10,110:print ""
print_locate 10,130:print ""
print_locate 10,160:print ""
print_locate 10,180:print "Pour commencer, sélectionnez le code à supprimer ou à modifier"
print_locate 10,220:print ""
print_target_is 0
return

afireste:
gosub efen
n=item_index(3)
print_locate 60,310:print string$(100," ")
print_locate 60,330:print string$(100," ")
print_locate 60,310:print "Utilisateur du Code "+libc$(n)+": "+utilc$(n)
print_locate 60,330:print "Destinataire/Emetteur du Code "+libc$(n)+": "+desc$(n)
gosub choix
return

addlist:
gosub afi3
font_name 3,"Fixedsys"
for n=1 to 99
rem if cdc$(n)="" then return
c$="":a$="":b$="":d$="":lt=0:l=0:ls=0
a$=cdc$(n):ls=4:gosub strig
a$=libc$(n):if len(a$)>36 then a$=left$(a$,36)
ls=37:gosub strig
c$=c$+" "+mrc$(n)
if mrc$(n)="" then c$=c$+"  "
c$=c$+opc$(n)+" |"
a$=catc$(n):ls=32:gosub strig
if oac$(n)=""then oac$(n)=" "
c$=c$+" "+oac$(n)+" | "
cbkcmod$=left$(cbkc$(n),2)
if cbkc$(n)="" then c$=c$+"  "
c$=c$+""+cbkcmod$+" | "
a$=dvc$(n):ls=5:gosub strig
a$=mecc$(n):ls=4:gosub strig
a$=mefc$(n):ls=4:gosub strig
a$=mtc$(n):ls=9:gosub mt:c$=c$+b$
a$=str$(n)
if len(a$)=1 then b$="00"+a$
if len(a$)=2 then b$="0"+a$
if len(a$)=3 then b$=a$
c$=c$+b$
item_add 3,c$
next n
return

afi3:
print_locate 7,22:print "CODE"
print_locate 132,22:print "LIBELLE DU CODE"
print_locate 346,22:print "MR +/-"
print_locate 442,22:print "FAMILLE et CATEGORIE"
print_locate 657,22:print "OAM"
print_locate 690,22:print "BANQUE"
print_locate 744,22:print "J/VAL"
print_locate 790,22:print "MENSUALITE"
print_locate 900,22:print "MONTANT"
print_locate 980,22:print "N° Ligne"
return

mt:
lt=0:l=0:p=0:d$="":b$=""
if a$="" then b$="        0.00 | ":return
if val(a$)=0 then b$="        0.00 | ":return
lt=len(a$):l=ls-lt
if lt=1 then b$=string$(l," ")+a$+".00 | ":return
gosub pas
return

pas:
p=0:d$="":b$="":e$=""

pa:
p=p+1
if p>lt then b$=string$(l," ")+a$+".00 | ":return
d$=mid$(a$,p,1)
if d$<>"." then goto pa
e$=mid$(a$,p+1,1):f$=mid$(a$,p+2,1)
if e$="" and f$="" then b$=string$(l+1," ")+a$+"00 | ":return
if e$<>"" and f$="" then b$=string$(l+2," ")+a$+"0 | ":return
if e$<>"" and f$<>"" then b$=string$(l+3," ")+a$+" | ":return
message "Cas non prévu à l'etiquette pa":terminate

strig:
if a$="" then d$=string$(ls," ")+"|":c$=c$+d$:a$="":b$="":d$="":lt=0:l=0:ls=0:return
lt=len(a$):l=ls-lt:b$=left$(a$,lt)+string$(l," ")+"|"
c$=c$+b$:a$="":b$="":lt=0:l=0:ls=0
return

chcptutil:
nu$=str$(nu)
fi$="cfplc" + nu$ + ".cfp"
fe=file_exists (fi$)
if fe=0 then message nomutil$+" Vous n'avez pas de compte ouvert":goto fin
if fe=1 then gosub chargeliste:return
return

rem --------------------------------------------------------------------------
chargeutil:
file_open_read 1,"utilisateur.cfp"
for n=1 to 10
file_readln 1,util$(n)
file_readln 1,mdp$(n)
file_readln 1,grad$(n)
next n
file_close 1
return

chargedest:
fi$= "cfpdest.cfp"
file_open_read 1,fi$
for n=1 to 99
file_readln 1,dest$(n)
next n
file_close 1
return

chargecat:
file_open_read 1,fi$
for n=1 to 15
file_readln 1,cat$(n)
next n
file_close 1
return

chargeliste:
file_open_read 1,fi$
for n=1 to 9
file_readln 1,cpt$(n)
file_readln 1,lcpt$(n)
file_readln 1,fec$(n)
file_readln 1,rec$(n)
file_readln 1,sldcpt$(n)
next n
file_close 1
return

chargefam:
file_open_read 1,"cfplisfa.cfp"
for n=1 to 20
file_readln 1,fifam$(n)
file_readln 1,fam$(n)
next n
file_close 1
return

chargecode:
file_open_read 1,"cfpcodes.cfp"
for n=1 to 99
file_readln 1,cdc$(n)
file_readln 1,libc$(n)
file_readln 1,mrc$(n)
file_readln 1,opc$(n)
file_readln 1,famc$(n)
file_readln 1,catc$(n)
file_readln 1,desc$(n)
file_readln 1,utilc$(n)
file_readln 1,oac$(n)
file_readln 1,cbkc$(n)
file_readln 1,dvc$(n)
file_readln 1,mecc$(n)
file_readln 1,mefc$(n)
file_readln 1,mtc$(n)
next n
file_close 1
return

sauvecode:
file_open_write 1,"cfpcodes.cfp"
for n=1 to 99
file_writeln 1,cdc$(n)
file_writeln 1,libc$(n)
file_writeln 1,mrc$(n)
file_writeln 1,opc$(n)
file_writeln 1,famc$(n)
file_writeln 1,catc$(n)
file_writeln 1,desc$(n)
file_writeln 1,utilc$(n)
file_writeln 1,oac$(n)
file_writeln 1,cbkc$(n)
file_writeln 1,dvc$(n)
file_writeln 1,mecc$(n)
file_writeln 1,mefc$(n)
file_writeln 1,mtc$(n)
next n
file_close 1
return

tf:
file_open_read 1,"cfptf01.cfp"
file_readln 1,proga$
file_readln 1,nu
file_readln 1,nomutil$
file_readln 1,motutil$
file_readln 1,gradutil$
file_close 1
print_locate 9,448:print "UTILISATEUR: "+nomutil$
print_locate 830,448:print date$
return

rem ---------------------------------------------------------------------------
quit:
execute cfptrcod.exe
fin:
terminate

rem cfpvir

label fin,tf,chargevir,chargetf03,chargeliste,sauveliste,debut,rpov,chargeoper
label sauveoper

dim n,n1,n2,nc,no,nu,ncpt,asld,sld,mt
dim a$,b$,nc$,nu$,fi$,fil$
dim cod$(111),nlig$(111),datoper$(111),lib$(111),mr$(111),op$(111),piece$(111),util$(111),dest$(111),fam$(111),cat$(111),dv$(111),mt$(111),sld$(111),ctr$(111)
dim codv$(111),datoperv$(111),libv$(111),mrv$(111),opv$(111),piecev$(111),utilv$(111),destv$(111),famv$(111),catv$(111),dvv$(111),mtv$(111)
dim proga$,nomutil$,motutil$,gradutil$
dim cpt$(9),lcpt$(9),fec$(9),rec$(9),sldcpt$(9)


left 0,402
top 0,261
width 0,550
height 0,192
caption 0,"COMPTE FAMILIALE  *  Execution des virements comptes à comptes  *"


gosub chargevir
gosub tf:nu$=str$(nu):gosub chargetf03:fil$=fi$:gosub chargeliste
proga$="cfpmenug.exe"
n=0:gosub debut
print_locate 10,50:print "PATIENTEZ Virements Comptes à Comptes en cours...."
wait 500
execute proga$
goto fin
end
rem ---------------------------------------------------------------------------

debut:
n=n+1
if destv$(n)="" then return
a$=destv$(n):nc$=right$(a$,1):nc=val(nc$):fi$=fec$(nc)
if file_exists(fi$)=0 then message "Le fichier "+fi$+" n'existe pas, Vous devez l'ouvrir. Les virements sur le compte "+lcpt$(nc)+" devront être fait manuelement pour cette fois":goto fin
gosub chargeoper:gosub rpov
cod$(no)=codv$(n)
b$=str$(no)
if no<10 then nlig$(no)="00"+b$
if no>9 and no<100 then nlig$(no)="0"+b$
if no>100 then nlig$(no)=""+b$
datoper$(no)=datoperv$(n):lib$(no)=libv$(n):mr$(no)=mrv$(n):op$(no)=opv$(n)
piece$(no)=piecev$(n):util$(no)=utilv$(n):dest$(no)=destv$(n):fam$(no)=famv$(n)
cat$(no)=catv$(n):dv$(no)=dvv$(n):mt$(no)=mtv$(n):ctr$(no)=""
asld=val(sld$(no-1)):mt=val(mt$(no))
if op$(no)="+" then sld=asld+mt
if op$(no)="-" then sld=asld-mt
sld$(no)=str$(sld)
gosub sauveoper
sldcpt$(nc)=sld$(no)
gosub sauveliste
goto debut


rpov:
for n1=1 to 111
if n1>111 then message "plus de place pour une nouvelle opération":goto fin
if nlig$(n1)="" then no=n1:return
next n1
return

rem ---------------------------------------------------------------------------
chargevir:
file_open_read 1,"cfpvir.cfp"
for n=1 to 111
file_readln 1,codv$(n)
file_readln 1,datoperv$(n)
file_readln 1,libv$(n)
file_readln 1,mrv$(n)
file_readln 1,opv$(n)
file_readln 1,piecev$(n)
file_readln 1,utilv$(n)
file_readln 1,destv$(n)
file_readln 1,famv$(n)
file_readln 1,catv$(n)
file_readln 1,dvv$(n)
file_readln 1,mtv$(n)
next n
file_close 1
return

chargeliste:
file_open_read 1,fil$
for n1=1 to 9
file_readln 1,cpt$(n1)
file_readln 1,lcpt$(n1)
file_readln 1,fec$(n1)
file_readln 1,rec$(n1)
file_readln 1,sldcpt$(n1)
next n1
file_close 1
return

sauveliste:
file_open_write 1,fil$
for n1=1 to 9
file_writeln 1,cpt$(n1)
file_writeln 1,lcpt$(n1)
file_writeln 1,fec$(n1)
file_writeln 1,rec$(n1)
file_writeln 1,sldcpt$(n1)
next n1
file_close 1
return

chargetf03:
file_open_read 1,"cfptf03.cfp"
file_readln 1,proga$
file_readln 1,fi$
file_readln 1,ncpt
file_close 1
return

chargeoper:
file_open_read 1,fi$
for n2=1 to 111
file_readln 1,cod$(n2)
file_readln 1,nlig$(n2)
file_readln 1,datoper$(n2)
file_readln 1,lib$(n2)
file_readln 1,mr$(n2)
file_readln 1,op$(n2)
file_readln 1,piece$(n2)
file_readln 1,util$(n2)
file_readln 1,dest$(n2)
file_readln 1,fam$(n2)
file_readln 1,cat$(n2)
file_readln 1,dv$(n2)
file_readln 1,mt$(n2)
file_readln 1,sld$(n2)
file_readln 1,ctr$(n2)
next n2
file_close 1
return

sauveoper:
file_open_write 1,fi$
for n2=1 to 111
file_writeln 1,cod$(n2)
file_writeln 1,nlig$(n2)
file_writeln 1,datoper$(n2)
file_writeln 1,lib$(n2)
file_writeln 1,mr$(n2)
file_writeln 1,op$(n2)
file_writeln 1,piece$(n2)
file_writeln 1,util$(n2)
file_writeln 1,dest$(n2)
file_writeln 1,fam$(n2)
file_writeln 1,cat$(n2)
file_writeln 1,dv$(n2)
file_writeln 1,mt$(n2)
file_writeln 1,sld$(n2)
file_writeln 1,ctr$(n2)
next n2
file_close 1
return

tf:
file_open_read 1,"cfptf01.cfp"
file_readln 1,proga$
file_readln 1,nu
file_readln 1,nomutil$
file_readln 1,motutil$
file_readln 1,gradutil$
file_close 1
rem print_locate 10,10:print "UTILISATEUR :  "+nomutil$
rem print_locate 255,10:print date$
return

fin:
terminate

rem cfpnovan

label nouvfich,tf,chargetf03,chargeliste,datfich,sauveliste
label sauveoper,minmax,demar
label aide,validnvmois,quit,fin,bleu,jaune,rose,vert
label ligreport,addlist,strig,pas,pa,pa2,mt
label adollar

dim a,b,c,n,n1,n3,nb,nc,ncc,nf,nu,nr,ncpt,l,lt,lp,l2,lc,ls,lr,p,li,no,nbch,pas,pass,mt,nch,ncq
dim a$,b$,c$,d$,e$,f$,fi$,fil$,an$,moi$,jou$,liba$,mec$,mef$,pcat$,pmt$,psld$,nu$,fic$,fik$
dim proga$,nomutil$,motutil$,gradutil$,cbkcmod$,afam$,oa$
dim cpt$(9),lcpt$(9),fec$(9),rec$(9),sldcpt$(9)
dim cod$(111),nlig$(111),datoper$(111),lib$(111),mr$(111),op$(111),piece$(111),util$(111),dest$(111),fam$(111),cat$(111),dv$(111),mt$(111),sld$(111),ctr$(111)
dim cdc$(99),libc$(99),mrc$(99),opc$(99),famc$(99),catc$(99),desc$(99),utilc$(99),oac$(99),cbkc$(99),dvc$(99),mecc$(99),mefc$(99),mtc$(99)

left 0,9
top 0,60:width 0,1264:height 0,834
gosub tf:gosub chargetf03:fil$=fi$:gosub chargeliste:gosub nouvfich:gosub datfich
caption 0,"COMPTE FAMILIALE  *  Enregistrement des Opérations Annuelles sur le Compte:  "+lcpt$(ncpt)+"  *  "+a$+"  *"
font_name 0,"Impact"
font_size 0,9

list 1
left 1,10:top 1,50:width 1,1180:height 1,300
color 1,190,255,255

button 2
left 2,1165:top 2,355:width 2,20:height 2,20
caption 2,"?"
on_click 2,aide

picture 3
left 3,10:top 3,384:width 3,1180:height 3,50

button 5
left 5,200:top 5,470
caption 5,"Motif"

button 6
left 6,340:top 6,470
caption 6,"MR"

button 8
left 8,670:top 8,470
caption 8,"Destinataire"

button 9
left 9,840:top 9,470
caption 9,"Montant"

button 10
left 10,810:top 10,470:width 10,80
caption 10,"Date de Valeur"
hide 10

button 11
left 11,15:top 11,354:width 11,150
caption 11,"Démarrer la Nouvelle Année"
font_size 11,9
on_click 11,demar

button 14
left 14,500:top 14,470
caption 14,"Catégorie"

button 16
left 16,370:top 16,530:width 16,170
caption 16,"Valider la Nouvelle Année"
on_click 16,validnvmois
inactive 16

button 17
left 17,605:top 17,530:width 17,150
caption 17,"Retour au Menu général"
on_click 17,quit

button 25:top 25,510:left 25,25:width 25,150:height 25,20:caption 25,"Confirmation Date Opération"
hide 25

edit 27:top 27,650:left 27,155:width 27,225:height 27,20
hide 27

button 31:top 31,652:left 31,395:width 31,20:height 31,20:caption 31,"OK"
hide 31

edit 23:top 23,540:left 23,980:width 23,80:height 23,25
hide 23

button 24:top 24,544:left 24,1065:width 24,20:height 24,20:caption 24,"OK"
hide 24
print_locate 10,780:print "UTILISATEUR :  "+nomutil$
print_locate 1180,780:print date$

gosub bleu:gosub jaune:gosub rose
inactive 5:inactive 6:inactive 8:inactive 9:inactive 10:inactive 14
set_focus 11
end
rem ----------------------------------------------------------------------------
aide:
return

demar:
gosub nouvfich
gosub ligreport
gosub addlist
active 16
return

validnvmois:
gosub sauveoper
gosub sauveliste
execute "cfpeoanu.exe"
goto fin
return

minmax:
a=val(mecc$(nc)):b=val(mefc$(nc))
if b=0 then return
if b>0 then a=a+1
a$=str$(a):gosub adollar
b$=mefc$(nc)
mecc$(nc)=a$
if a>b then piece$(no)="Terminé":mt=0:mt$(no)="0,00":return
piece$(no)=a$+"/"+b$
return

adollar:
a=val(a$)
if a<10 then a$="00"+a$:return
if a>9 and a<100 then a$="0"+a$:return
return

ligreport:
cod$(1)="REP":nlig$(1)="001"
jou$=left$(date$,2):moi$=mid$(date$,4,2):an$=mid$(date$,9,2):datoper$(1)=jou$+"/"+moi$+"/"+an$
lib$(1)="Report du Mois Précédent":mr$(1)="AU":op$(1)="§":piece$(1)="Report":util$(1)=nomutil$
dest$(1)="":fam$(1)="FONCTION":cat$(1)="FONCTION: Neutre":dv$(1)=datoper$(1):mt$(1)="0.00"
sld$(1)=sldcpt$(ncpt):ctr$(1)="REP"
for n=2 to 111
nlig$(n)=""
next n
return

strig:
if a$="" then d$=string$(ls," ")+"|":c$=c$+d$:a$="":b$="":d$="":lt=0:l=0:ls=0:return
lt=len(a$):l=ls-lt:b$=left$(a$,lt)+string$(l," ")+"|"
c$=c$+b$:a$="":b$="":lt=0:l=0:ls=0
return

addlist:
clear 1
pcat$=""
for n=1 to 111
font_name 1,"Fixedsys"
if nlig$(n)="" then return
lt=len(lib$(n)):li=36-lt:liba$=lib$(n)
if lt>35 then liba$=left$(lib$(n),35):li=1
lt=len(piece$(n)):lp=9-lt
if mid$(piece$(n),4,1)<>"/" then mec$="000":mef$="000"
if mid$(piece$(n),4,1)="/" then mec$=left$(piece$(n),3):mef$=right$(piece$(n),3)
pcat$=left$(cat$(n),23)
lt=len(pcat$):lc=24-lt
a$=mt$(n):ls=9:gosub mt:pmt$=b$
a$=sld$(n):ls=9:gosub mt:psld$=b$
lt=len(ctr$(n)):lr=5-lt
a$=" "+nlig$(n)+" | "+datoper$(n)+" | "+liba$+string$(li," ")+"| "+mr$(n)+op$(n)+" | "+piece$(n)+string$(lp," ")+"| "+mec$+"/"+mef$+" |"+pcat$+string$(lc," ")+" | "+pmt$+ psld$+string$(lr," ")+ctr$(n)+" |"
print_target_is 1
print a$
next n
print_target_is 0
return

rose:
2d_fill_color 255,235,235
2d_rectangle 10,15,1190,45
print_locate 24,20:print " LIGNE  |"
print_locate 64,20:print "DATE OPERATION |"
print_locate 147,20:print "                                                  LIBELLE    ou    MOTIF                                                    |"
print_locate 458,20:print " MR +/-  |"
print_locate 515,20:print "N °  de  PIECE    |"
print_locate 605,18:print "MIN /  MAX    |"
print_locate 754,18:print "Catégorie                                  |"
print_locate 904,18:print "MONTANT                    |"
print_locate 1054,18:print "  SOLDE            |"
print_locate 1134,18:print "CTR          |"
return

mt:
lt=0:l=0:p=0:d$="":b$=""
if a$="" then b$="        0.00 | ":return
lt=len(a$):l=ls-lt
if lt=1 then b$=string$(l," ")+a$+".00 | ":return
gosub pas
return

pas:
p=0:d$="":b$="":e$="":f$=""
pa:
p=p+1
if p=lt then b$=string$(l," ")+a$+".00 | ":return
d$=mid$(a$,p,1)
if d$="." then goto pa2
goto pa
pa2:
e$=mid$(a$,p+1,1)
f$=mid$(a$,p+2,1)
if e$="" and f$="" then b$=string$(l+1," ")+a$+"00 | ":return
if e$<>"" and f$="" then b$=string$(l+2," ")+a$+"0 | ":return
if e$<>"" and f$<>"" then b$=string$(l+3," ")+a$+" | ":return
message "Cas non prévu à l'etiquette pa":terminate

rose:
2d_fill_color 255,235,235
2d_rectangle 10,15,1190,45
print_locate 24,20:print " LIGNE  |"
print_locate 64,20:print "DATE OPERATION |"
print_locate 147,20:print "                                                  LIBELLE    ou    MOTIF                                                    |"
print_locate 458,20:print " MR +/-  |"
print_locate 515,20:print "N °  de  PIECE    |"
print_locate 605,18:print "MIN /  MAX    |"
print_locate 754,18:print "Catégorie                                  |"
print_locate 904,18:print "MONTANT                    |"
print_locate 1054,18:print "  SOLDE            |"
print_locate 1134,18:print "CTR          |"
return

vert:
2d_fill_color 200,255,200
2d_rectangle 10,580,1190,780
return

jaune:
2d_fill_color 240,245,120
2d_rectangle 10,500,1190,440
return

bleu:
2d_fill_color 140,235,255
2d_rectangle 310,562,820,522
return

datfich:
an$=mid$(fec$(ncpt),5,4)
a$=an$
return

nouvfich:
a$=left$(fec$(ncpt),4)
an$=mid$(fec$(ncpt),5,4)
a=val(an$):a=a+1
an$=str$(a)
fi$=a$+an$+".cfp"
fec$(ncpt)=fi$
print_locate 50,600:print fec$(ncpt)
return

rem ----------------------------------------------------------------------------
sauveoper:
file_open_write 1,fi$
for n=1 to 111
file_writeln 1,cod$(n)
file_writeln 1,nlig$(n)
file_writeln 1,datoper$(n)
file_writeln 1,lib$(n)
file_writeln 1,mr$(n)
file_writeln 1,op$(n)
file_writeln 1,piece$(n)
file_writeln 1,util$(n)
file_writeln 1,dest$(n)
file_writeln 1,fam$(n)
file_writeln 1,cat$(n)
file_writeln 1,dv$(n)
file_writeln 1,mt$(n)
file_writeln 1,sld$(n)
file_writeln 1,ctr$(n)
next n
file_close 1
return

chargeliste:
file_open_read 1,fil$
for n=1 to 9
file_readln 1,cpt$(n)
file_readln 1,lcpt$(n)
file_readln 1,fec$(n)
file_readln 1,rec$(n)
file_readln 1,sldcpt$(n)
next n
file_close 1
return

sauveliste:
file_open_write 1,fil$
for n=1 to 9
file_writeln 1,cpt$(n)
file_writeln 1,lcpt$(n)
file_writeln 1,fec$(n)
file_writeln 1,rec$(n)
file_writeln 1,sldcpt$(n)
next n
file_close 1
return

chargetf03:
file_open_read 1,"cfptf03.cfp"
file_readln 1,proga$
file_readln 1,fi$
file_readln 1,ncpt
file_close 1
return

tf:
file_open_read 1,"cfptf01.cfp"
file_readln 1,proga$
file_readln 1,nu
file_readln 1,nomutil$
file_readln 1,motutil$
file_readln 1,gradutil$
file_close 1
print_locate 10,780:print "UTILISATEUR :  "+nomutil$
print_locate 1190,780:print date$
return

rem --------------------------------
quit:
execute "cfpmenug.exe"
fin:
terminate

rem cfpcodvi

label quit,tf,fin,addlist,strig,mt,pas,afireste,aide,code,efen,verifcode
label doublon,lib,veriflib,afi3,mr,op,afi5,oam,afi6,bk,chcptutil
label fam,cat,afi9,dest,afi10,util,afi11,jv,afi12,montant,verifmontant
label mec,mef,afi15,re,enreg,rpnv,pa,adollar
label sauvecode,chargecode,chargeliste,chargefam,chargecat,chargedest,chargeutil


dim a,n,nc,nu,l,lt,ls,p,fe
dim a$,b$,c$,d$,e$,f$,nu$,fi$,cbkcmod$
dim proga$,nomutil$,motutil$,gradutil$
dim cdc$(99),libc$(99),mrc$(99),opc$(99),famc$(99),catc$(99),desc$(99),utilc$(99),oac$(99),cbkc$(99),dvc$(99),mecc$(99),mefc$(99),mtc$(99)
dim cpt$(9),lcpt$(9),fec$(9),rec$(9),sldcpt$(9)
dim fam$(20),fifam$(20)
dim cat$(15)
dim dest$(99)
dim util$(10),mdp$(10),grad$(10)

left 0,100:top 0,100:width 0,1071:height 0,500
caption 0,"COMPTE FAMILIALE  *  Création d'un Code Virement Compte à Compte *"
 
button 1:left 1,940:top 1,380:width 1,90:height 1,20
caption 1,"Retour au MENU"
on_click 1,quit

form 2:left 2,98:top 2,615:width 2,1071:height 2,290
caption 2,"COMPTE FAMILIALE *  Aide *"
color 2,255,255,255
font_size 2,10:font_color 2,0,0,255

list 3:left 3,2:top 3,40:width 3,1058:height 3,123
on_click 3,afireste

alpha 4:left 4,9:top 4,178:width 4,33
caption 4,"CODE:"

edit 5:left 5,46:top 5,175:width 5,48
text 5,"VI"
on_change 5,code

button 6:left 6,99:top 6,176:width 6,20:height 6,20
caption 6,"OK"
inactive 6
on_click 6,verifcode

alpha 7:left 7,134:top 7,178:width 7,49
caption 7,"LIBELLE:"
inactive 7

edit 8:left 8,182:top 8,175:width 8,248
text 8,"VIREMENT de "
inactive 8
on_change 8,lib

button 9:left 9,436:top 9,176:width 9,20:height 9,20
caption 9,"OK"
inactive 9
on_click 9,veriflib

alpha 10:left 10,469:top 10,178
caption 10,"MODE DE REGLEMENT:"
inactive 10

combo 11:left 11,595:top 11,175:width 11,40
item_add 11,"VI"
inactive 11
text 11,"VI"
on_click 11,mr

alpha 12:left 12,657:top 12,178
caption 12,"OPERATEUR:"
inactive 12

combo 13:left 13,730:top 13,175:width 13,40
font_bold 13
item_add 13,"-"
item_add 13,"+"
inactive 13
text 13,"-"
on_click 13,op

alpha 14:left 14,780:top 14,178:width 14,56
caption 14,"OP AUTOMATIQUE:"
inactive 14

combo 15:left 15,885:top 15,175:width 15,53
item_add 15,"OUI"
item_add 15,"NON"
inactive 15
on_click 15,oam

alpha 16:left 16,9:top 16,219:width 16,50
caption 16,"BANQUE:"
inactive 16

combo 17:left 17,60:top 17,215
gosub tf:gosub chcptutil: rem chargement utilisateur et comptes <<<<<<
for n=1 to 9
item_add 17,lcpt$(n)
next n
inactive 17
on_click 17,bk
if gradutil$="INACTIF" then message " "+nomutil$+" Vous ne pouvez pas créer de code vu votre statut":terminate

alpha 18:left 18,216:top 18,219:width 18,52
caption 18,"FAMILLE:"
inactive 18

combo 19:left 19,268:top 19,215
gosub chargefam
for n=1 to 20
item_add 19,fam$(n)
next n
inactive 19
on_click 19,fam

alpha 20:left 20,421:top 20,215:width 20,52
caption 20,"CATEGORIE:"
inactive 20

combo 21:left 21,490:top 21,210
inactive 21
on_click 21,cat

alpha 22:left 22,644:top 22,219:width 22,52
caption 22,"Banque à créditer"
inactive 22

combo 23:left 23,794:top 23,215
gosub chargedest:rem chargement et remplissage des destinataires <<<<<<<<<
for n=1 to 9
item_add 23,lcpt$(n)
next n
inactive 23
on_click 23,dest

alpha 24:left 24,9:top 24,259:width 24,52
caption 24,"UTILISATEUR:"
inactive 24

combo 25:left 25,88:top 25,255
gosub chargeutil:rem chargement et remplissage des Utlisateurs <<<<<<<<<
for n=1 to 10
item_add 25,util$(n)
next n
inactive 25
on_click 25,util

alpha 26:left 26,244:top 26,259:width 26,52
caption 26,"JOUR DE VALEUR:"
inactive 26

combo 27:left 27,344:top 27,255:width 27,40
for n=0 to 31
item_add 27,n
next n
inactive 27
on_click 27,jv

alpha 28:left 28,394:top 28,259:width 28,52
caption 28,"MONTANT:"
inactive 28

edit 29:left 29,455:top 29,255:width 29,110
inactive 29
on_change 29,montant

button 30:left 30,570:top 30,256:width 30,20:height 30,20
caption 30,"OK"
inactive 30
on_click 30,verifmontant

alpha 31:left 31,599:top 31,259:width 31,52
caption 31,"MENSUALITE ACTUELLE:"
inactive 31

combo 32:left 32,731:top 32,250:width 32,45
for n=0 to 999
item_add 32,n
next n
text 32,"0"
inactive 32
on_click 32,mec

alpha 33:left 33,780:top 33,259:width 33,52
caption 33,"MENSUALITE FINALE:"
inactive 33

combo 34:left 34,894:top 34,255:width 34,45
for n=0 to 999
item_add 34,n
next n
text 34,"0"
inactive 34
on_click 34,mef

button 35:left 35,940:top 35,414:width 35,90:height 35,25
caption 35,"ENREGISTRER"
inactive 35
on_click 35,enreg

button 36:left 36,940:top 36,345:width 36,90:height 36,20
caption 36,"Recommencer"
inactive 36
on_click 36,re

gosub efen
gosub chargecode:gosub addlist:gosub rpnv
gosub aide
print_locate 40,10:print "  ":print_locate 40,22:print nc

end
rem ----------------------------------------------------------------------------

rpnv:
for n=1 to 99
if cdc$(n)="" then nc=n:return
next n
message "Plus de place pour un nouveau Code"
return

enreg:
mrc$(nc)="VI":opc$(nc)="-"
gosub sauvecode
execute cfpcrcod.exe
goto fin
return

re:
execute cfpcrcod.exe
goto fin
return

mef:
a$=text$(34)
gosub adollar
mefc$(nc)=a$
inactive 34:active 35
return

adollar:
a=val(a$)
if a<10 then a$="00"+a$:return
if a>9 and a<100 then a$="0"+a$:return
return

afi15:
gosub efen
print_locate 60,305:print "Votre code est prêt à être enregistré"
print_locate 60,325:print "Il sera possible de le Modifier par la suite"
active 35
return

mec:
a$=text$(32)
gosub adollar
mecc$(nc)=a$
inactive 32:active 33:active 34:set_focus 34
return

montant:
a$=text$(29)
mtc$(nc)=a$
active 30
return

verifmontant:
n=numeric(a$)
if n=0 then message "Vous devez saisir un valeur numérique":return
if right$(a$,1)="." then message "Saisie Incorect":a$="":text 29,"":return
if len(a$)>13 then message "Maxi: 13 caractères)::text 29,"":return
gosub afi15
inactive 28:hide 30:inactive 29:active 31:active 32:set_focus 32
return

jv:
a$=text$(27):a=val(a$)
if a<10 then a$="0"+a$
if a>9  then a$=""+a$
dvc$(nc)=a$
gosub afi12
inactive 26:inactive 27:active 28:active 29:set_focus 29
return

afi12:
gosub efen
print_locate 60,305:print "Saisissez un Montant."
print_locate 60,325:print "Il sera possible de le changer par la suite"
print_locate 60,345:print "Vous pouvez saisir zéro"
return

util:
n=item_index(25)
utilc$(nc)=util$(n)
gosub afi11
inactive 24:inactive 25:active 26:active 27:set_focus 27
text 8,libc$(nc)
return

afi11:
gosub efen
print_locate 60,305:print "Sélectionnez un Jour de Valeur."
print_locate 60,325:print "Il sera possible de le changer par la suite"
print_locate 60,345:print "Vous pouvez saisir zéro"
return

dest:
n=item_index(23)
if dest$(n)="" then message "Sélection vide":return
desc$(nc)=cpt$(n)
libc$(nc)=libc$(nc)+cbkc$(nc)+" vers "+desc$(nc)
gosub afi10
inactive 22:inactive 23:active 24:active 25:set_focus 25
return

afi10:
gosub efen
print_locate 60,305:print "Sélectionnez l'Utilisateur adaptée."
print_locate 60,325:print "Il sera possible de le changer par la suite"
print_locate 60,345:print "Si vous souhaitez que ce Code fonctionne pour tout les Utilisateurs, sélectionnez un blanc."
return

cat:
n=item_index(21)
if cat$(n)="" then message "Sélection vide":return
catc$(nc)=cat$(n)
inactive 21:active 22:active 23:set_focus 23
return

afi9:
gosub efen
print_locate 60,305:print "Sélectionnez le Destinataire ou Emetteur adaptée."
print_locate 60,325:print "Il sera possible de le changer par la suite"
return

fam:
n=item_index(19)
if fam$(n)="" then message "Sélection vide":return
famc$(nc)=fam$(n)
inactive 19:active 20:active 21
fi$=fifam$(n):gosub chargecat
for n=1 to 15
item_add 21,cat$(n)
next n
return

bk:
n=item_index(17)
if cpt$(n)="" then message "Sélection vide":return
cbkc$(nc)=cpt$(n)
gosub afi9
inactive 16:inactive 17:active 18:active 19:set_focus 19
return

oam:
gosub afi5
a$=text$(15)
if mrc$(nc)="CB" and a$="OUI" then message "il ne peut pas y avoir une OAM pour une Carte Bancaire":return
if mrc$(nc)="ES" and a$="OUI" then message "il ne peut pas y avoir une OAM pour une opération en espèce":return
oac$(nc)=left$(a$,1)
inactive 15:inactive 14:active 16:active 17:set_focus 17
afi6:
gosub efen
print_locate 60,305:print "Sélectionnez le Compte adapté."
print_locate 60,325:print "Si vous souhaitez que ce Code fonctionne sur tout les Comptes, sélectionnez [9T].(il se trouve en fin de liste)"
return

op:
a$=text$(13)
if mrc$(nc)="CB" and a$="+" then message "L'opérateur pour une Carte Bancaire ne peut pas être +":return
if mrc$(nc)="CH" and a$="+" then message "Attention: il s'agit d'une remise de Chèque"
opc$(nc)=a$
inactive 13:active 15:set_focus 15
afi5:
gosub efen
print_locate 60,305:print "Indiquez par OUI ou NON si l'opération sera automatique tout les mois."
print_locate 60,325:print "Cet élément du Code s'appelle OAM (Opération Automatique Mensuelle)."
print_locate 60,345:print "Ex: vous payez votre loyer le 5 du mois par virement et son montant est fixe."
return

mr:
gosub afi3
a$=text$(11)
if a$="CB" then message "Mode de règlement incorect":text 11,"":return
mrc$(nc)=a$
inactive 10:inactive 11:active 15:set_focus 15
return

lib:
a$=text$(8)
return

veriflib:
if len(a$)<2 then message "2 caractères minimum":text 8,"":return
libc$(nc)=a$
inactive 8:hide 9
afi3:
gosub efen
print_locate 60,305:print "Choisissez le Mode de Règlement adapté."
print_locate 60,325:print "Il sera possible de le changer par la suite"
print_locate 60,365:print "CH => Chèque"
print_locate 60,385:print "VI => Virement"
print_locate 60,405:print "ES => Espèces"
print_locate 60,425:print "AU => Autre mode de règlement"
return

code:
a$=upper$(text$(5))
hide 2:active 6
if len(a$)>3 then message "3 caractères maximum":text 5,"":return
return

verifcode:
if a$="" then message "1 caractères minimum":text 5,"":return
b$=left$(a$,2)
if b$<>"VI" then message "Un code pour Virement compte à compte doit commencer par VI":text 5,"VI":return
if len(a$)<3 then message "Ajoutez un chiffre après VI":text 5,"VI":return
gosub doublon
if a$="" then text 5,"VI":return
cdc$(nc)=a$
a$=text$(8):libc$(nc)=a$
gosub afi3
inactive 4:inactive 5:hide 6:active 14:active 15:active 36:set_focus 15
return

doublon:
for n=1 to nc-1
if cdc$(n)=a$ then message "Ce Code existe déja":a$="":return
next n
return


efen:
2d_fill_color 240,235,235
2d_rectangle 50,300,900,440
return

aide:
print_target_is 2
print_locate 10,10:print "Quelques Conseils pour créer ce Code:"
print_locate 10,30:print "Certains des éléments de ce code sont déja crées, à vous de verifier et de complèter"
print_locate 10,50:print ""
print_locate 10,70:print "Pensez à vérifier (avant de créer votre Code) l'existence de la catégorie car vous ne pourrez pas la créer dans cette section du programme."
print_locate 10,90:print "Le destinataire sera le compte à créditer"
print_locate 10,110:print ""
print_locate 10,130:print ""
print_locate 10,160:print ""
print_locate 10,180:print ""
print_locate 10,220:print "Pour Démarrer, Cliquez dans le champ CODE et ajouter un chiffre de 0 à 9."
print_target_is 0
return

afireste:
gosub efen
n=item_index(3)
print_locate 60,310:print string$(100," ")
print_locate 60,330:print string$(100," ")
print_locate 60,310:print "Utilisateur du Code "+libc$(n)+": "+utilc$(n)
print_locate 60,330:print "Destinataire/Emetteur du Code "+libc$(n)+": "+desc$(n)
return

addlist:
print_locate 7,22:print "CODE"
print_locate 132,22:print "LIBELLE DU CODE"
print_locate 346,22:print "MR +/-"
print_locate 442,22:print "FAMILLE et CATEGORIE"
print_locate 657,22:print "OAM"
print_locate 690,22:print "BANQUE"
print_locate 744,22:print "J/VAL"
print_locate 790,22:print "MENSUALITE"
print_locate 900,22:print "MONTANT"
print_locate 980,22:print "N° Ligne"
font_name 3,"Fixedsys"
for n=1 to 99
c$="":a$="":b$="":d$="":lt=0:l=0:ls=0
a$=cdc$(n):ls=4:gosub strig
a$=libc$(n):if len(a$)>36 then a$=left$(a$,36)
ls=37:gosub strig
c$=c$+" "+mrc$(n)
if mrc$(n)="" then c$=c$+"  "
c$=c$+opc$(n)+" |"
a$=catc$(n):ls=32:gosub strig
if oac$(n)=""then oac$(n)=" "
c$=c$+" "+oac$(n)+" | "
cbkcmod$=left$(cbkc$(n),2)
if cbkc$(n)="" then c$=c$+"  "
c$=c$+""+cbkcmod$+" | "
a$=dvc$(n):ls=5:gosub strig
a$=mecc$(n):ls=4:gosub strig
a$=mefc$(n):ls=4:gosub strig
a$=mtc$(n):ls=9:gosub mt:c$=c$+b$
a$=str$(n)
if len(a$)=1 then b$="00"+a$
if len(a$)=2 then b$="0"+a$
if len(a$)=3 then b$=a$
c$=c$+b$
item_add 3,c$
next n
return

mt:
lt=0:l=0:p=0:d$="":b$=""
if a$="" then b$="        0.00 | ":return
if val(a$)=0 then b$="        0.00 | ":return
lt=len(a$):l=ls-lt
if lt=1 then b$=string$(l," ")+a$+".00 | ":return
gosub pas
return

pas:
p=0:d$="":b$="":e$=""

pa:
p=p+1
if p>lt then b$=string$(l," ")+a$+".00 | ":return
d$=mid$(a$,p,1)
if d$<>"." then goto pa
e$=mid$(a$,p+1,1):f$=mid$(a$,p+2,1)
if e$="" and f$="" then b$=string$(l+1," ")+a$+"00 | ":return
if e$<>"" and f$="" then b$=string$(l+2," ")+a$+"0 | ":return
if e$<>"" and f$<>"" then b$=string$(l+3," ")+a$+" | ":return
message "Cas non prévu à l'etiquette pa":terminate

strig:
if a$="" then d$=string$(ls," ")+"|":c$=c$+d$:a$="":b$="":d$="":lt=0:l=0:ls=0:return
lt=len(a$):l=ls-lt:b$=left$(a$,lt)+string$(l," ")+"|"
c$=c$+b$:a$="":b$="":lt=0:l=0:ls=0
return

chcptutil:
nu$=str$(nu)
fi$="cfplc" + nu$ + ".cfp"
fe=file_exists (fi$)
if fe=0 then message nomutil$+" Vous n'avez pas de compte ouvert":goto fin
if fe=1 then gosub chargeliste:return
return

rem --------------------------------------------------------------------------
chargeutil:
file_open_read 1,"utilisateur.cfp"
for n=1 to 10
file_readln 1,util$(n)
file_readln 1,mdp$(n)
file_readln 1,grad$(n)
next n
file_close 1
return

chargedest:
fi$= "cfpdest.cfp"
file_open_read 1,fi$
for n=1 to 99
file_readln 1,dest$(n)
next n
file_close 1
return

chargecat:
file_open_read 1,fi$
for n=1 to 15
file_readln 1,cat$(n)
next n
file_close 1
return

chargeliste:
file_open_read 1,fi$
for n=1 to 9
file_readln 1,cpt$(n)
file_readln 1,lcpt$(n)
file_readln 1,fec$(n)
file_readln 1,rec$(n)
file_readln 1,sldcpt$(n)
next n
file_close 1
return

chargefam:
file_open_read 1,"cfplisfa.cfp"
for n=1 to 20
file_readln 1,fifam$(n)
file_readln 1,fam$(n)
next n
file_close 1
return

chargecode:
file_open_read 1,"cfpcodes.cfp"
for n=1 to 99
file_readln 1,cdc$(n)
file_readln 1,libc$(n)
file_readln 1,mrc$(n)
file_readln 1,opc$(n)
file_readln 1,famc$(n)
file_readln 1,catc$(n)
file_readln 1,desc$(n)
file_readln 1,utilc$(n)
file_readln 1,oac$(n)
file_readln 1,cbkc$(n)
file_readln 1,dvc$(n)
file_readln 1,mecc$(n)
file_readln 1,mefc$(n)
file_readln 1,mtc$(n)
next n
file_close 1
return

sauvecode:
file_open_write 1,"cfpcodes.cfp"
for n=1 to 99
file_writeln 1,cdc$(n)
file_writeln 1,libc$(n)
file_writeln 1,mrc$(n)
file_writeln 1,opc$(n)
file_writeln 1,famc$(n)
file_writeln 1,catc$(n)
file_writeln 1,desc$(n)
file_writeln 1,utilc$(n)
file_writeln 1,oac$(n)
file_writeln 1,cbkc$(n)
file_writeln 1,dvc$(n)
file_writeln 1,mecc$(n)
file_writeln 1,mefc$(n)
file_writeln 1,mtc$(n)
next n
file_close 1
return

tf:
file_open_read 1,"cfptf01.cfp"
file_readln 1,proga$
file_readln 1,nu
file_readln 1,nomutil$
file_readln 1,motutil$
file_readln 1,gradutil$
file_close 1
print_locate 9,448:print "UTILISATEUR: "+nomutil$
print_locate 830,448:print date$
return

rem ---------------------------------------------------------------------------
quit:
execute cfptrcod.exe
fin:
terminate

rem cfpcodms

label quit,tf,fin,addlist,strig,mt,pas,afireste,aide,code,efen,verifcode
label doublon,lib,veriflib,afi3,mr,op,afi5,oam,afi6,bk,chcptutil,spec
label fam,cat,afi9,dest,afi10,util,afi11,jv,afi12,montant,verifmontant
label mec,mef,afi15,re,enreg,rpnv,pa,adollar,verifspec
label sauvecode,chargecode,chargeliste,chargefam,chargecat,chargedest,chargeutil


dim a,n,nc,nu,l,lt,ls,p,fe
dim a$,b$,c$,d$,e$,f$,nu$,fi$,cbkcmod$
dim proga$,nomutil$,motutil$,gradutil$
dim cdc$(99),libc$(99),mrc$(99),opc$(99),famc$(99),catc$(99),desc$(99),utilc$(99),oac$(99),cbkc$(99),dvc$(99),mecc$(99),mefc$(99),mtc$(99)
dim cpt$(9),lcpt$(9),fec$(9),rec$(9),sldcpt$(9)
dim fam$(20),fifam$(20)
dim cat$(15)
dim dest$(99)
dim util$(10),mdp$(10),grad$(10)

left 0,100:top 0,100:width 0,1071:height 0,500
caption 0,"COMPTE FAMILIALE  *  Création d'un Code Médecin Spécialiste *"
 
button 1:left 1,940:top 1,380:width 1,90:height 1,20
caption 1,"Retour au MENU"
on_click 1,quit

form 2:left 2,98:top 2,615:width 2,1071:height 2,290
caption 2,"COMPTE FAMILIALE *  Aide *"
color 2,255,255,255
font_size 2,10:font_color 2,0,0,255

list 3:left 3,2:top 3,40:width 3,1058:height 3,123
on_click 3,afireste

alpha 4:left 4,9:top 4,178:width 4,33
caption 4,"CODE:"

edit 5:left 5,46:top 5,175:width 5,48
text 5,"MS"
on_change 5,code

button 6:left 6,99:top 6,176:width 6,20:height 6,20
caption 6,"OK"
inactive 6
on_click 6,verifcode

alpha 7:left 7,134:top 7,178:width 7,49
caption 7,"LIBELLE:"
inactive 7

edit 8:left 8,182:top 8,175:width 8,248
text 8,"Médecin Spécialiste: "
inactive 8
on_change 8,lib

button 9:left 9,436:top 9,176:width 9,20:height 9,20
caption 9,"OK"
inactive 9
on_click 9,veriflib

alpha 10:left 10,469:top 10,178
caption 10,"MODE DE REGLEMENT:"
inactive 10

combo 11:left 11,595:top 11,175:width 11,40
item_add 11,"CB"
item_add 11,"CH"
item_add 11,"VI"
item_add 11,"ES"
item_add 11,"AU"
inactive 11
on_click 11,mr

alpha 12:left 12,657:top 12,178
caption 12,"OPERATEUR:"
inactive 12

combo 13:left 13,730:top 13,175:width 13,40
font_bold 13
item_add 13,"+"
item_add 13,"-"
text 13,"-"
inactive 13
on_click 13,op

alpha 14:left 14,780:top 14,178:width 14,56
caption 14,"OP AUTOMATIQUE:"
inactive 14

combo 15:left 15,885:top 15,175:width 15,53
item_add 15,"OUI"
item_add 15,"NON"
inactive 15
text 15,"NON"
on_click 15,oam

alpha 16:left 16,9:top 16,219:width 16,50
caption 16,"BANQUE:"
inactive 16

combo 17:left 17,60:top 17,215
gosub tf:gosub chcptutil: rem chargement utilisateur et comptes <<<<<<
for n=1 to 9
item_add 17,lcpt$(n)
next n
inactive 17
on_click 17,bk
if gradutil$="INACTIF" then message " "+nomutil$+" Vous ne pouvez pas créer de code vu votre statut":terminate

alpha 18:left 18,216:top 18,219:width 18,52
caption 18,"FAMILLE:"
inactive 18

combo 19:left 19,268:top 19,215
gosub chargefam
for n=1 to 20
item_add 19,fam$(n)
next n
text 19,"SANTE:"
inactive 19
on_click 19,fam

alpha 20:left 20,421:top 20,215:width 20,52
caption 20,"CATEGORIE:"
inactive 20

combo 21:left 21,490:top 21,210
text 21,"SANTE: Médecin"
inactive 21
on_click 21,cat

alpha 22:left 22,644:top 22,219:width 22,52
caption 22,"DESTINATAIRE/EMETTEUR:"
inactive 22

combo 23:left 23,794:top 23,215
gosub chargedest:rem chargement et remplissage des destinataires <<<<<<<<<
for n=1 to 99
item_add 23,dest$(n)
next n
inactive 23
on_click 23,dest

alpha 24:left 24,9:top 24,259:width 24,52
caption 24,"UTILISATEUR:"
inactive 24

combo 25:left 25,88:top 25,255
gosub chargeutil:rem chargement et remplissage des Utlisateurs <<<<<<<<<
for n=1 to 10
item_add 25,util$(n)
next n
inactive 25
on_click 25,util

alpha 26:left 26,244:top 26,259:width 26,52
caption 26,"JOUR DE VALEUR:"
inactive 26

combo 27:left 27,344:top 27,255:width 27,40
for n=0 to 31
item_add 27,n
next n
inactive 27
text 27,"0"
on_click 27,jv

alpha 28:left 28,394:top 28,259:width 28,52
caption 28,"MONTANT:"
inactive 28

edit 29:left 29,455:top 29,255:width 29,110
inactive 29
on_change 29,montant

button 30:left 30,570:top 30,256:width 30,20:height 30,20
caption 30,"OK"
inactive 30
on_click 30,verifmontant

alpha 31:left 31,599:top 31,259:width 31,52
caption 31,"MENSUALITE ACTUELLE:"
inactive 31

combo 32:left 32,731:top 32,250:width 32,45
for n=0 to 999
item_add 32,n
next n
text 32,"0"
inactive 32
on_click 32,mec

alpha 33:left 33,780:top 33,259:width 33,52
caption 33,"MENSUALITE FINALE:"
inactive 33

combo 34:left 34,894:top 34,255:width 34,45
for n=0 to 999
item_add 34,n
next n
text 34,"0"
inactive 34
on_click 34,mef

button 35:left 35,940:top 35,414:width 35,90:height 35,25
caption 35,"ENREGISTRER"
inactive 35
on_click 35,enreg

button 36:left 36,940:top 36,345:width 36,90:height 36,20
caption 36,"Recommencer"
inactive 36
on_click 36,re

edit 37:left 37,520:top 37,345:width 37,110
hide 37
on_change 37,spec

alpha 38:left 38,394:top 38,348:width 38,52
caption 38,"Spécialité du Médecin:"
hide 38

button 39:left 39,635:top 39,347:width 39,20:height 39,20
caption 39,"OK"
hide 39
on_click 39,verifspec

gosub efen
gosub chargecode:gosub addlist:gosub rpnv
gosub aide
print_locate 40,10:print "  ":print_locate 40,22:print nc



end
rem ----------------------------------------------------------------------------
spec:
a$=upper$(text$(37))
show 39
return

verifspec:
if len(a$)>10 then message "10 Caractères Maximum":return
libc$(nc)=libc$(nc)+a$+" "+desc$(nc)
hide 37:hide 38:hide 39
active 28:active 29:set_focus 29
text 8,libc$(nc)
return

rpnv:
for n=1 to 99
if cdc$(n)="" then nc=n:return
next n
message "Plus de place pour un nouveau Code"
return

enreg:
opc$(nc)="+":famc$(nc)="SANTE:":catc$(nc)="SANTE: Médecin":mecc$(nc)="0":mefc$(nc)="0"
dvc$(nc)="0":opC$(nc)="-":oac$(nc)="N"
gosub sauvecode
execute cfpcrcod.exe
goto fin
return

re:
execute cfpcrcod.exe
goto fin
return

mef:
a$=text$(34)
gosub adollar
mefc$(nc)=a$
inactive 34:active 35
return

adollar:
a=val(a$)
if a<10 then a$="00"+a$:return
if a>9 and a<100 then a$="0"+a$:return
return

afi15:
gosub efen
print_locate 60,305:print "Votre code est prêt à être enregistré"
print_locate 60,325:print "Il sera possible de le Modifier par la suite"
active 35
return

mec:
a$=text$(32)
gosub adollar
mecc$(nc)=a$
inactive 32:active 33:active 34:set_focus 34
return

montant:
a$=text$(29)
mtc$(nc)=a$
active 30
return

verifmontant:
n=numeric(a$)
if n=0 then message "Vous devez saisir un valeur numérique":return
if right$(a$,1)="." then message "Saisie Incorect":a$="":text 29,"":return
if len(a$)>13 then message "Maxi: 13 caractères)::text 29,"":return
gosub afi15
inactive 28:hide 30:inactive 29
return

jv:
a$=text$(27):a=val(a$)
if a<10 then a$="0"+a$
if a>9  then a$=""+a$
dvc$(nc)=a$
gosub afi12
return

afi12:
gosub efen
print_locate 60,305:print "Saisissez un Montant."
print_locate 60,325:print "Il sera possible de le changer par la suite"
print_locate 60,345:print "Vous pouvez saisir zéro"
return

util:
n=item_index(25)
utilc$(nc)=util$(n)
gosub afi11
inactive 24:inactive 25:show 38:show 37:set_focus 37
text 8,libc$(nc)
return

afi11:
gosub efen
print_locate 60,305:print "Sélectionnez un Jour de Valeur."
print_locate 60,325:print "Il sera possible de le changer par la suite"
print_locate 60,345:print "Vous pouvez saisir zéro"
return

dest:
n=item_index(23)
if dest$(n)="" then message "Sélection vide":return
desc$(nc)=dest$(n)
gosub afi10
inactive 22:inactive 23:active 24:active 25:set_focus 25
return

afi10:
gosub efen
print_locate 60,305:print "Sélectionnez l'Utilisateur adaptée."
print_locate 60,325:print "Il sera possible de le changer par la suite"
print_locate 60,345:print "Si vous souhaitez que ce Code fonctionne pour tout les Utilisateurs, sélectionnez un blanc."
return

cat:
n=item_index(21)
if cat$(n)="" then message "Sélection vide":return
catc$(nc)=cat$(n)
inactive 21:active 22:active 23:set_focus 23
return

afi9:
gosub efen
print_locate 60,305:print "Sélectionnez le Destinataire ou Emetteur adaptée."
print_locate 60,325:print "Il sera possible de le changer par la suite"
return

fam:
n=item_index(19)
if fam$(n)="" then message "Sélection vide":return
famc$(nc)=fam$(n)
inactive 19:active 20:active 21
fi$=fifam$(n):gosub chargecat
for n=1 to 15
item_add 21,cat$(n)
next n
return

bk:
n=item_index(17)
if cpt$(n)="" then message "Sélection vide":return
cbkc$(nc)=cpt$(n)
gosub afi9
inactive 16:inactive 17:active 22:active 23:set_focus 23
return

oam:
gosub afi5
a$=text$(15)
if mrc$(nc)="CB" and a$="OUI" then message "il ne peut pas y avoir une OAM pour une Carte Bancaire":return
if mrc$(nc)="ES" and a$="OUI" then message "il ne peut pas y avoir une OAM pour une opération en espèce":return
oac$(nc)=left$(a$,1)
afi6:
gosub efen
print_locate 60,305:print "Sélectionnez le Compte adapté."
print_locate 60,325:print "Si vous souhaitez que ce Code fonctionne sur tout les Comptes, sélectionnez [9T].(il se trouve en fin de liste)"
return

op:
a$=text$(13)
if mrc$(nc)="CB" and a$="+" then message "L'opérateur pour une Carte Bancaire ne peut pas être +":return
if mrc$(nc)="CH" and a$="+" then message "Attention: il s'agit d'une remise de Chèque"
opc$(nc)=a$
afi5:
gosub efen
print_locate 60,305:print "Indiquez par OUI ou NON si l'opération sera automatique tout les mois."
print_locate 60,325:print "Cet élément du Code s'appelle OAM (Opération Automatique Mensuelle)."
print_locate 60,345:print "Ex: vous payez votre loyer le 5 du mois par virement et son montant est fixe."
return

mr:
gosub afi3
a$=text$(11)
if a$="CB" then message "Mode de règlement incorect":text 11,"":return
mrc$(nc)=a$
inactive 10:inactive 11:active 16:active 17:set_focus 17
return

lib:
a$=text$(8)
return

veriflib:
if len(a$)<2 then message "2 caractères minimum":text 8,"":return
libc$(nc)=a$
active 10:inactive 8:hide 9
afi3:
gosub efen
print_locate 60,305:print "Choisissez le Mode de Règlement adapté."
print_locate 60,325:print "Il sera possible de le changer par la suite"
print_locate 60,365:print "CH => Chèque"
print_locate 60,385:print "VI => Virement"
print_locate 60,405:print "ES => Espèces"
print_locate 60,425:print "AU => Autre mode de règlement"
return

code:
a$=upper$(text$(5))
hide 2:active 6
if len(a$)>3 then message "3 caractères maximum":text 5,"":return
return

verifcode:
if a$="" then message "1 caractères minimum":text 5,"":return
b$=left$(a$,2)
if b$<>"MS" then message "Un code pour Médecin doit commencer par MS":text 5,"MS":return
if len(a$)<3 then message "Ajoutez un chiffre après SA":text 5,"MS":return
gosub doublon
if a$="" then text 5,"MS":return
cdc$(nc)=a$
a$=text$(8):libc$(nc)=a$
gosub afi3
inactive 4:inactive 5:hide 6:active 10:active 11:set_focus 11
return

doublon:
for n=1 to nc-1
if cdc$(n)=a$ then message "Ce Code existe déja":a$="":return
next n
return


efen:
2d_fill_color 240,235,235
2d_rectangle 50,300,900,440
return

aide:
print_target_is 2
print_locate 10,10:print "Quelques Conseils pour créer ce Code:"
print_locate 10,30:print "La pluparts des éléments de ce code sont déja crées, à vous de verifier et de complèter"
print_locate 10,50:print ""
print_locate 10,70:print "Pensez à vérifier (avant de créer votre Code) l'existence du nom du médecin car vous ne pourrez pas les créer dans cette section du programme."
print_locate 10,90:print ""
print_locate 10,110:print ""
print_locate 10,130:print ""
print_locate 10,160:print ""
print_locate 10,180:print ""
print_locate 10,220:print "Pour Démarrer, Cliquez dans le champ CODE et ajouter un chiffre de 0 à 9."
print_target_is 0
return

afireste:
gosub efen
n=item_index(3)
print_locate 60,310:print string$(100," ")
print_locate 60,330:print string$(100," ")
print_locate 60,310:print "Utilisateur du Code "+libc$(n)+": "+utilc$(n)
print_locate 60,330:print "Destinataire/Emetteur du Code "+libc$(n)+": "+desc$(n)
return

addlist:
print_locate 7,22:print "CODE"
print_locate 132,22:print "LIBELLE DU CODE"
print_locate 346,22:print "MR +/-"
print_locate 442,22:print "FAMILLE et CATEGORIE"
print_locate 657,22:print "OAM"
print_locate 690,22:print "BANQUE"
print_locate 744,22:print "J/VAL"
print_locate 790,22:print "MENSUALITE"
print_locate 900,22:print "MONTANT"
print_locate 980,22:print "N° Ligne"
font_name 3,"Fixedsys"
for n=1 to 99
c$="":a$="":b$="":d$="":lt=0:l=0:ls=0
a$=cdc$(n):ls=4:gosub strig
a$=libc$(n):if len(a$)>36 then a$=left$(a$,36)
ls=37:gosub strig
c$=c$+" "+mrc$(n)
if mrc$(n)="" then c$=c$+"  "
c$=c$+opc$(n)+" |"
a$=catc$(n):ls=32:gosub strig
if oac$(n)=""then oac$(n)=" "
c$=c$+" "+oac$(n)+" | "
cbkcmod$=left$(cbkc$(n),2)
if cbkc$(n)="" then c$=c$+"  "
c$=c$+""+cbkcmod$+" | "
a$=dvc$(n):ls=5:gosub strig
a$=mecc$(n):ls=4:gosub strig
a$=mefc$(n):ls=4:gosub strig
a$=mtc$(n):ls=9:gosub mt:c$=c$+b$
a$=str$(n)
if len(a$)=1 then b$="00"+a$
if len(a$)=2 then b$="0"+a$
if len(a$)=3 then b$=a$
c$=c$+b$
item_add 3,c$
next n
return

mt:
lt=0:l=0:p=0:d$="":b$=""
if a$="" then b$="        0.00 | ":return
if val(a$)=0 then b$="        0.00 | ":return
lt=len(a$):l=ls-lt
if lt=1 then b$=string$(l," ")+a$+".00 | ":return
gosub pas
return

pas:
p=0:d$="":b$="":e$=""

pa:
p=p+1
if p>lt then b$=string$(l," ")+a$+".00 | ":return
d$=mid$(a$,p,1)
if d$<>"." then goto pa
e$=mid$(a$,p+1,1):f$=mid$(a$,p+2,1)
if e$="" and f$="" then b$=string$(l+1," ")+a$+"00 | ":return
if e$<>"" and f$="" then b$=string$(l+2," ")+a$+"0 | ":return
if e$<>"" and f$<>"" then b$=string$(l+3," ")+a$+" | ":return
message "Cas non prévu à l'etiquette pa":terminate

strig:
if a$="" then d$=string$(ls," ")+"|":c$=c$+d$:a$="":b$="":d$="":lt=0:l=0:ls=0:return
lt=len(a$):l=ls-lt:b$=left$(a$,lt)+string$(l," ")+"|"
c$=c$+b$:a$="":b$="":lt=0:l=0:ls=0
return

chcptutil:
nu$=str$(nu)
fi$="cfplc" + nu$ + ".cfp"
fe=file_exists (fi$)
if fe=0 then message nomutil$+" Vous n'avez pas de compte ouvert":goto fin
if fe=1 then gosub chargeliste:return
return

rem --------------------------------------------------------------------------
chargeutil:
file_open_read 1,"utilisateur.cfp"
for n=1 to 10
file_readln 1,util$(n)
file_readln 1,mdp$(n)
file_readln 1,grad$(n)
next n
file_close 1
return

chargedest:
fi$= "cfpdest.cfp"
file_open_read 1,fi$
for n=1 to 99
file_readln 1,dest$(n)
next n
file_close 1
return

chargecat:
file_open_read 1,fi$
for n=1 to 15
file_readln 1,cat$(n)
next n
file_close 1
return

chargeliste:
file_open_read 1,fi$
for n=1 to 9
file_readln 1,cpt$(n)
file_readln 1,lcpt$(n)
file_readln 1,fec$(n)
file_readln 1,rec$(n)
file_readln 1,sldcpt$(n)
next n
file_close 1
return

chargefam:
file_open_read 1,"cfplisfa.cfp"
for n=1 to 20
file_readln 1,fifam$(n)
file_readln 1,fam$(n)
next n
file_close 1
return

chargecode:
file_open_read 1,"cfpcodes.cfp"
for n=1 to 99
file_readln 1,cdc$(n)
file_readln 1,libc$(n)
file_readln 1,mrc$(n)
file_readln 1,opc$(n)
file_readln 1,famc$(n)
file_readln 1,catc$(n)
file_readln 1,desc$(n)
file_readln 1,utilc$(n)
file_readln 1,oac$(n)
file_readln 1,cbkc$(n)
file_readln 1,dvc$(n)
file_readln 1,mecc$(n)
file_readln 1,mefc$(n)
file_readln 1,mtc$(n)
next n
file_close 1
return

sauvecode:
file_open_write 1,"cfpcodes.cfp"
for n=1 to 99
file_writeln 1,cdc$(n)
file_writeln 1,libc$(n)
file_writeln 1,mrc$(n)
file_writeln 1,opc$(n)
file_writeln 1,famc$(n)
file_writeln 1,catc$(n)
file_writeln 1,desc$(n)
file_writeln 1,utilc$(n)
file_writeln 1,oac$(n)
file_writeln 1,cbkc$(n)
file_writeln 1,dvc$(n)
file_writeln 1,mecc$(n)
file_writeln 1,mefc$(n)
file_writeln 1,mtc$(n)
next n
file_close 1
return

tf:
file_open_read 1,"cfptf01.cfp"
file_readln 1,proga$
file_readln 1,nu
file_readln 1,nomutil$
file_readln 1,motutil$
file_readln 1,gradutil$
file_close 1
print_locate 9,448:print "UTILISATEUR: "+nomutil$
print_locate 830,448:print date$
return

rem ---------------------------------------------------------------------------
quit:
execute cfptrcod.exe
fin:
terminate

rem cfpcodmg

label quit,tf,fin,addlist,strig,mt,pas,afireste,aide,code,efen,verifcode
label doublon,lib,veriflib,afi3,mr,op,afi5,oam,afi6,bk,chcptutil
label fam,cat,afi9,dest,afi10,util,afi11,jv,afi12,montant,verifmontant
label mec,mef,afi15,re,enreg,rpnv,pa,adollar
label sauvecode,chargecode,chargeliste,chargefam,chargecat,chargedest,chargeutil


dim a,n,nc,nu,l,lt,ls,p,fe
dim a$,b$,c$,d$,e$,f$,nu$,fi$,cbkcmod$
dim proga$,nomutil$,motutil$,gradutil$
dim cdc$(99),libc$(99),mrc$(99),opc$(99),famc$(99),catc$(99),desc$(99),utilc$(99),oac$(99),cbkc$(99),dvc$(99),mecc$(99),mefc$(99),mtc$(99)
dim cpt$(9),lcpt$(9),fec$(9),rec$(9),sldcpt$(9)
dim fam$(20),fifam$(20)
dim cat$(15)
dim dest$(99)
dim util$(10),mdp$(10),grad$(10)

left 0,100:top 0,100:width 0,1071:height 0,500
caption 0,"COMPTE FAMILIALE  *  Création d'un Code Médecin Généraliste *"
 
button 1:left 1,940:top 1,380:width 1,90:height 1,20
caption 1,"Retour au MENU"
on_click 1,quit

form 2:left 2,98:top 2,615:width 2,1071:height 2,290
caption 2,"COMPTE FAMILIALE *  Aide *"
color 2,255,255,255
font_size 2,10:font_color 2,0,0,255

list 3:left 3,2:top 3,40:width 3,1058:height 3,123
on_click 3,afireste

alpha 4:left 4,9:top 4,178:width 4,33
caption 4,"CODE:"

edit 5:left 5,46:top 5,175:width 5,48
text 5,"MG"
on_change 5,code

button 6:left 6,99:top 6,176:width 6,20:height 6,20
caption 6,"OK"
inactive 6
on_click 6,verifcode

alpha 7:left 7,134:top 7,178:width 7,49
caption 7,"LIBELLE:"
inactive 7

edit 8:left 8,182:top 8,175:width 8,248
text 8,"Médecin Généraliste: "
inactive 8
on_change 8,lib

button 9:left 9,436:top 9,176:width 9,20:height 9,20
caption 9,"OK"
inactive 9
on_click 9,veriflib

alpha 10:left 10,469:top 10,178
caption 10,"MODE DE REGLEMENT:"
inactive 10

combo 11:left 11,595:top 11,175:width 11,40
item_add 11,"CB"
item_add 11,"CH"
item_add 11,"VI"
item_add 11,"ES"
item_add 11,"AU"
inactive 11
on_click 11,mr

alpha 12:left 12,657:top 12,178
caption 12,"OPERATEUR:"
inactive 12

combo 13:left 13,730:top 13,175:width 13,40
font_bold 13
item_add 13,"+"
item_add 13,"-"
text 13,"-"
inactive 13
on_click 13,op

alpha 14:left 14,780:top 14,178:width 14,56
caption 14,"OP AUTOMATIQUE:"
inactive 14

combo 15:left 15,885:top 15,175:width 15,53
item_add 15,"OUI"
item_add 15,"NON"
inactive 15
text 15,"NON"
on_click 15,oam

alpha 16:left 16,9:top 16,219:width 16,50
caption 16,"BANQUE:"
inactive 16

combo 17:left 17,60:top 17,215
gosub tf:gosub chcptutil: rem chargement utilisateur et comptes <<<<<<
for n=1 to 9
item_add 17,lcpt$(n)
next n
inactive 17
on_click 17,bk
if gradutil$="INACTIF" then message " "+nomutil$+" Vous ne pouvez pas créer de code vu votre statut":terminate

alpha 18:left 18,216:top 18,219:width 18,52
caption 18,"FAMILLE:"
inactive 18

combo 19:left 19,268:top 19,215
gosub chargefam
for n=1 to 20
item_add 19,fam$(n)
next n
text 19,"SANTE:"
inactive 19
on_click 19,fam

alpha 20:left 20,421:top 20,215:width 20,52
caption 20,"CATEGORIE:"
inactive 20

combo 21:left 21,490:top 21,210
text 21,"SANTE: Médecin"
inactive 21
on_click 21,cat

alpha 22:left 22,644:top 22,219:width 22,52
caption 22,"DESTINATAIRE/EMETTEUR:"
inactive 22

combo 23:left 23,794:top 23,215
gosub chargedest:rem chargement et remplissage des destinataires <<<<<<<<<
for n=1 to 99
item_add 23,dest$(n)
next n
inactive 23
on_click 23,dest

alpha 24:left 24,9:top 24,259:width 24,52
caption 24,"UTILISATEUR:"
inactive 24

combo 25:left 25,88:top 25,255
gosub chargeutil:rem chargement et remplissage des Utlisateurs <<<<<<<<<
for n=1 to 10
item_add 25,util$(n)
next n
inactive 25
on_click 25,util

alpha 26:left 26,244:top 26,259:width 26,52
caption 26,"JOUR DE VALEUR:"
inactive 26

combo 27:left 27,344:top 27,255:width 27,40
for n=0 to 31
item_add 27,n
next n
inactive 27
text 27,"0"
on_click 27,jv

alpha 28:left 28,394:top 28,259:width 28,52
caption 28,"MONTANT:"
inactive 28

edit 29:left 29,455:top 29,255:width 29,110
inactive 29
on_change 29,montant

button 30:left 30,570:top 30,256:width 30,20:height 30,20
caption 30,"OK"
inactive 30
on_click 30,verifmontant

alpha 31:left 31,599:top 31,259:width 31,52
caption 31,"MENSUALITE ACTUELLE:"
inactive 31

combo 32:left 32,731:top 32,250:width 32,45
for n=0 to 999
item_add 32,n
next n
text 32,"0"
inactive 32
on_click 32,mec

alpha 33:left 33,780:top 33,259:width 33,52
caption 33,"MENSUALITE FINALE:"
inactive 33

combo 34:left 34,894:top 34,255:width 34,45
for n=0 to 999
item_add 34,n
next n
text 34,"0"
inactive 34
on_click 34,mef

button 35:left 35,940:top 35,414:width 35,90:height 35,25
caption 35,"ENREGISTRER"
inactive 35
on_click 35,enreg

button 36:left 36,940:top 36,345:width 36,90:height 36,20
caption 36,"Recommencer"
inactive 36
on_click 36,re

gosub efen
gosub chargecode:gosub addlist:gosub rpnv
gosub aide
print_locate 40,10:print "  ":print_locate 40,22:print nc



end
rem ----------------------------------------------------------------------------

rpnv:
for n=1 to 99
if cdc$(n)="" then nc=n:return
next n
message "Plus de place pour un nouveau Code"
return

enreg:
opc$(nc)="+":famc$(nc)="SANTE:":catc$(nc)="SANTE: Médecin":mecc$(nc)="0":mefc$(nc)="0"
dvc$(nc)="0":opc$(nc)="-":oac$(nc)="N"
gosub sauvecode
execute cfpcrcod.exe
goto fin
return

re:
execute cfpcrcod.exe
goto fin
return

mef:
a$=text$(34)
gosub adollar
mefc$(nc)=a$
inactive 34:active 35
return

adollar:
a=val(a$)
if a<10 then a$="00"+a$:return
if a>9 and a<100 then a$="0"+a$:return
return

afi15:
gosub efen
print_locate 60,305:print "Votre code est prêt à être enregistré"
print_locate 60,325:print "Il sera possible de le Modifier par la suite"
active 35
return

mec:
a$=text$(32)
gosub adollar
mecc$(nc)=a$
inactive 32:active 33:active 34:set_focus 34
return

montant:
a$=text$(29)
mtc$(nc)=a$
active 30
return

verifmontant:
n=numeric(a$)
if n=0 then message "Vous devez saisir un valeur numérique":return
if right$(a$,1)="." then message "Saisie Incorect":a$="":text 29,"":return
if len(a$)>13 then message "Maxi: 13 caractères)::text 29,"":return
gosub afi15
inactive 28:hide 30:inactive 29
return

jv:
a$=text$(27):a=val(a$)
if a<10 then a$="0"+a$
if a>9  then a$=""+a$
dvc$(nc)=a$
gosub afi12
return

afi12:
gosub efen
print_locate 60,305:print "Saisissez un Montant."
print_locate 60,325:print "Il sera possible de le changer par la suite"
print_locate 60,345:print "Vous pouvez saisir zéro"
return

util:
n=item_index(25)
utilc$(nc)=util$(n)
gosub afi11
inactive 24:inactive 25:active 28:active 29:set_focus 29
text 8,libc$(nc)
return

afi11:
gosub efen
print_locate 60,305:print "Sélectionnez un Jour de Valeur."
print_locate 60,325:print "Il sera possible de le changer par la suite"
print_locate 60,345:print "Vous pouvez saisir zéro"
return

dest:
n=item_index(23)
if dest$(n)="" then message "Sélection vide":return
desc$(nc)=dest$(n)
gosub afi10
inactive 22:inactive 23:active 24:active 25:set_focus 25
libc$(nc)=libc$(nc)+" "+desc$(nc)
text 8,libc$(nc)
return

afi10:
gosub efen
print_locate 60,305:print "Sélectionnez l'Utilisateur adaptée."
print_locate 60,325:print "Il sera possible de le changer par la suite"
print_locate 60,345:print "Si vous souhaitez que ce Code fonctionne pour tout les Utilisateurs, sélectionnez un blanc."
return

cat:
n=item_index(21)
if cat$(n)="" then message "Sélection vide":return
catc$(nc)=cat$(n)
inactive 21:active 22:active 23:set_focus 23
return

afi9:
gosub efen
print_locate 60,305:print "Sélectionnez le Destinataire ou Emetteur adaptée."
print_locate 60,325:print "Il sera possible de le changer par la suite"
return

fam:
n=item_index(19)
if fam$(n)="" then message "Sélection vide":return
famc$(nc)=fam$(n)
inactive 19:active 20:active 21
fi$=fifam$(n):gosub chargecat
for n=1 to 15
item_add 21,cat$(n)
next n
return

bk:
n=item_index(17)
if cpt$(n)="" then message "Sélection vide":return
cbkc$(nc)=cpt$(n)
gosub afi9
inactive 16:inactive 17:active 22:active 23:set_focus 23
return

oam:
gosub afi5
a$=text$(15)
if mrc$(nc)="CB" and a$="OUI" then message "il ne peut pas y avoir une OAM pour une Carte Bancaire":return
if mrc$(nc)="ES" and a$="OUI" then message "il ne peut pas y avoir une OAM pour une opération en espèce":return
oac$(nc)=left$(a$,1)
afi6:
gosub efen
print_locate 60,305:print "Sélectionnez le Compte adapté."
print_locate 60,325:print "Si vous souhaitez que ce Code fonctionne sur tout les Comptes, sélectionnez [9T].(il se trouve en fin de liste)"
return

op:
a$=text$(13)
if mrc$(nc)="CB" and a$="+" then message "L'opérateur pour une Carte Bancaire ne peut pas être +":return
if mrc$(nc)="CH" and a$="+" then message "Attention: il s'agit d'une remise de Chèque"
opc$(nc)=a$
afi5:
gosub efen
print_locate 60,305:print "Indiquez par OUI ou NON si l'opération sera automatique tout les mois."
print_locate 60,325:print "Cet élément du Code s'appelle OAM (Opération Automatique Mensuelle)."
print_locate 60,345:print "Ex: vous payez votre loyer le 5 du mois par virement et son montant est fixe."
return

mr:
gosub afi3
a$=text$(11)
if a$="CB" then message "Mode de règlement incorect":text 11,"":return
mrc$(nc)=a$
inactive 10:inactive 11:active 16:active 17:set_focus 17
return

lib:
a$=text$(8)
return

veriflib:
if len(a$)<2 then message "2 caractères minimum":text 8,"":return
libc$(nc)=a$
active 10:inactive 8:hide 9
afi3:
gosub efen
print_locate 60,305:print "Choisissez le Mode de Règlement adapté."
print_locate 60,325:print "Il sera possible de le changer par la suite"
print_locate 60,365:print "CH => Chèque"
print_locate 60,385:print "VI => Virement"
print_locate 60,405:print "ES => Espèces"
print_locate 60,425:print "AU => Autre mode de règlement"
return

code:
a$=upper$(text$(5))
hide 2:active 6
if len(a$)>3 then message "3 caractères maximum":text 5,"":return
return

verifcode:
if a$="" then message "1 caractères minimum":text 5,"":return
b$=left$(a$,2)
if b$<>"MG" then message "Un code pour Médecin doit commencer par MG":text 5,"MG":return
if len(a$)<3 then message "Ajoutez un chiffre après SA":text 5,"MG":return
gosub doublon
if a$="" then text 5,"MG":return
cdc$(nc)=a$
a$=text$(8):libc$(nc)=a$
gosub afi3
inactive 4:inactive 5:hide 6:active 10:active 11:set_focus 11
return

doublon:
for n=1 to nc-1
if cdc$(n)=a$ then message "Ce Code existe déja":a$="":return
next n
return


efen:
2d_fill_color 240,235,235
2d_rectangle 50,300,900,440
return

aide:
print_target_is 2
print_locate 10,10:print "Quelques Conseils pour créer ce Code:"
print_locate 10,30:print "La pluparts des éléments de ce code sont déja crées, à vous de verifier et de complèter"
print_locate 10,50:print ""
print_locate 10,70:print "Pensez à vérifier (avant de créer votre Code) l'existence du nom du médecin car vous ne pourrez pas les créer dans cette section du programme."
print_locate 10,90:print ""
print_locate 10,110:print ""
print_locate 10,130:print ""
print_locate 10,160:print ""
print_locate 10,180:print ""
print_locate 10,220:print "Pour Démarrer, Cliquez dans le champ CODE et ajouter un chiffre de 0 à 9."
print_target_is 0
return

afireste:
gosub efen
n=item_index(3)
print_locate 60,310:print string$(100," ")
print_locate 60,330:print string$(100," ")
print_locate 60,310:print "Utilisateur du Code "+libc$(n)+": "+utilc$(n)
print_locate 60,330:print "Destinataire/Emetteur du Code "+libc$(n)+": "+desc$(n)
return

addlist:
print_locate 7,22:print "CODE"
print_locate 132,22:print "LIBELLE DU CODE"
print_locate 346,22:print "MR +/-"
print_locate 442,22:print "FAMILLE et CATEGORIE"
print_locate 657,22:print "OAM"
print_locate 690,22:print "BANQUE"
print_locate 744,22:print "J/VAL"
print_locate 790,22:print "MENSUALITE"
print_locate 900,22:print "MONTANT"
print_locate 980,22:print "N° Ligne"
font_name 3,"Fixedsys"
for n=1 to 99
c$="":a$="":b$="":d$="":lt=0:l=0:ls=0
a$=cdc$(n):ls=4:gosub strig
a$=libc$(n):if len(a$)>36 then a$=left$(a$,36)
ls=37:gosub strig
c$=c$+" "+mrc$(n)
if mrc$(n)="" then c$=c$+"  "
c$=c$+opc$(n)+" |"
a$=catc$(n):ls=32:gosub strig
if oac$(n)=""then oac$(n)=" "
c$=c$+" "+oac$(n)+" | "
cbkcmod$=left$(cbkc$(n),2)
if cbkc$(n)="" then c$=c$+"  "
c$=c$+""+cbkcmod$+" | "
a$=dvc$(n):ls=5:gosub strig
a$=mecc$(n):ls=4:gosub strig
a$=mefc$(n):ls=4:gosub strig
a$=mtc$(n):ls=9:gosub mt:c$=c$+b$
a$=str$(n)
if len(a$)=1 then b$="00"+a$
if len(a$)=2 then b$="0"+a$
if len(a$)=3 then b$=a$
c$=c$+b$
item_add 3,c$
next n
return

mt:
lt=0:l=0:p=0:d$="":b$=""
if a$="" then b$="        0.00 | ":return
if val(a$)=0 then b$="        0.00 | ":return
lt=len(a$):l=ls-lt
if lt=1 then b$=string$(l," ")+a$+".00 | ":return
gosub pas
return

pas:
p=0:d$="":b$="":e$=""

pa:
p=p+1
if p>lt then b$=string$(l," ")+a$+".00 | ":return
d$=mid$(a$,p,1)
if d$<>"." then goto pa
e$=mid$(a$,p+1,1):f$=mid$(a$,p+2,1)
if e$="" and f$="" then b$=string$(l+1," ")+a$+"00 | ":return
if e$<>"" and f$="" then b$=string$(l+2," ")+a$+"0 | ":return
if e$<>"" and f$<>"" then b$=string$(l+3," ")+a$+" | ":return
message "Cas non prévu à l'etiquette pa":terminate

strig:
if a$="" then d$=string$(ls," ")+"|":c$=c$+d$:a$="":b$="":d$="":lt=0:l=0:ls=0:return
lt=len(a$):l=ls-lt:b$=left$(a$,lt)+string$(l," ")+"|"
c$=c$+b$:a$="":b$="":lt=0:l=0:ls=0
return

chcptutil:
nu$=str$(nu)
fi$="cfplc" + nu$ + ".cfp"
fe=file_exists (fi$)
if fe=0 then message nomutil$+" Vous n'avez pas de compte ouvert":goto fin
if fe=1 then gosub chargeliste:return
return

rem --------------------------------------------------------------------------
chargeutil:
file_open_read 1,"utilisateur.cfp"
for n=1 to 10
file_readln 1,util$(n)
file_readln 1,mdp$(n)
file_readln 1,grad$(n)
next n
file_close 1
return

chargedest:
fi$= "cfpdest.cfp"
file_open_read 1,fi$
for n=1 to 99
file_readln 1,dest$(n)
next n
file_close 1
return

chargecat:
file_open_read 1,fi$
for n=1 to 15
file_readln 1,cat$(n)
next n
file_close 1
return

chargeliste:
file_open_read 1,fi$
for n=1 to 9
file_readln 1,cpt$(n)
file_readln 1,lcpt$(n)
file_readln 1,fec$(n)
file_readln 1,rec$(n)
file_readln 1,sldcpt$(n)
next n
file_close 1
return

chargefam:
file_open_read 1,"cfplisfa.cfp"
for n=1 to 20
file_readln 1,fifam$(n)
file_readln 1,fam$(n)
next n
file_close 1
return

chargecode:
file_open_read 1,"cfpcodes.cfp"
for n=1 to 99
file_readln 1,cdc$(n)
file_readln 1,libc$(n)
file_readln 1,mrc$(n)
file_readln 1,opc$(n)
file_readln 1,famc$(n)
file_readln 1,catc$(n)
file_readln 1,desc$(n)
file_readln 1,utilc$(n)
file_readln 1,oac$(n)
file_readln 1,cbkc$(n)
file_readln 1,dvc$(n)
file_readln 1,mecc$(n)
file_readln 1,mefc$(n)
file_readln 1,mtc$(n)
next n
file_close 1
return

sauvecode:
file_open_write 1,"cfpcodes.cfp"
for n=1 to 99
file_writeln 1,cdc$(n)
file_writeln 1,libc$(n)
file_writeln 1,mrc$(n)
file_writeln 1,opc$(n)
file_writeln 1,famc$(n)
file_writeln 1,catc$(n)
file_writeln 1,desc$(n)
file_writeln 1,utilc$(n)
file_writeln 1,oac$(n)
file_writeln 1,cbkc$(n)
file_writeln 1,dvc$(n)
file_writeln 1,mecc$(n)
file_writeln 1,mefc$(n)
file_writeln 1,mtc$(n)
next n
file_close 1
return

tf:
file_open_read 1,"cfptf01.cfp"
file_readln 1,proga$
file_readln 1,nu
file_readln 1,nomutil$
file_readln 1,motutil$
file_readln 1,gradutil$
file_close 1
print_locate 9,448:print "UTILISATEUR: "+nomutil$
print_locate 830,448:print date$
return

rem ---------------------------------------------------------------------------
quit:
execute cfptrcod.exe
fin:
terminate

rem cfpviop2

label tf,chargetf03,chargeliste,datfich,chargeoper,addlist,sauveoper,mt,pas,pa
label quit,fin,verificour,rose,vert,afi1,recheche,selfich,datfic,moi

dim cpt$(9),lcpt$(9),fec$(9),rec$(9),sldcpt$(9)
dim cod$(111),nlig$(111),datoper$(111),lib$(111),mr$(111),op$(111),piece$(111),util$(111),dest$(111),fam$(111),cat$(111),dv$(111),mt$(111),sld$(111),ctr$(111)
dim proga$,nomutil$,motutil$,gradutil$
dim n,no,nu,ncpt,l,li,lt,lp,lc,lr,ls,p
dim a$,b$,c$,d$,e$,f$,an$,moi$,nu$,fi$,fil$,liba$,mec$,mef$,pcat$,pmt$,psld$
dim jou$

left 0,9:top 0,60:width 0,1270:height 0,850
gosub tf
font_name 0,"Impact"
font_size 0,9
gosub chargetf03:fil$=fi$:gosub chargeliste:gosub datfich
caption 0,"COMPTE FAMILIALE  *  Visualisation sur le Compte:  "+lcpt$(ncpt)+"  *  "+a$+"  *"

list 1
left 1,10:top 1,50:width 1,1190:height 1,550
color 1,190,255,255
on_click 1,afi1

button 2
left 2,10:top 2,630:width 2,100:height 2,25:caption 2,"RETOUR"
on_click 2,quit

button 3
left 3,130:top 3,630:width 3,100:height 3,25:caption 3,"RECHERCHER"
on_click 3,recheche

list 4
left 4,110:top 4,55:width 4,250:height 4,540
color 4,255,255,20
font_name 4,"Fixedsys"
hide 4

gosub rose
gosub verificour:gosub chargeoper:gosub addlist:no=n
gosub vert
end
rem -----------------------------------------------------------------------------
recheche:
clear 1:show 4
b$=cpt$(ncpt):c$=lcpt$(ncpt):caption 0," Recherche sur le compte:  "+c$
a$=file_find_first$
if left$(a$,4)="£"+b$ then gosub moi:item_add 4,a$
while a$<>"_"
a$=file_find_next$
if left$(a$,4)="£"+b$ then gosub moi:item_add 4,a$
end_while
file_find_close
on_click 4,selfich
hide 3
return

moi:
f$=mid$(a$,3,1)
if f$="A" then return
e$=a$:moi$=mid$(a$,7,2)
gosub datfic
d$=e$+ "  "+a$:a$=d$
return

selfich:
fi$=left$(item_index$(4),12)
moi$=mid$(fi$,7,2)
gosub datfic
caption 0,"COMPTE FAMILIALE  *  Visualisation sur le Compte:  "+lcpt$(ncpt)+"  *  "+a$+"  *"
gosub chargeoper
gosub addlist
clear 4:hide 4:show 3
return

afi1:
gosub vert
no=item_index(1):a$=item_index$(1)
print_locate 20,710:print "INFORMATIONS  COMPLEMENTAIRES  DE  LA  LIGNE :  "+nlig$(no)+"  "+cod$(no)+"  "+lib$(no)
print_locate 20,730:print "UTILISATEUR :  "+util$(no)+string$(16," ")+"DESTINATAIRE :  "+dest$(no)
print_locate 20,750:print "DATE  DE  VALEUR :  "+dv$(no)
print_locate 20,770:print "FAMILLE  DE  CATEGORIE :  "+fam$(no)
return

vert:
print_target_is 0
print_locate 10,800:print "  UTILISATEUR :  "+nomutil$+"  "
print_locate 1180,800:print "  "+date$+"  "
2d_fill_color 200,255,200
2d_rectangle 10,790,1200,700
return

rose:
2d_fill_color 255,235,235
2d_rectangle 10,15,1200,45
print_locate 24,20:print " LIGNE  |"
print_locate 64,20:print "DATE OPERATION |"
print_locate 147,20:print "                                                  LIBELLE    ou    MOTIF                                                    |"
print_locate 458,20:print " MR +/-  |"
print_locate 515,20:print "N °  de  PIECE        |"
print_locate 605,18:print "MIN /  MAX        |"
print_locate 754,18:print "Catégorie                                      |"
print_locate 904,18:print "MONTANT                        |"
print_locate 1054,18:print "  SOLDE                |"
print_locate 1134,18:print "CTR              |"
return

verificour:
fi$=fec$(ncpt)
n=file_exists(fi$)
if n=0 then Message "Le fichier "+fi$+" n'existe pas.":goto fin
if n=1 then return
return

addlist:
for n=1 to 111
font_name 1,"Fixedsys"
if nlig$(n)="" then return
lt=len(lib$(n)):li=36-lt:liba$=lib$(n)
if lt>35 then liba$=left$(lib$(n),35):li=1
lt=len(piece$(n)):lp=10-lt
if mid$(piece$(n),4,1)<>"/" then mec$="000":mef$="000"
if mid$(piece$(n),4,1)="/" then mec$=left$(piece$(n),3):mef$=right$(piece$(n),3)
pcat$=left$(cat$(n),23)
lt=len(pcat$):lc=24-lt
a$=mt$(n):ls=9:gosub mt:pmt$=b$
a$=sld$(n):ls=9:gosub mt:psld$=b$
lt=len(ctr$(n)):lr=5-lt
a$=" "+nlig$(n)+" | "+datoper$(n)+" | "+liba$+string$(li," ")+"| "+mr$(n)+op$(n)+" | "+piece$(n)+string$(lp," ")+"| "+mec$+"/"+mef$+" |"+pcat$+string$(lc," ")+" | "+pmt$+ psld$+string$(lr," ")+ctr$(n)+" |"
print_target_is 1
print a$
next n
return

mt:
lt=0:l=0:p=0:d$="":b$=""
if a$="" then b$="        0.00 | ":return
lt=len(a$):l=ls-lt
if lt=1 then b$=string$(l," ")+a$+".00 | ":return
gosub pas
return

pas:
p=0:d$="":b$="":e$=""
pa:
p=p+1
if p>lt then b$=string$(l," ")+a$+".00 | ":return
d$=mid$(a$,p,1)
if d$<>"." then goto pa
e$=mid$(a$,p+1,1)
f$=mid$(a$,p+2,1)
if e$="" and f$="" then b$=string$(l+1," ")+a$+"00 | ":return
if e$<>"" and f$="" then b$=string$(l+2," ")+a$+"0 | ":return
if e$<>"" and f$<>"" then b$=string$(l+3," ")+a$+" | ":return
message "Cas non prévu à l'etiquette pa":terminate

datfich:
an$=mid$(fec$(ncpt),5,2):moi$=mid$(fec$(ncpt),7,2)
datfic:
if moi$="01" then a$="JANVIER / "+an$
if moi$="02" then a$="FEVRIER / "+an$
if moi$="03" then a$="MARS / "+an$
if moi$="04" then a$="AVRIL / "+an$
if moi$="05" then a$="MAI / "+an$
if moi$="06" then a$="JUIN / "+an$
if moi$="07" then a$="JUILLET / "+an$
if moi$="08" then a$="AOUT / "+an$
if moi$="09" then a$="SEPTEMBRE / "+an$
if moi$="10" then a$="OCTOBRE / "+an$
if moi$="11" then a$="NOVEMBBRE / "+an$
if moi$="12" then a$="DECEMBRE / "+an$
return

rem -----------------------------------------------------------------------------
chargeliste:
file_open_read 1,fil$
for n=1 to 9
file_readln 1,cpt$(n)
file_readln 1,lcpt$(n)
file_readln 1,fec$(n)
file_readln 1,rec$(n)
file_readln 1,sldcpt$(n)
next n
file_close 1
return

chargetf03:
file_open_read 1,"cfptf03.cfp"
file_readln 1,proga$
file_readln 1,fi$
file_readln 1,ncpt
file_close 1
return

tf:
file_open_read 1,"cfptf01.cfp"
file_readln 1,proga$
file_readln 1,nu
file_readln 1,nomutil$
file_readln 1,motutil$
file_readln 1,gradutil$
file_close 1
return

chargeoper:
file_open_read 1,fi$
for n=1 to 111
file_readln 1,cod$(n)
file_readln 1,nlig$(n)
file_readln 1,datoper$(n)
file_readln 1,lib$(n)
file_readln 1,mr$(n)
file_readln 1,op$(n)
file_readln 1,piece$(n)
file_readln 1,util$(n)
file_readln 1,dest$(n)
file_readln 1,fam$(n)
file_readln 1,cat$(n)
file_readln 1,dv$(n)
file_readln 1,mt$(n)
file_readln 1,sld$(n)
file_readln 1,ctr$(n)
next n
file_close 1
return

sauveoper:
file_open_write 1,fi$
for n=1 to 111
file_writeln 1,cod$(n)
file_writeln 1,nlig$(n)
file_writeln 1,datoper$(n)
file_writeln 1,lib$(n)
file_writeln 1,mr$(n)
file_writeln 1,op$(n)
file_writeln 1,piece$(n)
file_writeln 1,util$(n)
file_writeln 1,dest$(n)
file_writeln 1,fam$(n)
file_writeln 1,cat$(n)
file_writeln 1,dv$(n)
file_writeln 1,mt$(n)
file_writeln 1,sld$(n)
file_writeln 1,ctr$(n)
next n
file_close 1
return
rem ----------------------------------------------------------------------------

quit:
execute "cfpvisop.exe"
fin:
terminate

rem cfpeoanu

label quit,fin,jaune,bleu,rose,vert,tf,chargetf03,datfich,co,fen2,nouvfich
label chargeliste,sauveliste,chargeoper,sauveoper,verificour,pasfich,addlist
label mt,pa,pas,demar,chargecode,sauvecode,selcode,aficode,strig
label scod,scod2,scod3,scod4,scod5,continue,ct,rec,piece,chekm,chargechequiers,chqprincip
label chargecheque,rpcb,datoper,jour,mois,ans,confdat,atm,modidest,chargedest,seldest
label minmax,adollar,montant,montan,monta,enregop,modilib,modlib,molib,modimr,modmr
label modicat,selfam,cnb,chargefam,addfam,cont,chargecat,selcat,solde,gestioncheque,ctrchq
label sauvechequiers,sauvecheque,visu,changemois,modich,visuch,vch,modic
label preparvir,addvir,sauvevir

dim a,b,c,n,nb,n1c,nc,nf,nu,ncpt,l,lt,lp,l2,lc,ls,lr,p,li,no,nbch,pas,mt,nch,ncq
dim a$,b$,c$,d$,e$,f$,fi$,fil$,fif$,an$,moi$,jou$,liba$,mec$,mef$,pcat$,pmt$,psld$,nu$,fic$,fik$
dim proga$,nomutil$,motutil$,gradutil$,cbkcmod$,afam$,nch$,vir$
dim cpt$(9),lcpt$(9),fec$(9),rec$(9),sldcpt$(9)
dim cod$(111),nlig$(111),datoper$(111),lib$(111),mr$(111),op$(111),piece$(111),util$(111),dest$(111),fam$(111),cat$(111),dv$(111),mt$(111),sld$(111),ctr$(111)
dim codv$(111),datoperv$(111),libv$(111),mrv$(111),opv$(111),piecev$(111),utilv$(111),destv$(111),famv$(111),catv$(111),dvv$(111),mtv$(111)
dim cdc$(99),libc$(99),mrc$(99),opc$(99),famc$(99),catc$(99),desc$(99),utilc$(99),oac$(99),cbkc$(99),dvc$(99),mecc$(99),mefc$(99),mtc$(99)
dim numchq$(10),bkchq$(10),utilchq$(10),typchq$(10),npchk$(10),ndchk$(10),sitchq$(10)
dim nchk$(50),mtchk$(50),datoperchk$(50),datvalchk$(50),ordrechk$(50),sitchk$(50)
dim fifam$(20)


left 0,9
top 0,60:width 0,1264:height 0,834

gosub tf:gosub chargetf03:fil$=fi$:gosub chargeliste:gosub datfich

caption 0,"COMPTE FAMILIALE  *  Enregistrement d'une Opérations sur le Compte:  "+lcpt$(ncpt)+"  *  "+a$+"  *"
font_name 0,"Impact"
font_size 0,9

list 1
left 1,10:top 1,50:width 1,1180:height 1,300
color 1,190,255,255

picture 3
left 3,10:top 3,384:width 3,1180:height 3,50

combo 4
left 4,32:top 4,470:width 4,40
rem caption 4,"JOUR"
for n=1 to 31
item_add 4,n
next n

button 5
left 5,230:top 5,470
caption 5,"Motif"

button 6
left 6,340:top 6,470
caption 6,"MR"

button 2
left 2,420:top 2,470
caption 2,"N° de Chèque"

button 8
left 8,640:top 8,470
caption 8,"Destinataire"

button 9
left 9,725:top 9,470
caption 9,"Montant"

button 10
left 10,810:top 10,470:width 10,80
caption 10,"Date de Valeur"
hide 10

button 11
left 11,15:top 11,354:width 11,150
caption 11,"Démarrer un Enregistrement"
font_size 11,9
on_click 11,demar
hide 11

combo 12
left 12,80:top 12,470:width 12,40
rem caption 12,"MOIS"
for n=1 to 12
item_add 12,n
next n

combo 13
left 13,130:top 13,470:width 13,40
rem caption 13,"ANS"
for n=0 to 99
item_add 13,n
next n

button 14
left 14,500:top 14,470
caption 14,"Catégorie"

button 15
left 15,315:top 15,530:width 15,150
caption 15,"Visualisation de la Page"
on_click 15,visu

button 16
left 16,489:top 16,530:width 16,150
caption 16,"Changement d'année"
on_click 16,changemois

button 17
left 17,665:top 17,530:width 17,150
caption 17,"Retour au Menu général"
on_click 17,quit

list 18:top 18,600:left 18,80:width 18,1050:height 18,170
inactive 18
on_click 18,continue

edit 19:top 19,550:left 19,80:width 19,30:height 19,25
inactive 19
on_change 19,scod

alpha 20:top 20,530:left 20,54
caption 20,"Entrez la premiere lettre du code"
inactive 20

button 21:top 21,552:left 21,120:width 21,20:height 21,20:caption 21,"OK"
inactive 21
on_click 21,scod2

print_locate 10,780:print "UTILISATEUR :  "+nomutil$
print_locate 1190,780:print date$

gosub fen2:gosub verificour
inactive 2:inactive 4:inactive 5:inactive 6:inactive 8:inactive 9
inactive 12:inactive 13:inactive 14

button 22
left 22,15:top 22,354:width 22,150
caption 22,"Recommencer"
font_size 22,9
on_click 22,rec
hide 22

edit 23:top 23,540:left 23,980:width 23,80:height 23,25
hide 23

button 24:top 24,544:left 24,1065:width 24,20:height 24,20:caption 24,"OK"
hide 24

button 25:top 25,510:left 25,25:width 25,150:height 25,20:caption 25,"Confirmation Date Opération"
hide 25

button 26
left 26,200:top 26,354:width 26,150
caption 26,"VALIDER  l ' Opération"
font_size 26,9
on_click 26,enregop
hide 26

edit 27:top 27,650:left 27,155:width 27,225:height 27,20
hide 27

button 31:top 31,652:left 31,395:width 31,20:height 31,20:caption 31,"OK"
hide 31

combo 32:top 32,650:left 32,155:width 32,50:height 32,20
item_add 32,"CB":item_add 32,"CH":item_add 32,"VI":item_add 32,"ES":item_add 32,"AU":item_add 32,"RG"
hide 32

gosub bleu:gosub jaune:gosub rose
gosub chargeoper:gosub addlist:no=n
show 11:set_focus 11

end
rem ----------------------------------------------------------------------------
modich:
if mr$(no)<>"CH" then message "Le règlement n'est pas un Chèque":gosub jaune:return
gosub visuch
list 34:top 34,200:left 34,900:width 34,300:height 34,400
on_click 34,modic
return

modic:
hide 34:gosub bleu:gosub vert:gosub jaune
nch$=left$(item_index$(34),6)
nch=val(nch$)
piece$(no)="N°"+nch$
print_locate 15,400:print "  "+nlig$(no)+"    |        "
print_locate 60,400:print datoper$(no)+"        |      "
print_locate 130,400:print cod$(no)+"  |              "
print_locate 160,400:print string$(110," ")+"  | "
print_locate 160,400:print lib$(no)
print_locate 390,400:print string$(8," ")+"  | "
print_locate 390,400:print mr$(no)+op$(no)
print_locate 415,400:print string$(57," ")
print_locate 420,400:print piece$(no)+"  | "
print_locate 480,400:print string$(107," ")
print_locate 485,400:print cat$(no)+"  |"
print_locate 645,400:print string$(50," ")
print_locate 653,400:print dest$(no)+"  |  "
return

visuch:
combo 33:top 33,200:left 33,500:width 33,340
print_locate 15,80:print "Sélectionnez le Chèquier"
for n1c=1 to 10
item_add 33,numchq$(n1c)+" "+bkchq$(n1c)+" "+typchq$(n1c)+" "+npchk$(n1c)+"/"+ndchk$(n1c)+" "+sitchq$(n1c)
next n1c
on_click 33,vch
return

vch:
n1c=item_index(33):ncq=n1c
if numchq$(n1c)="" then message "Sélection Vide":return
hide 33
rem print_locate 96,105:print "|N°CHEQUE|  MONTANT  | DATE OPER. | DATE VAL.. |        ORDRE        | SITUATION | |"
fik$="cf"+nu$+"ch"+numchq$(n1c)+".cfp"
a=val(npchk$(n1c)):b=val(ndchk$(n1c)):nbch=1+(b-a)
gosub chargecheque
for n1c=1 to nbch
c$=nchk$(n1c)+" |"
a$=mtchk$(n1c):ls=9:gosub mt:c$=c$+b$
a$=datoperchk$(n1c):ls=12:gosub strig
a$=datvalchk$(n1c):ls=12:gosub strig
a$=ordrechk$(n1c):ls=22:gosub strig
a$=sitchk$(n1c):ls=14:gosub strig
item_add 34,c$:c$=""
next n1c
return

changemois:
execute "cfpnovan.exe":goto fin
return

visu:
execute "cfpvisop.exe":goto fin
return

enregop:
rem clear 1:n=0:gosub addlist
hide 26:hide 2:hide 5:hide 6:hide 8:hide 9:hide 10:hide 14
gosub jaune
gosub solde
if mr$(no)="CH" then gosub gestioncheque
mt$(no)=str$(mt)
gosub preparvir
if vir$="O" then gosub sauvevir
gosub sauveoper
gosub sauvecode
gosub sauveliste
if vir$="O" then execute "cfpvir.exe":goto fin
if proga$="cfpprlv.exe" then execute proga$:goto fin
print "Votre  opération  est  enregistrée.  Cliquez  sur  [ Recommencer ]  ou  [ Retour au Menu ]"
return

preparvir:
n=0:vir$=""
if nlig$(no)="" then return
if left$(cod$(no),2)="VI" then gosub addvir
return

addvir:
n=n+1:vir$="O"
codv$(n)=cod$(no):datoperv$(n)=datoper$(no):libv$(n)=lib$(no):mrv$(n)=mr$(no):opv$(n)="+"
piecev$(n)=piece$(no):utilv$(n)=util$(no):destv$(n)=dest$(no):famv$(n)=fam$(no)
catv$(n)=cat$(no):dvv$(n)=dv$(no):mtv$(n)=mt$(no)
return

gestioncheque:
mtchk$(nch)=str$(mt):datoperchk$(nch)=datoper$(no):datvalchk$(nch)=dv$(no)
ordrechk$(nch)=dest$(no):sitchk$(nch)="EMIS"
if cod$(no)="CHA" then sitchk$(nch)="ANNULE"
print numchq$(ncq)+" "+bkchq$(ncq)+" "+utilchq$(ncq)+" "+typchq$(ncq)+" "+npchk$(ncq)+" "+ndchk$(ncq)+" "+sitchq$(ncq)
gosub ctrchq
print nchk$(nch)+" "+mtchk$(nch)+" "+datoperchk$(nch)+" "+datvalchk$(nch)+" "+ordrechk$(nch)+" "+sitchk$(nch)
gosub sauvechequiers
gosub sauvecheque
return

ctrchq:
for n=1 to nbch
if n>nbch then sitchq$(ncq)="PAS TOUT POINTE":typchq$(ncq)="SECONDAIRE":return
if sitchk$(n)="BLANC" then sitchq$(ncq)="A FINIR": return
next n

continue:
gosub vert:gosub rose
hide 20:hide 19:hide 21
inactive 15:inactive 16
a$=item_index$(18):b$=right$(a$,3):nc=val(b$)
if left$(cbkc$(nc),2)="9T" then goto ct
if cbkc$(nc)<>cpt$(ncpt)  then message "Ce Code ne peut pas être utilisé sur ce Compte":return
ct:
if oac$(nc)="O" then message "Code réservé aux Opérations Automatiques":return: rem <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< a verifier
gosub datoper
cod$(no)=cdc$(nc):lib$(no)=libc$(nc):mr$(no)=mrc$(nc):op$(no)=opc$(nc)
util$(no)=utilc$(nc):dest$(no)=desc$(nc):fam$(no)=famc$(nc):cat$(no)=catc$(nc):dv$(no)=dvc$(nc):mt$(no)=mtc$(nc)
mt=val(mt$(no))
gosub minmax
gosub piece
print_locate 15,400:print "  "+nlig$(no)+"    |        "
print_locate 60,400:print datoper$(no)+"        |      "
print_locate 130,400:print cod$(no)+"  |              "
print_locate 160,400:print string$(110," ")+"  | "
print_locate 160,400:print lib$(no)
print_locate 390,400:print string$(8," ")+"  | "
print_locate 390,400:print mr$(no)+op$(no)
print_locate 415,400:print string$(57," ")
print_locate 420,400:print piece$(no)+"  | "
print_locate 480,400:print string$(107," ")
print_locate 485,400:print cat$(no)+"  |"
print_locate 645,400:print string$(50," ")
print_locate 653,400:print dest$(no)+"  |  "
if val(mt$(no))=0 then gosub montant
print_locate 758,400:print string$(25," ")
print_locate 758,400:print mt$(no)+"  |  "
dv$(no)=datoper$(no)
print_locate 780,400:print string$(20," ")
print_locate 815,400:print "  "+dv$(no)+"        |"
if mr$(no)="CH" then active 2
active 5:active 6:active 8:active 9:active 14
gosub vert:print_locate 60,600:print " Modifiez les éléments de l'opération avec les bouttons si nécéssaire, puis Valider ou Retour au Menu "
show 26
gosub jaune
on_click 9,montant
on_click 5,modilib
on_click 6,modimr
on_click 8,modidest
on_click 14,modicat
on_click 2,modich
return

solde:
a= val(sldcpt$(ncpt))
if op$(no)="-" then c=a-mt
if op$(no)="+" then c=a+mt
a$=str$(c)
sld$(no)=a$:sldcpt$(ncpt)=a$
gosub vert:print_locate 60,600:print "Nouveau Solde: "+sld$(no)
return

modicat:
list 33:left 33,830:top 33,520:width 33,170:height 33,250
gosub chargefam: gosub addfam
on_click 33,selfam
list 34:left 34,1010:top 34,520:width 34,190:height 34,250
on_click 34,selcat
gosub rose
return

selcat:
n=item_index(34)
a$=item_index$(34)
if cat$(n)="" then message "Sélection Vide":return
cat$(no)=a$
gosub jaune
print_locate 480,400:print string$(62," ")
print_locate 485,400:print cat$(no)+"  |"
hide 33:hide 34:inactive 14:gosub vert:gosub jaune
return

selfam:
pas=pas+1:if pas >1 then clear 34
n=item_index(33):nf=n
a$=item_index$(33)
if a$="" then message "Sélection Vide":return
l=len(fam$(n)):afam$=left$(fam$(n),l-1):fif$=fifam$(nf)
gosub chargecat
for n=1 to 15
item_add 34,cat$(n)
next n
gosub cnb
return

cnb:
for n=1 to 15
nb=nb+1
if cat$(n)="" then nb=nb-1
next n
return

addfam:
nf=0
for n=1 to 20
if fam$(n)="" then goto cont
l=len(fam$(n)):afam$=left$(fam$(n),l-1)
nf=nf+1
cont:
item_add 33,afam$
afam$=""
next n
return

modidest:
gosub chargedest
list 7:left 7,950:top 7,445:width 7,178:height 7,330
gosub rose:gosub vert:gosub jaune
for n=1 to 99
item_add 7,dest$(n)
next n
on_click 7,seldest
return

seldest:
dest$(no)=item_index$(7)
print_locate 635,400:print string$(40," ")
print_locate 643,400:print dest$(no)+"  |"
hide 7:inactive 8:gosub vert:gosub jaune
return

modimr:
show 32:set_focus 32
on_click 32,modmr
return

modmr:
mr$(no)=text$(32)
print_locate 390,400:print string$(7," ")+"  | "
print_locate 390,400:print mr$(no)+op$(no)
hide 32:gosub vert
gosub piece
gosub jaune
print_locate 415,400:print string$(17," ")
print_locate 420,400:print piece$(no)+"  | "
rem <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< if mr$(no)="CH" and op$(no)="-" then active 10
return

modilib:
text 27,lib$(no)
on_change 27,modlib
show 27:set_focus 27
return

modlib:
a$=text$(27)
if len(a$)<3 then message "3 caractères Minimum":return
if len(a$)>36 then message "36 caractères Maximum":return
show 31
on_click 31,molib
return

molib:
lib$(no)=a$
gosub jaune
print_locate 160,400:print string$(109," ")+"  | "
print_locate 160,400:print lib$(no)
hide 27:hide 31:gosub vert:gosub jaune
return

montant:
if cod$(no)="CHA" then mt=0:mt$(no)="0.00":return
show 23:set_focus 23
on_change 23,montan
print_locate 980,520:print "Entrez le Montant"
return

montan:
a$=text$(23)
if numeric(a$)=0 then text 23,"":return
if len(a$)>10 then text 23,"":return
show 24
on_click 24,monta
return

monta:
mt=val(a$)
a$=str$(mt)
mt$(no)=a$
gosub mt
hide 23:hide 24
gosub jaune
print_locate 980,520:print string$(41," ")
print_locate 738,400:print string$(15," ")
print_locate 743,400:print mt$(no)
return

minmax:
a=val(mecc$(nc)):b=val(mefc$(nc))
if b=0 then return
if b>0 then a=a+1
a$=str$(a):gosub adollar
b$=mefc$(nc)
mecc$(nc)=a$
if a>b then piece$(no)="Terminé":mt=0:mt$(no)="0,00"
piece$(no)=a$+"/"+b$
return

adollar:
a=val(a$)
if a<10 then a$="00"+a$:return
if a>9 and a<100 then a$="0"+a$:return
return

piece:
if cod$(no)="CHA" then piece$(no)="ANNULE":ctr$(no)="CHA"
if mid$(piece$(no),4,1)="/" then return
if mr$(no)="CH" and op$(no)="-" then gosub chekm:return
if mr$(no)="CH" and op$(no)="+" then piece$(no)=datoper$(no):return
if mr$(no)="ES" and op$(no)="-" then piece$(no)=datoper$(no):return
if mr$(no)="ES" and op$(no)="+" then piece$(no)=datoper$(no):return
if mr$(no)="VI" or mr$(no)="AU" and op$(no)="-" then piece$(no)=datoper$(no):return
if mr$(no)="VI" or mr$(no)="AU" and op$(no)="+" then piece$(no)=datoper$(no):return
if mr$(no)="CB" and op$(no)="-" then piece$(no)=datoper$(no):return
if mr$(no)="DB" and op$(no)="-" then piece$(no)=datoper$(no):return
if mr$(no)="RG" and op$(no)="-" then piece$(no)=datoper$(no):ctr$(no)="REG":return
if mr$(no)="RG" and op$(no)="+" then piece$(no)=datoper$(no):ctr$(no)="REG":return
return

datoper:
active 4:active 12:active 13:show 22:show 25:hide 18:gosub vert:gosub rose
on_click 4,jour
on_click 12,mois
on_click 13,ans
on_click 25,confdat
print_locate 60,600:print " Modifier si nécéssaire la date d'opération, puis confirmer "
gosub atm
return

jour:
jou$=text$(4)
if val(jou$)<10 then jou$="0"+jou$
gosub atm
return
mois:
moi$=text$(12)
if val(moi$)<10 then moi$="0"+moi$
gosub atm
return
ans:
an$=text$(13)
if val(an$)<10 then an$="0"+an$
gosub atm
return

confdat:
a$=jou$:b$=moi$:c$=an$
datoper$(no)=a$+"/"+b$+"/"+c$
inactive 4:inactive 12:inactive 13:hide 25:gosub vert:gosub jaune
print_locate 415,400:print string$(27," ")+"  | "
return

atm:
a$=inkey$:if a$="" then goto atm
return

chekm:
nu$=str$(nu)
fic$="cfp"+nu$+"chq.cfp"
n=0:gosub chargechequiers
n=0:gosub chqprincip
if numchq$(1)="" then message "il n'y a aucun chèquiers ouvert. vous devez le créer.":execute "cfpgchq.exe":goto fin
a=val(npchk$(n)):b=val(ndchk$(n)):nbch=1+(b-a)
ncq=n
fik$="cf"+nu$+"ch"+a$+".cfp"
gosub chargecheque
a$="":gosub rpcb
piece$(no)="N°"+a$
nch=n
gosub jaune
return

rpcb:
for n=1 to nbch
if n>nbch then message "il n'y a plus de Chèque sur le chèquier "+fik$+" Vous allez être redirigé vers la gestion des chèques.":execute "cfpgchq.exe":goto fin
if sitchk$(n)="BLANC" then a$=nchk$(n): return
next n
return

chqprincip:
for n= 1 to 10
if n>10 then message "il n'y a pas de chèquier principale. vous ne pouvez continuer.":execute "cfpgchq.exe":goto fin
if typchq$(n)="PRINCIPAL" then a$=numchq$(n):return
next n
return

demar:
inactive 11:active 18
print_target_is 0
if no<10 then nlig$(no)="00"+str$(no)
if no>9 and no<100 then nlig$(no)="0"+str$(no)
if no>100 then nlig$(no)=str$(no)
print_locate 15,400:print "  "+nlig$(no)+"    |        "
jou$=left$(date$,2):moi$=mid$(date$,4,2):an$=mid$(date$,9,2):datoper$(no)=jou$+"/"+moi$+"/"+an$
text 4,jou$:text 12,moi$:text 13,an$
print_locate 60,400:print datoper$(no)+"        |      "
gosub chargecode:gosub selcode
gosub vert:gosub rose
return

selcode:
nc=1:gosub aficode
active 20:active 19
font_name 19,"Courier New"
set_focus 19
return

scod:
active 21:set_focus 21
return
scod2:
a$=upper$(text$(19))
gosub scod3
return

scod3:
nc=0:n=0:b$=""
scod4:
n=n+1
if n>99 then b$="":n=1:goto scod5
b$=mid$(cdc$(n),1,1)
if b$="" then goto scod4
if b$=a$ then goto scod5
goto scod4

scod5:
if b$="" then message "Pas de Code Qui Commence par "+a$
clear 18
nc=n:gosub aficode
set_focus 18
hide 20:hide 19:hide 21
return

aficode:
font_name 18,"Fixedsys"
for n=nc to 99-(nc+1)
c$="":a$="":b$="":d$="":lt=0:l=0:ls=0
a$=cdc$(n):ls=4:gosub strig
a$=libc$(n):if len(a$)>36 then a$=left$(a$,36)
ls=37:gosub strig
c$=c$+" "+mrc$(n)
if mrc$(n)="" then c$=c$+"  "
c$=c$+opc$(n)+" |"
a$=catc$(n):ls=32:gosub strig
if oac$(n)=""then oac$(n)=" "
c$=c$+" "+oac$(n)+" | "
cbkcmod$=left$(cbkc$(n),2)
if cbkc$(n)="" then c$=c$+"  "
c$=c$+""+cbkcmod$+" | "
a$=dvc$(n):ls=5:gosub strig
a$=mecc$(n):ls=4:gosub strig
a$=mefc$(n):ls=4:gosub strig
a$=mtc$(n):ls=9:gosub mt:c$=c$+b$
a$=str$(n)
if len(a$)=1 then b$="00"+a$
if len(a$)=2 then b$="0"+a$
if len(a$)=3 then b$=a$
c$=c$+b$
item_add 18,c$
next n
return

strig:
if a$="" then d$=string$(ls," ")+"|":c$=c$+d$:a$="":b$="":d$="":lt=0:l=0:ls=0:return
lt=len(a$):l=ls-lt:b$=left$(a$,lt)+string$(l," ")+"|"
c$=c$+b$:a$="":b$="":lt=0:l=0:ls=0
return

addlist:
for n=1 to 111
font_name 1,"Fixedsys"
if nlig$(n)="" then return
lt=len(lib$(n)):li=36-lt:liba$=lib$(n)
if lt>35 then liba$=left$(lib$(n),35):li=1
lt=len(piece$(n)):lp=9-lt
if mid$(piece$(n),4,1)<>"/" then mec$="000":mef$="000"
if mid$(piece$(n),4,1)="/" then mec$=left$(piece$(n),3):mef$=right$(piece$(n),3)
pcat$=left$(cat$(n),23)
lt=len(pcat$):lc=24-lt
a$=mt$(n):ls=9:gosub mt:pmt$=b$
a$=sld$(n):ls=9:gosub mt:psld$=b$
lt=len(ctr$(n)):lr=5-lt
a$=" "+nlig$(n)+" | "+datoper$(n)+" | "+liba$+string$(li," ")+"| "+mr$(n)+op$(n)+" | "+piece$(n)+string$(lp," ")+"| "+mec$+"/"+mef$+" |"+pcat$+string$(lc," ")+" | "+pmt$+ psld$+string$(lr," ")+ctr$(n)+" |"
print_target_is 1
print a$
next n
return

rose:
2d_fill_color 255,235,235
2d_rectangle 10,15,1190,45
print_locate 24,20:print " LIGNE  |"
print_locate 64,20:print "DATE OPERATION |"
print_locate 147,20:print "                                                  LIBELLE    ou    MOTIF                                                    |"
print_locate 458,20:print " MR +/-  |"
print_locate 515,20:print "N °  de  PIECE    |"
print_locate 605,18:print "MIN /  MAX    |"
print_locate 754,18:print "Catégorie                                  |"
print_locate 904,18:print "MONTANT                    |"
print_locate 1054,18:print "  SOLDE            |"
print_locate 1134,18:print "CTR          |"
return

mt:
lt=0:l=0:p=0:d$="":b$=""
if a$="" then b$="        0.00 | ":return
lt=len(a$):l=ls-lt
if lt=1 then b$=string$(l," ")+a$+".00 | ":return
gosub pas
return

pas:
p=0:d$="":b$="":e$=""
pa:
p=p+1
if p>lt then b$=string$(l," ")+a$+".00 | ":return
d$=mid$(a$,p,1)
if d$<>"." then goto pa
e$=mid$(a$,p+1,1)
f$=mid$(a$,p+2,1)
if e$="" and f$="" then b$=string$(l+1," ")+a$+"00 | ":return
if e$<>"" and f$="" then b$=string$(l+2," ")+a$+"0 | ":return
if e$<>"" and f$<>"" then b$=string$(l+3," ")+a$+" | ":return
message "Cas non prévu à l'etiquette pa":terminate

datfich:
an$=mid$(fec$(ncpt),5,4)
a$=an$
return

co:
hide 28:hide 29:hide 30
print_target_is 0
command_target_is 0
inactive 5:inactive 6:inactive 8:inactive 9:inactive 11:inactive 12:inactive 13:inactive 14:inactive 15
cod$(1)="DEP":nlig$(1)="001"
jou$=left$(date$,2):moi$=mid$(date$,4,2):an$=mid$(date$,9,2):datoper$(1)=jou$+"/"+moi$+"/"+an$
lib$(1)="Démarrage du Compte":mr$(1)="AU":op$(1)="§":piece$(1)="Dépard":util$(1)=nomutil$
dest$(1)="":fam$(1)="FONCTION":cat$(1)="FONCTION: Neutre":dv$(1)=datoper$(1):mt$(1)="0.00"
sld$(1)=sldcpt$(ncpt):ctr$(1)="DEP"
for n=2 to 111
nlig$(n)=""
next n
gosub nouvfich
return

nouvfich:
a$=left$(fec$(ncpt),4)
an$=mid$(fec$(ncpt),5,4)
fi$=a$+an$+".cfp"
fec$(ncpt)=fi$
print_locate 50,600:print fec$(ncpt)
gosub sauveliste
gosub sauveoper
execute "cfpeoanu.exe"
return

vert:
2d_fill_color 200,255,200
2d_rectangle 10,580,1190,780
return

jaune:
2d_fill_color 240,245,120
2d_rectangle 10,500,1190,440
print_locate 30,446:print "  JOUR    /    MOIS    /    ANNEE"
return

bleu:
2d_fill_color 140,235,255
2d_rectangle 310,562,820,522
return
rem ----------------------------------------------------------------------------
pasfich:
show 30
print_target_is 30
print_locate 350,10:print "Le fichier "+fi$+" n'existe pas"
print_locate 10,50:print "1er CAS:"
print_locate 30,90:print "Si vous enregistrez une Opération pour la première fois, c'est normal."
print_locate 10,350:print "2ème CAS:"
print_locate 30,380:print "Ce n'est pas normal, Cliquez sur [Abandon] pour rechercher l'erreur"
show 28:show 29
end
return

verificour:
fi$=fec$(ncpt)
n=file_exists(fi$)
if n=0 then Message "Le fichier "+fi$+" n'existe pas. Suivez les instrutions qui vous seront données.":gosub pasfich:return
if n=1 then return
return
rem ----------------------------------------------------------------------------
sauvevir:
file_open_write 1,"cfpvir.cfp"
for n=1 to 111
file_writeln 1,codv$(n)
file_writeln 1,datoperv$(n)
file_writeln 1,libv$(n)
file_writeln 1,mrv$(n)
file_writeln 1,opv$(n)
file_writeln 1,piecev$(n)
file_writeln 1,utilv$(n)
file_writeln 1,destv$(n)
file_writeln 1,famv$(n)
file_writeln 1,catv$(n)
file_writeln 1,dvv$(n)
file_writeln 1,mtv$(n)
next n
file_close 1
return

chargeoper:
file_open_read 1,fi$
for n=1 to 111
file_readln 1,cod$(n)
file_readln 1,nlig$(n)
file_readln 1,datoper$(n)
file_readln 1,lib$(n)
file_readln 1,mr$(n)
file_readln 1,op$(n)
file_readln 1,piece$(n)
file_readln 1,util$(n)
file_readln 1,dest$(n)
file_readln 1,fam$(n)
file_readln 1,cat$(n)
file_readln 1,dv$(n)
file_readln 1,mt$(n)
file_readln 1,sld$(n)
file_readln 1,ctr$(n)
next n
file_close 1
return

sauveoper:
file_open_write 1,fi$
for n=1 to 111
file_writeln 1,cod$(n)
file_writeln 1,nlig$(n)
file_writeln 1,datoper$(n)
file_writeln 1,lib$(n)
file_writeln 1,mr$(n)
file_writeln 1,op$(n)
file_writeln 1,piece$(n)
file_writeln 1,util$(n)
file_writeln 1,dest$(n)
file_writeln 1,fam$(n)
file_writeln 1,cat$(n)
file_writeln 1,dv$(n)
file_writeln 1,mt$(n)
file_writeln 1,sld$(n)
file_writeln 1,ctr$(n)
next n
file_close 1
return

chargeliste:
file_open_read 1,fil$
for n=1 to 9
file_readln 1,cpt$(n)
file_readln 1,lcpt$(n)
file_readln 1,fec$(n)
file_readln 1,rec$(n)
file_readln 1,sldcpt$(n)
next n
file_close 1
return

sauveliste:
file_open_write 1,fil$
for n=1 to 9
file_writeln 1,cpt$(n)
file_writeln 1,lcpt$(n)
file_writeln 1,fec$(n)
file_writeln 1,rec$(n)
file_writeln 1,sldcpt$(n)
next n
file_close 1
return

chargetf03:
file_open_read 1,"cfptf03.cfp"
file_readln 1,proga$
file_readln 1,fi$
file_readln 1,ncpt
file_close 1
return

tf:
file_open_read 1,"cfptf01.cfp"
file_readln 1,proga$
file_readln 1,nu
file_readln 1,nomutil$
file_readln 1,motutil$
file_readln 1,gradutil$
file_close 1
print_locate 10,780:print "UTILISATEUR :  "+nomutil$
print_locate 1190,780:print date$
return

chargecode:
file_open_read 1,"cfpcodes.cfp"
for n=1 to 99
file_readln 1,cdc$(n)
file_readln 1,libc$(n)
file_readln 1,mrc$(n)
file_readln 1,opc$(n)
file_readln 1,famc$(n)
file_readln 1,catc$(n)
file_readln 1,desc$(n)
file_readln 1,utilc$(n)
file_readln 1,oac$(n)
file_readln 1,cbkc$(n)
file_readln 1,dvc$(n)
file_readln 1,mecc$(n)
file_readln 1,mefc$(n)
file_readln 1,mtc$(n)
next n
file_close 1
return

sauvecode:
file_open_write 1,"cfpcodes.cfp"
for n=1 to 99
file_writeln 1,cdc$(n)
file_writeln 1,libc$(n)
file_writeln 1,mrc$(n)
file_writeln 1,opc$(n)
file_writeln 1,famc$(n)
file_writeln 1,catc$(n)
file_writeln 1,desc$(n)
file_writeln 1,utilc$(n)
file_writeln 1,oac$(n)
file_writeln 1,cbkc$(n)
file_writeln 1,dvc$(n)
file_writeln 1,mecc$(n)
file_writeln 1,mefc$(n)
file_writeln 1,mtc$(n)
next n
file_close 1
return

chargechequiers:
file_open_read 1,fic$
for n=1 to 10
file_readln 1,numchq$(n)
file_readln 1,bkchq$(n)
file_readln 1,utilchq$(n)
file_readln 1,typchq$(n)
file_readln 1,npchk$(n)
file_readln 1,ndchk$(n)
file_readln 1,sitchq$(n)
next n
file_close 1
return

sauvechequiers:
file_open_write 1,fic$
for n=1 to 10
file_writeln 1,numchq$(n)
file_writeln 1,bkchq$(n)
file_writeln 1,utilchq$(n)
file_writeln 1,typchq$(n)
file_writeln 1,npchk$(n)
file_writeln 1,ndchk$(n)
file_writeln 1,sitchq$(n)
next n
file_close 1
return

sauvecheque:
file_open_write 1,fik$
for n=1 to 50
file_writeln 1,nchk$(n)
file_writeln 1,mtchk$(n)
file_writeln 1,datoperchk$(n)
file_writeln 1,datvalchk$(n)
file_writeln 1,ordrechk$(n)
file_writeln 1,sitchk$(n)
next n
file_close 1
return

chargecheque:
file_open_read 1,fik$
for n=1 to 50
file_readln 1,nchk$(n)
file_readln 1,mtchk$(n)
file_readln 1,datoperchk$(n)
file_readln 1,datvalchk$(n)
file_readln 1,ordrechk$(n)
file_readln 1,sitchk$(n)
next n
file_close 1
return

chargedest:
file_open_read 1,"cfpdest.cfp"
for n=1 to 99
file_readln 1,dest$(n)
next n
file_close 1
return

chargecat:
file_open_read 1,fif$
for n=1 to 15
file_readln 1,cat$(n)
next n
file_close 1
return

chargefam:
file_open_read 1,"cfplisfa.cfp"
for n=1 to 20
file_readln 1,fifam$(n)
file_readln 1,fam$(n)
next n
file_close 1
return

rem --------------------------------

fen2:
form 30
top 30,100:left 30,150:width 30,1040:height 30,600
caption 30,"COMPTE FAMILIALE  *  Enregistrement d'une Opérations sur le Compte:  "+lcpt$(ncpt)+"  *  "+a$+"  *"
color 30,200,240,255
font_name 30,"Fixedsys"
hide 30
command_target_is 30
button 28
left 28,315:top 28,500:width 28,150
caption 28,"Continuer"
on_click 28,co
hide 28
button 29
left 29,580:top 29,500:width 29,150
caption 29,"Abandon"
on_click 29,quit
hide 29
command_target_is 0
return

rem ----------------------------------------------------------------------------
rec:
execute "cfpeomen.exe":goto fin
return

quit:
execute "cfpmenug.exe"
fin:
terminate