FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC
Vous souhaitez réagir à ce message ? Créez un compte en quelques clics ou connectez-vous pour continuer.
FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC

Développement d'applications avec le langage Panoramic
 
AccueilAccueil  RechercherRechercher  Dernières imagesDernières images  S'enregistrerS'enregistrer  MembresMembres  Connexion  
Derniers sujets
» SineCube
CFP les codes Emptypar Marc Aujourd'hui à 12:38

» Editeur EliP 6 : Le Tiny éditeur avec 25 onglets de travail
CFP les codes Emptypar Marc Aujourd'hui à 12:22

» Philharmusique
CFP les codes Emptypar jjn4 Hier à 13:58

» PANORAMIC V 1
CFP les codes Emptypar papydall Jeu 9 Mai 2024 - 3:22

» select intégrés [résolu]
CFP les codes Emptypar jjn4 Mer 8 Mai 2024 - 17:00

» number_mouse_up
CFP les codes Emptypar jjn4 Mer 8 Mai 2024 - 11:59

» Aide de PANORAMIC
CFP les codes Emptypar jjn4 Mer 8 Mai 2024 - 11:16

» trop de fichiers en cours
CFP les codes Emptypar lepetitmarocain Mer 8 Mai 2024 - 10:43

» Je teste PANORAMIC V 1 beta 1
CFP les codes Emptypar papydall Mer 8 Mai 2024 - 4:17

» bouton dans autre form que 0
CFP les codes Emptypar leclode Lun 6 Mai 2024 - 13:59

» KGF_dll - nouvelles versions
CFP les codes Emptypar Klaus Lun 6 Mai 2024 - 11:41

» Gestion d'un système client-serveur.
CFP les codes Emptypar Klaus Lun 6 Mai 2024 - 10:23

» @Jack
CFP les codes Emptypar Jack Mar 30 Avr 2024 - 20:40

» Une calculatrice en une ligne de programme
CFP les codes Emptypar jean_debord Dim 28 Avr 2024 - 8:47

» Form(résolu)
CFP les codes Emptypar leclode Sam 27 Avr 2024 - 17:59

Navigation
 Portail
 Index
 Membres
 Profil
 FAQ
 Rechercher
Rechercher
 
 

Résultats par :
 
Rechercher Recherche avancée
Mai 2024
LunMarMerJeuVenSamDim
  12345
6789101112
13141516171819
20212223242526
2728293031  
CalendrierCalendrier
-45%
Le deal à ne pas rater :
WHIRLPOOL OWFC3C26X – Lave-vaisselle pose libre 14 couverts – ...
339 € 622 €
Voir le deal

 

 CFP les codes

Aller en bas 
2 participants
Aller à la page : 1, 2  Suivant
AuteurMessage
Jean Claude

Jean Claude


Nombre de messages : 5950
Age : 69
Localisation : 83 Var
Date d'inscription : 07/05/2009

CFP les codes Empty
MessageSujet: CFP les codes   CFP les codes EmptyMar 15 Sep 2009 - 19:05

Voici le premier code, pour celui-ci le nom importe peut car li faudra le lancer une seule fois. Il sert à installer les fichiers nécéssaires au fontionnement de CFP. Pour vos commentaires, utilisé la rubrique CFP vos commentaires

Code:

rem instalcfp

dim util$(10),mdp$(10),grad$(10)
dim dest$(100)
dim n,nu
dim fi$,fic$,nu$
dim cat$(15)
dim fam$(20),fifam$(20)
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)

for nu=1 to 10
nu$=str$(nu)
fic$="cfp"+nu$+"chq.cfp"
file_open_write 1,fic$
for n=1 to 10
numchq$(n)="":bkchq$(n)="":utilchq$(n)="":typchq$(n)="":npchk$(n)="":ndchk$(n)="":sitchq$(n)=""
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
next nu


cdc$(1)="D":libc$(1)="Retrait au Distributeur":mrc$(1)="DB":opc$(1)="-":famc$(1)="CONSOMATION:":catc$(1)="CONSOMATION: Divers":desc$(1)=""
utilc$(1)="TOUS":oac$(1)="N":cbkc$(1)="9T":dvc$(1)="00":mecc$(1)="000":mefc$(1)="000":mtc$(1)="0"

cdc$(2)="CHA":libc$(2)="Chèque Annulé":mrc$(2)="CH":opc$(2)="-":famc$(2)="FONCTION:":catc$(2)="FONCTION: Chèque annulé":desc$(2)=""
utilc$(2)="TOUS":oac$(2)="N":cbkc$(2)="9T":dvc$(2)=" ":mecc$(2)="000":mefc$(2)="000":mtc$(2)="0"

cdc$(3)="RG+":libc$(3)="Régularisation en plus":mrc$(3)="RG":opc$(3)="+":famc$(3)="FONCTION:":catc$(3)="FONCTION: Régularisation":desc$(3)=""
utilc$(3)="TOUS":oac$(3)="N":cbkc$(3)="9T":dvc$(3)="00":mecc$(3)="000":mefc$(3)="000":mtc$(3)="0"

cdc$(4)="RG-":libc$(4)="Régularisation en moins":mrc$(4)="RG":opc$(4)="-":famc$(4)="FONCTION:":catc$(4)="FONCTION: Régularisation":desc$(4)=""
utilc$(4)="TOUS":oac$(4)="N":cbkc$(4)="9T":dvc$(4)="00":mecc$(4)="000":mefc$(4)="000":mtc$(4)="0"

cdc$(5)="RD":libc$(5)="Recettes Diverses":mrc$(5)="VI":opc$(5)="+":famc$(5)="REVENUS:":catc$(5)="REVENUS: Divers":desc$(5)=""
utilc$(5)="TOUS":oac$(5)="N":cbkc$(5)="9T":dvc$(5)="00":mecc$(5)="000":mefc$(5)="000":mtc$(5)="0"

cdc$(6)="DDC":libc$(6)="Dépenses Diverses par Chèque":mrc$(6)="CH":opc$(6)="-":famc$(6)="CONSOMATION:":catc$(6)="CONSOMATION: Divers":desc$(6)="DIVERS"
utilc$(6)="TOUS":oac$(6)="N":cbkc$(6)="9T":dvc$(6)="00":mecc$(6)="000":mefc$(6)="000":mtc$(6)="0"

cdc$(7)="DDB":libc$(7)="Dépenses Diverses par Carte Bancaire":mrc$(7)="CB":opc$(7)="-":famc$(7)="CONSOMATION:":catc$(7)="CONSOMATION: Divers":desc$(7)="DIVERS"
utilc$(7)="TOUS":oac$(7)="N":cbkc$(7)="9T":dvc$(7)="00":mecc$(7)="000":mefc$(7)="000":mtc$(7)="0"

cdc$(8)="CPA":libc$(8)="Remboursement Sécu (CPAM)":mrc$(8)="VI":opc$(8)="+":famc$(8)="SANTE:":catc$(8)="SANTE: Remboursement":desc$(8)="CPAM"
utilc$(8)="TOUS":oac$(8)="N":cbkc$(8)="9T":dvc$(8)="00":mecc$(8)="000":mefc$(8)="000":mtc$(8)="0"

cdc$(9)="MUT":libc$(9)="Remboursement MUTUELLE":mrc$(9)="VI":opc$(9)="+":famc$(9)="SANTE:":catc$(9)="SANTE: Remboursement":desc$(9)="MUTUELLE"
utilc$(9)="TOUS":oac$(9)="N":cbkc$(9)="9T":dvc$(9)="00":mecc$(9)="000":mefc$(9)="000":mtc$(9)="0"

cdc$(10)="PHA":libc$(10)="Achats en PHARMACIE":mrc$(10)="CB":opc$(10)="-":famc$(10)="SANTE:":catc$(10)="SANTE: Pharmacie":desc$(10)="PHARMACIE"
utilc$(10)="TOUS":oac$(10)="N":cbkc$(10)="9T":dvc$(10)="00":mecc$(10)="000":mefc$(10)="000":mtc$(10)="0"

cdc$(11)="RCH":libc$(11)="Remise de Chèque à la Banque":mrc$(11)="CH":opc$(11)="+":famc$(11)="REVENUS:":catc$(11)="REVENUS: Divers":desc$(11)=""
utilc$(11)="TOUS":oac$(11)="N":cbkc$(11)="9T":dvc$(11)="00":mecc$(11)="000":mefc$(11)="000":mtc$(11)="0"

cdc$(12)="VEB":libc$(12)="Remise d'Especes à la Banque":mrc$(12)="ES":opc$(12)="+":famc$(12)="REVENUS:":catc$(12)="REVENUS: Divers":desc$(12)=""
utilc$(12)="TOUS":oac$(12)="N":cbkc$(12)="9T":dvc$(12)="00":mecc$(12)="000":mefc$(12)="000":mtc$(12)="0"


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


fifam$(1)="fcabanqu.cfp"
fam$(1)="BANQUE:"
fifam$(2)="fcaassur.cfp"
fam$(2)="ASSURANCE:"
fifam$(3)="fcasante.cfp"
fam$(3)="SANTE:"
fifam$(4)="fcaconso.cfp"
fam$(4)="CONSOMATION:"
fifam$(5)="fcaimpot.cfp"
fam$(5)="IMPÔTS:"
fifam$(6)="fcareven.cfp"
fam$(6)="REVENUS:"
fifam$(7)="fcafonct.cfp"
fam$(7)="FONCTION:"
for n=8 to 20
fifam$(n)="":fam$(n)=""
next n
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



cat$(1)="BANQUE: Contrats"
cat$(2)="BANQUE: Intérêts Normaux en -"
cat$(3)="BANQUE: Perception d'intérêts +"
cat$(4)="BANQUE: Pénalités"
cat$(5)="BANQUE: Epargne"
cat$(6)="BANQUE: Déblocage prêt"
for n=7 to 15
cat$(n)=""
next n
file_open_write 1,"fcabanqu.cfp"
for n=1 to 15
file_writeln 1,cat$(n)
next n
file_close 1

cat$(1)="ASSURANCE: Divers"
cat$(2)="ASSURANCE: Groupés"
cat$(3)="ASSURANCE: Prêts"
cat$(4)="ASSURANCE: Vie"
for n=5 to 15
cat$(n)=""
next n
file_open_write 1,"fcaassur.cfp"
for n=1 to 15
file_writeln 1,cat$(n)
next n
file_close 1

cat$(1)="SANTE: Remboursement"
cat$(2)="SANTE: Pharmacie"
cat$(3)="SANTE: Laboratoire"
cat$(4)="SANTE: Hopital"
cat$(5)="SANTE: Médecin"
cat$(6)="SANTE: Prothéses (lunette, ...)"
for n=7 to 15
cat$(n)=""
next n
file_open_write 1,"fcasante.cfp"
for n=1 to 15
file_writeln 1,cat$(n)
next n
file_close 1

cat$(1)="CONSOMATION: Divers"
for n=2 to 15
cat$(n)=""
next n
file_open_write 1,"fcaconso.cfp"
for n=1 to 15
file_writeln 1,cat$(n)
next n
file_close 1

cat$(1)="IMPÔTS: Divers"
cat$(2)="IMPÔTS: sur le revenu"
cat$(3)="IMPÔTS: Fonciers"
cat$(4)="IMPÔTS: Locaux"
for n=5 to 15
cat$(n)=""
next n
file_open_write 1,"fcaimpot.cfp"
for n=1 to 15
file_writeln 1,cat$(n)
next n
file_close 1

cat$(1)="REVENUS: Divers"
cat$(2)="REVENUS: Salaire"
for n=3 to 15
cat$(n)=""
next n
file_open_write 1,"fcareven.cfp"
for n=1 to 15
file_writeln 1,cat$(n)
next n
file_close 1

cat$(1)="FONCTION: Divers"
cat$(2)="FONCTION: Chèque annulé"
cat$(3)="FONCTION: Régularisation"
cat$(4)="FONCTION: Report"
cat$(5)="FONCTION: Neutre"
for n=6 to 15
cat$(n)=""
next n
file_open_write 1,"fcafonct.cfp"
for n=1 to 15
file_writeln 1,cat$(n)
next n
file_close 1


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


for n=2 to 10
util$(n)=""
mdp$(n)="BONJOUR"
grad$(n)=""
next n
util$(1)="ADMIN"
mdp$(1)="ADMIN"
grad$(1)="ADMINISTRATEUR"

file_open_write 1,"utilisateur.cfp"
for n=1 to 10
file_writeln 1,util$(n)
file_writeln 1,mdp$(n)
file_writeln 1,grad$(n)
next n
file_close 1
terminate


Dernière édition par Jean Claude le Lun 21 Sep 2009 - 18:25, édité 1 fois
Revenir en haut Aller en bas
Jean Claude

Jean Claude


Nombre de messages : 5950
Age : 69
Localisation : 83 Var
Date d'inscription : 07/05/2009

CFP les codes Empty
MessageSujet: Re: CFP les codes   CFP les codes EmptyMar 15 Sep 2009 - 19:15

le 2eme cfpacces permet de démarrer le programme. Un conseil, créer une icone sur le bureau.
Pour pouvoir vous servir du logiciel, au premier lancement vous utiliserez ADMIN comme Utilisateur et comme Mot de Passe (Minuscules ou Majuscules, pas d'importance).

Code:

rem cfpacces

label controlmdp,saisimdp,saisiutil,quit,controlutil,verifutil,sauvetf,nouveau

dim util$(10),mdp$(10),grad$(10)
dim utilp$,mdpp$,echec$,motutil$,nomutil$,gradutil$,proga$
dim nt,n,nu

left 0,223:top 0,182:width 0,550:height 0,492
caption 0,"COMPTE FAMILIALE  *  Accès"
 
alpha 1:left 1,80:top 1,19:width 1,305
caption 1,"ENTREZ VOTRE IDENTIFIANT ET VOTRE MOT DE PASSE "

alpha 2:left 2,215:top 2,82
caption 2,"Identifiant"

alpha 3:left 3,215:top 3,190
caption 3,"Mot De Passe"

edit 4:left 4,205:top 4,113
hint 4,"ENTREZ VOTRE IDENTIFIANT"
on_change 4, saisiutil

edit 5:left 5,205:top 5,230
hint 5,"ENTREZ VOTRE MOT DE PASSE"
font_color 5,255,255,255
on_change 5, saisimdp
inactive 5

button 6:left 6,345:top 6,113
caption 6,"OK"
on_click 6,controlutil

button 7:left 7,347:top 7,228
caption 7,"OK"
on_click 7,controlmdp
inactive 7

button 8:left 8,27:top 8,391
caption 8,"QUITTER"
on_click 8,quit

font_name 0,"Fixedsys"
2d_fill_color 240,235,235
2d_rectangle 10,10,530,50

set_focus 4

end
rem -----------------------------------------------------------------
saisimdp:
mdpp$=upper$(text$(5))
nt=scancode
if nt<>13 then return
controlmdp:
if len(mdpp$)<2 then beep :message "Vous Devez Saisir 2 Caractères Minimum":return
if motutil$=mdpp$ then gosub sauvetf: execute cfpmenug.exe:goto quit
message "Mot de passe: FAUX":terminate
return

saisiutil:
utilp$=upper$(text$(4))
nt=scancode
if nt<>13 then return
controlutil:
if len(utilp$)<3 then beep :message "Vous Devez Saisir 3 Caractères Minimum":return
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
gosub verifutil:if echec$="o" then terminate
if motutil$="BONJOUR" then gosub nouveau:goto quit
print_locate 30,235:print utilp$
active 7:active 5
hide 4: hide 6:hide 2
set_focus 5
return

verifutil:
echec$=""
for n=1 to 10
if util$(n)="" then echec$="o":message " "+utilp$+" vous n'ete pas enregistrer. Demandez à l'administrateur de créer votre Compte Utilisateur.":return
if utilp$=util$(n) then echec$="n":motutil$=mdp$(n):nomutil$=utilp$:gradutil$=grad$(n):return
next n

nouveau:
message " "+utilp$+" vous devez changez votre Mot de Passe Maintenant"
motutil$="":nomutil$=utilp$:gradutil$=grad$(n)
gosub sauvetf
execute cfpnovmo.exe
goto quit
return

sauvetf:
nu=n
file_open_write 1,"cfptf01.cfp"
file_writeln 1,proga$
file_writeln 1,nu
file_writeln 1,nomutil$
file_writeln 1,motutil$
file_writeln 1,gradutil$
file_close 1
return

quit:
terminate
Revenir en haut Aller en bas
Jean Claude

Jean Claude


Nombre de messages : 5950
Age : 69
Localisation : 83 Var
Date d'inscription : 07/05/2009

CFP les codes Empty
MessageSujet: Re: CFP les codes   CFP les codes EmptyMar 15 Sep 2009 - 20:01

le 3ème, c'est le menu général.
Avant de continuer, pour démarrer vous devrez aller directement dans la gestion des utilisateurs pour supprimer ADMIN et mettre votre nom ou pseudo.

Code:
rem cfpmenug

label util,quit,sauvetf,dest,changemot,videtf,compte,fam,cat,gcod,enreg
label fin,gchq,rlv

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

left 0,223
top 0,182
width 0,441
height 0,492
caption 0,"COMPTE FAMILIALE * Menu Général"
font_name 0,"impact"
font_size 0,9

button 1
left 1,20
top 1,21
width 1,150
caption 1,"Enregistrer  une  Opération"
on_click 1,enreg

button 2
left 2,21
top 2,67
width 2,150
caption 2,"Pointer un Relevé de  Compte"
on_click 2,rlv

button 3
left 3,21
top 3,121
width 3,150
caption 3,"Button 3"

button 4
left 4,21
top 4,172
width 4,150
caption 4,"Button 4"

button 5
left 5,21
top 5,219
width 5,150
caption 5,"Gestion  des  Chèques"
on_click 5,gchq

button 6
left 6,21
top 6,269
width 6,150
caption 6,"Gestion  des  Codes"
on_click 6,gcod

button 7
left 7,250
top 7,21
width 7,150
caption 7,"Gestion  des  Utilisateurs"
on_click 7,util

button 8
left 8,250
top 8,69
width 8,150
caption 8,"Gestion  des  Destinataires"
on_click 8,dest

button 9
left 9,245
top 9,119
width 9,158
caption 9,"Gestion Familles de Catégories"
on_click 9,fam

button 10
left 10,250
top 10,173
width 10,150
caption 10,"Gestion  des  Catégories"
on_click 10,cat

button 11
left 11,250
top 11,219
width 11,150
caption 11,"Gestion  des  Comptes"
on_click 11,compte

button 12
left 12,250
top 12,270
width 12,150
caption 12,"Changer mon Mot De Passe"
on_click 12,changemot

alpha 13
left 13,136
top 13,366
width 13,177
height 13,14

button 14
left 14,150
top 14,410
width 14,100
caption 14,"QUITTER"
on_click 14,quit

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

proga$="cfpmenug"

2d_fill_color 240,235,235
2d_rectangle 50,360,370,390
caption 13,"CLIQUEZ    SUR    L ' ACTION    CHOISIE"

end
rem -------------------------------------------------------------
rlv:
proga$="cfpprlv.exe"
gosub sauvetf
execute "cfpsceop.exe"
goto fin
return

enreg:
if gradutil$="INACTIF" then message " "+nomutil$+": Vous n'êtes pas autorisé à enregister de nouvelles Opération ":return
gosub sauvetf
execute "cfpsceop.exe"
goto fin
return

gchq:
gosub sauvetf
execute cfpgchq.exe
goto fin
return

gcod:
gosub sauvetf
execute cfpgcod.exe
goto fin
return

cat:
gosub sauvetf
execute cfpgcat.exe
goto fin
return

fam:
gosub sauvetf
execute cfpgfca.exe
goto fin
return

compte:
gosub sauvetf
execute cfpgcomp.exe
goto fin
return

util:
if gradutil$<>"ADMINISTRATEUR" then message " "+nomutil$+": Cette Option est réservée à l'Administrateur":return
execute cfpgutil.exe
goto fin
return


dest:
gosub sauvetf
execute cfpgdest.exe
goto fin
return


changemot:
execute cfpchamo.exe
goto fin
return


quit:
gosub videtf
gosub sauvetf
goto fin
return

videtf:
proga$=""
nu=0:nomutil$="":motutil$="":gradutil$=""
return

sauvetf:
file_open_write 1,"cfptf01.cfp"
file_writeln 1, proga$
file_writeln 1,nu
file_writeln 1,nomutil$
file_writeln 1,motutil$
file_writeln 1,gradutil$
file_close 1
return

fin:
terminate
Revenir en haut Aller en bas
Jean Claude

Jean Claude


Nombre de messages : 5950
Age : 69
Localisation : 83 Var
Date d'inscription : 07/05/2009

CFP les codes Empty
MessageSujet: Re: CFP les codes   CFP les codes EmptyMar 15 Sep 2009 - 20:07

Le 4ème cfpgutil, réservé à l'administrateur, cette partie gère les utilisateurs, il y a une rubrique d'aide que je vous conseille de lire

Code:

rem cfpgutil

label quit,demar,aide,selection,lignesup,supprim,supprime,enregistre
label nouveau,ajoute,doublon,tri,insert,modifgrad

dim util$(10),mdp$(10),grad$(10)
dim utilt$(10),mdpt$(10),gradt$(10)
dim utilsel$,ligsup$,utilp$,doublon$,echec$,gradp$,nu$,fi$
dim n,nu,t,lv,ng,fe

left 0,50:top 0,50:width 0,587:height 0,537
caption 0,"COMPTE FAMILIALE *  Gestion Des Utilisateurs *"
on_click 0,selection

alpha 1
left 1,93:top 1,34:width 1,113
caption 1," Liste Des Utilisateurs"

list 2
left 2,61:top 2,61:width 2,170:height 2,149
on_click 2,selection

button 3
left 3,108:top 3,377
caption 3,"Ajouter "
inactive 3
on_click 3,ajoute

button 4
left 4,110:top 4,231
caption 4,"Supprimer"
on_click 4,supprim
inactive 4

edit 5
left 5,84:top 5,346
inactive 5
on_change 5,nouveau

alpha 6
left 6,113:top 6,319
caption 6,"  Nouveau"
inactive 6


button 8
left 8,421:top 8,377
caption 8,"Quitter"
on_click 8, quit

memo 9
left 9,261:top 9,61:width 9,110:height 9,149
font_color 9,0,0,255

alpha 10
left 10,270:top 10,35
caption 10,"    Statut"

combo 12
left 12,400:top 12,61
item_add 12,""
item_add 12,"ADMINISTRATEUR"
item_add 12,"ACTIF"
item_add 12,"INACTIF"
inactive 12
on_click 12,modifgrad
alpha 13
left 13,420:top 13,39:width 13,127
caption 13,"Changer le Statut"
inactive 13

button 15
left 15,4:top 15,3:width 15,41
caption 15,"AIDE"
on_click 15,aide

form 16
left 16,650:top 16,50:width 16,587:height 16,537
caption 16,"Gestion Des Utilisateurs * Aide *"
hide 16
color 16,255,255,255
font_color 16,0,0,255

button 17
left 17,70:top 17,231:width 17,150
caption 17,"Confirmer la Suppression"
on_click 17,supprime
hide 17


rem -------------------------------------------------------------------
gosub demar

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

modifgrad:
gosub selection
ng=item_index(12)
gradp$=item_read$(12,ng)
if gradp$="" then message "Attention: la ligne est vide": return
item_insert 9,nu,gradp$
grad$(nu)=gradp$
gosub quit
return

Ajoute:
gosub doublon
inactive 5:inactive 6:inactive 3
item_insert 2,nu,utilp$
item_delete 2,11
if doublon$="o" then utilp$="":item_delete 2,nu:util$(nu)="":message "Cet utilisateur existe déja":text 5,"":return
if doublon$="" then util$(nu)=utilp$
show 12
mdp$(nu)="BONJOUR":text 5,""
gosub enregistre
return

rem
doublon:
doublon$=""
for n=1 to 10
if util$(n)=utilp$ and n<>nu then doublon$="o":return
next n
return

nouveau:
utilp$=upper$(text$(5))
if len(utilp$)<3 then return
if len(utilp$)>20 then message "20 Caractères Maximum":return
active 3
return

supprime:
item_delete 2,nu:util$(nu)="":item_delete 9,nu:grad$(nu)="":mdp$(nu)=""
hide 17
nu$=str$(nu)
fi$="cfplc" + nu$ + ".cfp": rem fi$ est le fichier des comptes
fe=file_exists (fi$)
if fe=1 then file_delete fi$
gosub enregistre
return

supprim:
inactive 4
message "RAPPEL: supprimer un utilisateur provoque l'éffacement de tous les fichiers le concernant "
show 17
return

selection:
hide 17:inactive 12:inactive 13
utilsel$=item_index$(2):nu=item_index(2):active 4
print_locate 30,50:print "  ":print_locate 30,50:print nu
if nu=1 and utilsel$="" then inactive 4:active 5:active 6:return
if utilsel$="" then gosub lignesup:inactive 4:inactive 12:return
inactive 5:inactive 6:active 12:active 13
return

rem pour eviter un blanc entre 2 lignes
lignesup:
n=nu-1:if n<1 then return
ligsup$=item_read$(2,n)
if ligsup$ = "" and n<9 then inactive 5:inactive 6:inactive 12:return
active 5:active 6:set_focus 5
return

aide:
show 16
print_target_is 16
print_locate 10,20
print " - Pour Ajouter un nouvel utilisateur sélectionner un champ vide dans le champ 'Liste des utilisateurs', inscrivez son nom "
print "  dans le champs 'Nouveau' et cliquez sur Ajouter. Remarque: le nom de l'utilisateur ne sera plus modifiable "
print_locate 10,70
print " - Pour Supprimer un utilisateur sélectionnez son nom dans le champ 'Liste des utilisateurs' et cliquez sur Supprimer"
print_locate 30,90
print "Remarque: supprimer un utilisateur provoque l'éffacement de tous les fichiers le concernant "
print_locate 30,110
print "Il est préférable de modifier son statut"
print_locate 10,150
print " - Pour Modifier le Statut d'un utilisateur sélectionnez son nom dans le champ 'Liste des utilisateurs', séléctionnez"
print "  le Statut souhaité dans le champ 'Changer le Statut' "
print_locate 30,200
print "Remarque: le Statut Inactif autorise seulement l'utilisateur concerné de visualiser"
print_locate 30,220
print "                  le Statut Administrateur autorise la gestion des Utilisateurs, sauf leur mot de passe "
print_locate 10,260
print "  A noter: si vous Ajoutez un nouvel utilisateur, il sera directement dirigé vers la création de son Mot de Passe"
print_locate 10,280
print_target_is 0
return

demar:
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)
item_add 2,util$(n)
item_add 9,grad$(n)
next n
file_close 1
return

enregistre:
echec$=""
gosub tri
file_open_write 1,"utilisateur.cfp"
for n=1 to 10
file_writeln 1,util$(n)
file_writeln 1,mdp$(n)
file_writeln 1,grad$(n)
next n
file_close 1
return

tri:
t=0:lv=0
for n=1 to 10
 if util$(n)<>"" then gosub insert
 if util$(n)="" then lv=lv+1
next n
for n=1 to 10
util$(n)=utilt$(n)
mdp$(n)=mdpt$(n)
grad$(n)=gradt$(n)
if grad$(n)="" and util$(n)<>"" then echec$="o": message "Vous devez attribuer un Statut à "+util$(n):return
next n
n=10-(lv-1)
util$(n)="":mdp$(n)="":grad$(n)=""
return
insert:
t=t+1
utilt$(t)=util$(n)
mdpt$(t)=mdp$(n)
gradt$(t)=grad$(n)
return

quit:
gosub enregistre
if echec$="o" then return
terminate

Revenir en haut Aller en bas
Jean Claude

Jean Claude


Nombre de messages : 5950
Age : 69
Localisation : 83 Var
Date d'inscription : 07/05/2009

CFP les codes Empty
MessageSujet: Re: CFP les codes   CFP les codes EmptyMar 15 Sep 2009 - 20:11

Le 5ème, cfpgcomp, Menu pour gèrer les Comptes.

Code:
rem cfpgcomp

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 Comptes *"
 
button 1
left 1,30
top 1,30
width 1,218
caption 1,"Créer un nouveau Compte"
on_click 1,creation

button 2
left 2,30
top 2,80
width 2,218
caption 2,"Modifier un Compte"
on_click 2,modification

button 3
left 3,30
top 3,130
width 3,218
caption 3,"Cloturer un Compte"
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 cfpmocpt.exe
terminate
return

suppression:
execute cfpclcpt.exe
terminate
return

creation:
execute cfpcrcpt.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
Revenir en haut Aller en bas
Jean Claude

Jean Claude


Nombre de messages : 5950
Age : 69
Localisation : 83 Var
Date d'inscription : 07/05/2009

CFP les codes Empty
MessageSujet: Re: CFP les codes   CFP les codes EmptyMar 15 Sep 2009 - 20:17

Le 6ème, cfpnovmo, est destiné à un nouvel Utilisateur pour créer son mot de passe. (lire la rubrique d'aide)

Code:
rem cfpnovmo

label abandon,chargetf,sauvetf,aide,novmot,verifmop,confirm,verifmoc
label chargeutil,sauveutil

dim a$
dim nomutil$,motutil$,gradutil$,mdpp$,mdpc$,proga$
dim util$(10),mdp$(10),grad$(10)
dim nt,nu,n

left 0,150
top 0,150
width 0,455
height 0,208
caption 0,"COMPTE FAMILIALE  *  Création de votre Mot De Passe *"
 
button 1
left 1,370
top 1,10
width 1,20
height 1,20
caption 1,"?"
on_click 1,aide

edit 2
left 2,219
top 2,53
font_color 2,255,255,255
on_change 2,novmot

edit 3
left 3,219
top 3,90
hide 3
font_color 3,255,255,255
on_change 3,confirm

button 4
left 4,20
top 4,135
caption 4,"Abandon"
on_click 4,abandon

button 5
left 5,246
top 5,136
caption 5,"Enregisrer"
on_click 5,verifmoc
hide 5

alpha 6
left 6,90
top 6,56
width 6,81
caption 6," Saisir un Mot de Passe =>"

alpha 7
left 7,138
top 7,92
width 7,74
caption 7,"Confirmation =>"
hide 7

button 8
left 8,346
top 8,53
width 8,29
caption 8,"OK"
on_click 8,verifmop
hide 8

form 9
left 9,650:top 9,150:width 9,400:height 9,210
caption 9,"Gestion Des Utilisateurs * Aide *"
hide 9
color 9,255,255,255
font_color 9,0,0,255

gosub chargetf
print_locate 15,15
print " BONJOUR "+nomutil$+" ."
set_focus 2
end
rem ---------------------------------------------------------------------------
aide:
show 9
print_target_is 9
print_locate 10,40
print " Vous pouvez utiliser tout les caractères du clavier"
print_locate 10,60
print " Vous pouvez utiliser Minuscules ou Majuscules"
print_locate 10,80
print " Après enregistrement, il faudra relancer le programme"
print_target_is 0
return

novmot:
hide 9
mdpp$=upper$(text$(2))
show 8
if len(mdpp$)>10 then gosub verifmop
return

verifmop:
if len(mdpp$)<3 then message "3 caractères Minimum":mdpp$="":text 2,"":return
if len(mdpp$)>10 then message "10 caractères Maximum":mdpp$="":text 2,"":return
show 7:show 3:inactive 8
set_focus 3
return

confirm:
mdpc$=upper$(text$(3))
show 5
if len(mdpc$)>10 then gosub verifmoc
return

verifmoc:
if len(mdpc$)<3 then message "3 caractères Minimum":mdpc$="":text 3,"":return
if len(mdpc$)>10 then message "10 caractères Maximum":mdpc$="":text 3,"" :return
if mdpp$<>mdpc$ then message " ERREUR: vos 2 Mots de Passe ne sont pas identiques":gosub abandon:return
if mdpp$=mdpc$ then message " Votre Nouveau Mots de Passe est enregistré * Vous devez relancer le programme pour continuer"
gosub chargeutil
util$(nu)=nomutil$:mdp$(nu)=mdpp$:grad$(nu)=gradutil$
gosub sauveutil
gosub abandon
return

rem ---------------------------------------------------------------------------
sauvetf:
nomutil$="":motutil$="":gradutil$=""
file_open_write 1,"cfptf01.cfp"
file_writeln 1, proga$
file_writeln 1,nu
file_writeln 1,nomutil$
file_writeln 1,motutil$
file_writeln 1,gradutil$
file_close 1
return

chargetf:
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

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

sauveutil:
file_open_write 1,"utilisateur.cfp"
for n=1 to 10
file_writeln 1,util$(n)
file_writeln 1,mdp$(n)
file_writeln 1,grad$(n)
next n
file_close 1
return

abandon:
gosub sauvetf
terminate
Revenir en haut Aller en bas
Jean Claude

Jean Claude


Nombre de messages : 5950
Age : 69
Localisation : 83 Var
Date d'inscription : 07/05/2009

CFP les codes Empty
MessageSujet: Re: CFP les codes   CFP les codes EmptyMar 15 Sep 2009 - 20:22

Le 7ème, cfpchamo, pour que n'importe quel utilisateur puisse changer son Mot de Passe.
A ce sujet JL35 a écrit un prog de crypatge qui pourrait servir a ce code.

Code:
rem cfpchamo

label abandon,aide,chargetf,ancien,verifmop,control,chargeutil,sauveutil
label novmot,verifnovmot,confirm,enreg,sortie,quit

dim nomutil$,motutil$,gradutil$,mdpp$,mdpc$,nmdp$,proga$
dim util$(10),mdp$(10),grad$(10)
dim nu,n


left 0,223
top 0,182
width 0,428
height 0,223
caption 0,"COMPTE FAMILIALE * Changement du mot de passe *"
 
button 1
left 1,15
top 1,10
width 1,22
caption 1,"?"
on_click 1,aide

alpha 2
left 2,40
top 2,60
width 2,122
caption 2,"Ancien Mot De Passe  =>"

edit 3
left 3,169
top 3,57
font_color 3,255,255,255
on_change 3,ancien

button 4
left 4,305
top 4,55
width 4,24
caption 4,"OK"
on_click 4,verifmop
hide 4

alpha 5
left 5,32
top 5,99
width 5,129
caption 5,"Nouveau Mot De Passe =>"
hide 5

edit 6
left 6,169
top 6,96
hide 6
font_color 6,255,255,255
on_change 6,novmot

button 7
left 7,305
top 7,93
width 7,24
caption 7,"OK"
on_click 7,verifnovmot
hide 7

alpha 8
left 8,88
top 8,138
width 8,73
caption 8,"Confirmation =>"
hide 8

edit 9
left 9,169
top 9,137
hide 9
font_color 9,255,255,255
on_change 9,confirm

button 10
left 10,305
top 10,137
width 10,81
caption 10,"Enregistrer"
hide 10
on_click 10,enreg

button 11
left 11,54
top 11,10
caption 11,"Abandon"
on_click 11,abandon

form 12
left 12,660:top 12,182:width 12,400:height 12,223
caption 12,"Gestion Des Utilisateurs * Aide *"
hide 12
color 12,255,255,255
font_color 12,0,0,255

gosub chargetf
print_locate 165,15
print " BONJOUR "+nomutil$
set_focus 3
end
rem ---------------------------------------------------------------------------
aide:
show 12
print_target_is 12
print_locate 10,40
print " Vous pouvez utiliser tout les caractères du clavier"
print_locate 10,60
print " Vous pouvez utiliser Minuscules ou Majuscules"
print_locate 10,80
print " Après confirmation vous serez redirigé vers le Menu Général"
print_target_is 0
return

confirm:
nmdp$=upper$(text$(9))
if len(nmdp$)>10 then gosub enreg
return

enreg:
if len(nmdp$)<3 then message "3 caractères Minimum":nmdp$="":text 9,"":return
if len(nmdp$)>10 then message "10 caractères Maximum":nmdp$="":text 9,"":return
if nmdp$<>mdpc$ then message " ERREUR: Recommencez ":execute cfpchamo.exe:goto quit
if nmdp$=mdpc$ then message "Retenez votre nouveau Mot De Passe":gosub sortie:return
return

novmot:
inactive 2:show 7
mdpc$=upper$(text$(6))
if len(mdpc$)>10 then gosub verifnovmot
return

verifnovmot:
if len(mdpc$)<3 then message "3 caractères Minimum":mdpc$="":text 6,"":return
if len(mdpc$)>10 then message "10 caractères Maximum":mdpc$="":text 6,"":return
if mdpc$=mdpp$ then message " REFUS: votre nouveau mot de passe est identique à l'ancien":mdpc$="":text 6,"":return
show 8:show 9:show 10:inactive 5:inactive 7
set_focus 9
return

ancien:
hide 12
mdpp$=upper$(text$(3))
show 4
if len(mdpp$)>10 then gosub verifmop
return

verifmop:
if len(mdpp$)<3 then message "3 caractères Minimum":mdpp$="":text 3,"":return
if len(mdpp$)>10 then message "10 caractères Maximum":mdpp$="":text 3,"":return
gosub control
show 5:show 6:hide 4:hide 3
set_focus 6
return

control:
gosub chargeutil
if mdpp$<>mdp$(nu) then message " ERREUR: Mots de Passe Incorect":gosub abandon:return
return

sortie:
mdp$(nu)=nmdp$
gosub sauveutil
abandon:
execute cfpmenug.exe
goto quit
return

rem ---------------------------------------------------------------------------
chargetf:
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

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

sauveutil:
file_open_write 1,"utilisateur.cfp"
for n=1 to 10
file_writeln 1,util$(n)
file_writeln 1,mdp$(n)
file_writeln 1,grad$(n)
next n
file_close 1
return

quit:
terminate
Revenir en haut Aller en bas
Jean Claude

Jean Claude


Nombre de messages : 5950
Age : 69
Localisation : 83 Var
Date d'inscription : 07/05/2009

CFP les codes Empty
MessageSujet: Re: CFP les codes   CFP les codes EmptyMar 15 Sep 2009 - 20:28

Le 8ème, cfpclcpt, pour cloturer un compte
La rubrique d'aide n'est pas faite

Code:
rem cfpclcpt

label quit,aide,tf,chcptutil,addlist,sel,typclot,conf,pra,eface,enreg
label chargeliste,sauveliste

dim n,nu,fe,a,nc
dim nu$,fi$,a$,ty$,nc$
dim proga$,nomutil$,motutil$,gradutil$
dim cpt$(9),lcpt$(9),fec$(9),rec$(9),sldcpt$(9)

left 0,200
top 0,100
width 0,483
height 0,292
caption 0,"COMPTE FAMILIALE *  Clôture d'un Compte *"
 
list 1
left 1,21
top 1,62
width 1,211
height 1,150
on_click 1,sel

alpha 2
left 2,273
top 2,40
width 2,78
caption 2,"Type de Cloture"
inactive 2

combo 3
left 3,242
top 3,64
item_add 3,"CLOTURE PARTIELLE"
item_add 3,"CLOTURE DEFINITIVE"
on_click 3,typclot
inactive 3

button 4
left 4,280
top 4,150
caption 4,"Confirmation"
inactive 4
on_click 4,conf

button 5
left 5,280
top 5,191
caption 5,"Abandon"
on_click 5,quit

button 6
left 6,391
top 6,18
width 6,20
height 6,20
caption 6,"?"
on_click 6,aide

alpha 7
left 7,65
top 7,40
width 7,112
caption 7,"Sélection du Compte"

button 8
left 8,280
top 8,150
caption 8,"CLOTURE"
on_click 8,enreg
hide 8

gosub tf:gosub chcptutil:gosub addlist

end
rem -------------------------------------------------------------------------
aide:
terminate
return

conf:
hide 4:hide 7:hide 1: cls
if a$="CLOTURE PARTIELLE" then rec$(nc)="CLO"+rec$(nc)
if a$="CLOTURE DEFINITIVE" then goto eface
return

eface:
cpt$(nc)="":lcpt$(nc)="":fec$(nc)="":rec$(nc)="":sldcpt$(nc)=""
message "Programe pas terminé, Mais vous pouvez supprimer en définitif ou cliquer sur Abandon":show 8
return

enreg:
gosub sauveliste:goto quit
return

typclot:
hide 3:hide 2
active 4
print_locate 10,10:print "                                                      "
a$=item_index$(3)
if a$="CLOTURE PARTIELLE" then message "Si vous souhaitez réellement clôturer le Compe "+lcpt$(nc)+" partiellement, cliquez sur confirmation":goto pra
if a$="CLOTURE DEFINITIVE" then message "Si vous souhaitez réellement clôturer le Compe "+lcpt$(nc)+" définitivement, cliquez sur confirmation":goto pra
pra:
print_locate 250,70:print a$+" de"
print_locate 250,90:print lcpt$(nc)
return

sel:
nc= item_index (1)
if cpt$(nc)="" then message "Sélection Vide":return
print_locate 10,10:print "Le Compte à clôturer est: "+lcpt$(nc)
active 2:active 3
return

addlist:
for n=1 to 8
item_add 1,cpt$(n)+" "+lcpt$(n)
next n
return

chcptutil:
nu$=str$(nu)
fi$="cfplc" + nu$ + ".cfp"
fe=file_exists (fi$)
if fe=0 then message "il n'y a pas de Compte":terminate
if fe=1 then gosub chargeliste:return
return

rem -------------------------------------------------------------------------
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

sauveliste:
file_open_write 1,fi$
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

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,240:print "UTILISATEUR: "+nomutil$
print_locate 400,240:print date$
return

rem ---------------------------------------------------------------------------
quit:
execute cfpgcomp.exe
terminate
Revenir en haut Aller en bas
Jean Claude

Jean Claude


Nombre de messages : 5950
Age : 69
Localisation : 83 Var
Date d'inscription : 07/05/2009

CFP les codes Empty
MessageSujet: Re: CFP les codes   CFP les codes EmptyMar 15 Sep 2009 - 20:34

le 9ème, cfpcodsa, il s'agit d'un code assisté pour le salaire
il y a une rubrique d'aide.

Code:
rem cfpcodsa

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 (SALAIRE) *"
 
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,"SA"
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,"SALAIRE 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,"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
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,"REVENUS:"
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,"REVENUS: Salaire"
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
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)="REVENUS:":catc$(nc)="REVENUS: Salaire":mecc$(nc)="0":mefc$(nc)="0"
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
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)
libc$(nc)=libc$(nc)+utilc$(nc)+" => "+desc$(nc)
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)=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)
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$
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$<>"SA" then message "Un code pour Salaire doit commencer par SA":text 5,"SA":return
if len(a$)<3 then message "Ajoutez un chiffre après SA":text 5,"SA":return
gosub doublon
if a$="" then text 5,"SA":return
cdc$(nc)=a$
a$=text$(8):libc$(nc)=a$
gosub afi3
inactive 4:inactive 5:hide 6:active 10:active 14:active 36: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 de la catégorie et du destinataire 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


Dernière édition par Jean Claude le Sam 19 Sep 2009 - 11:50, édité 1 fois
Revenir en haut Aller en bas
Jean Claude

Jean Claude


Nombre de messages : 5950
Age : 69
Localisation : 83 Var
Date d'inscription : 07/05/2009

CFP les codes Empty
MessageSujet: Re: CFP les codes   CFP les codes EmptyMar 15 Sep 2009 - 20:38

Le 10ème, cfpcrcat, pour créer une nouvelle catégorie

Code:
rem cfpcrcat

label quit,aide,tf,addlist,fin,selfam,rpcv,cont,aj,ajou,enreg,cnb
label sauvefam,chargefam,chargecat,sauvecat

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

left 0,80
top 0,180
width 0,700
height 0,492
caption 0,"COMTE FAMILIALE * Création d'une Catégorie *"
 
button 1
left 1,560
top 1,9
width 1,20
height 1,20
caption 1,"?"
on_click 1,aide

button 2
left 2,20
top 2,380
width 2,90
caption 2,"Retour au Menu"
on_click 2,quit

alpha 3
left 3,57
top 3,24
caption 3,"Liste des Familles"

list 4
left 4,20
top 4,50
width 4,170
height 4,270
on_click 4,selfam

alpha 5
left 5,255
top 5,24
caption 5,"Liste des Catégories"

list 6
left 6,217
top 6,50
width 6,190
height 6,270

alpha 7
left 7,420
top 7,80
hide 7

edit 8
left 8,430
top 8,110
hide 8
on_change 8,aj

button 9
left 9,560
top 9,112
width 9,20
height 9,20
caption 9,"OK"
hide 9
on_click 9,ajou

button 10
left 10,457
top 10,160
caption 10,"Enregistrer"
hide 10
on_click 10,enreg

button 11
left 11,457
top 11,210
caption 11,"Continuer"
hide 11

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

gosub tf:gosub chargefam: gosub addlist:gosub aide

end
rem ----------------------------------------------------------------------------
aide:
show 12
print_target_is 12
print_locate 10,10:print "Pour Ajouter une Catégorie, vous devez commencer par sélectionner une Famille."
print_locate 10,30:print "Dans la Fenêtre [Liste des Catégories] vous visualisez les Categories existantes"
print_locate 10,50:print "Ajouter la nouvelle Catégorie dans le champ [Nouvelle Catégorie]"
print_locate 10,70:print "Validez la nouvelle Catégorie en cliquant sur le bouton [Enregistrer]"
print_locate 10,210:print "MISE EN GARDE: il est déconseillé de Supprimer une Catégorie, car vous ne"
print_locate 102,230:print "pourrez plus avoir les Statistiques correspondantes"
print_target_is 0
return

aj:
show 9:hide 12
a$=text$(8)
if len(a$)>21 then gosub ajou
return

ajou:
if len(a$)<3 then message "3 caractères Minimum":a$="":text 8,"":return
if len(a$)>21 then message "21 caractères Maximum":a$="":text 8,"":return
inactive 4
show 10:hide 9
return

enreg:
cat$(nc)=afam$+": "+a$
gosub sauvecat
execute cfpcrcat.exe
goto fin
return

selfam:
pas=pas+1:if pas >1 then clear 6
hide 12:show 7:show 8
n=item_index(4):nf=n
a$=item_index$(4)
if a$="" then message "Sélection Vide":return
l=len(fam$(n)):afam$=left$(fam$(n),l-1)
caption 7,"Nouvelle Catégorie de la Famille: "+afam$
fi$=fifam$(nf)
gosub chargecat
for n=1 to 15
item_add 6,cat$(n)
next n
gosub rpcv
nc=n
if nc>14 then message "Plus de place pour une nouvelle Catégorie":goto quit
inactive 6
gosub cnb
print_locate 202,50:print "  "
print_locate 202,50:print nb
set_focus 8
return

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

rpcv:
for n=1 to 20
if cat$(n)="" then return
next n
return

addlist:
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 4,afam$
afam$=""
next n
print_locate 7,50:print "  "
print_locate 7,50:print nf
return

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

sauvecat:
file_open_write 1,fi$
for n=1 to 15
file_writeln 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 cfpgcat.exe
fin:
terminate
Revenir en haut Aller en bas
Jean Claude

Jean Claude


Nombre de messages : 5950
Age : 69
Localisation : 83 Var
Date d'inscription : 07/05/2009

CFP les codes Empty
MessageSujet: Re: CFP les codes   CFP les codes EmptyMar 15 Sep 2009 - 20:43

le 11ème, cfpcrcod, pour créer des codes (pas automatiques) qui servirons à enregistrer vos opérations.

Code:
rem cfpcrcod

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


dim n,nc,nu,l,lt,ls,p,fe,a
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  *"
 
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
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
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,"-"
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
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,"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,250: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

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
set_focus 5
gosub afiun


end
rem ----------------------------------------------------------------------------
codepecial:
message "Code Spécial. Programme pas encore Disponible"
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:
gosub sauvecode
execute cfptrcod.exe
goto fin
return

re:
execute cfpcrcod.exe
goto fin
return

mef:
a$=text$(34)
gosub adollar
mefc$(nc)=a$
gosub afi15
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"
return

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

afi14:
gosub efen
print_locate 60,305:print "Saisissez le Numéro de la Mensualité Finale (Dans le cas d'un crédit de 48 mois c'est 48)."
print_locate 60,325:print "Il sera possible de le changer par la suite"
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 afi13
hide 30:inactive 29:active 31:active 32:set_focus 32
return

afi13:
gosub efen
print_locate 60,305:print "Saisissez le Numéro de la Mensualité en cours (Dans le cas d'un crédit)."
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

jv:
a$=text$(27)
a=val(a$)
if a<10 then a$="0"+a$
dvc$(nc)=a$
gosub afi12
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 25:active 26:active 27:set_focus 27
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 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)
gosub afi9
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)
gosub afi8
inactive 19:active 20:active 21:set_focus 21
fi$=fifam$(n):gosub chargecat
for n=1 to 15
item_add 21,cat$(n)
next n
return

afi8:
gosub efen
print_locate 60,305:print "Sélectionnez la Catégorie adaptée."
print_locate 60,325:print "Il sera possible de la changer par la suite"
return

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

afi7:
gosub efen
print_locate 60,305:print "Sélectionnez la Famille de Catégorie adaptée."
print_locate 60,325:print "Il sera possible de la changer par la suite"
return

oam:
gosub afi5
a$=text$(15)
if mrc$(nc)="CH" and a$="OUI" then message "il ne peut pas y avoir une OAM pour un Chèque":return
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: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:
gosub afi4
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 14: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)
mrc$(nc)=a$
inactive 11:active 12:active 13:set_focus 13
afi4:
gosub efen
print_locate 60,305:print "Choisissez l'Opérateur + ou -."
print_locate 60,325:print "+ crédite le Compte"
print_locate 60,345:print "- débite le Compte"
return

lib:
gosub afi2: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$
active 10:inactive 8:hide 9:active 11:set_focus 11
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,345:print "CB => Carte Bancaire"
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:
gosub afiun
a$=upper$(text$(5))
rem if asc(a$)<47 or asc(a$)>90 then message "Vous devez saisir une lettre pour les 2 premiers caractères.":text 5,"":return
if len(a$)>3 then message "3 caractères maximum":text 5,"":return
hide 2:active 6
return

verifcode:
if a$="" then message "1 caractères minimum":text 5,"":return
b$=left$(a$,2)
if b$="SA" then execute cfpcodsa.exe:goto fin
if b$="VI" then execute cfpcodvi.exe:goto fin
if a$="MS" then execute cfpcodms.exe:goto fin
if a$="MG" then execute cfpcodmg.exe:goto fin
if a$="VC" then gosub codepecial:terminate
gosub doublon
if a$="" then text 5,"":return
cdc$(nc)=a$
inactive 5:hide 6:active 7:active 36:active 8:set_focus 8
afi2:
gosub efen
print_locate 60,310:print "Entrez le Libellé du Code de 2 à 36 caractères."
print_locate 60,330:print "Majuscules, Minuscules, Espaces, Chiffres sont autorisés"
return

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

afiun:
gosub efen
print_locate 60,310:print "Entrez un Code de 1 à 3 caractères.Inspirez-vous des Codes intégrés ci-dessus (ex: ddc => Dépenses Diverses par Chèque)"
print_locate 60,330:print "Liste des Codes Spéciaux: SA => Salaire"
print_locate 60,350:print "                          MG et MS pour Médecin Généraliste ou Spécialiste"
print_locate 60,370:print "                          VI ou VC pour Virement de Compte à Compte"
print_locate 60,410:print "Liste des codes Intégrés: D / CHA / RG+ / RG- / RD / DDC / DDB / CPA / MUT / PHA / RCH / VEB"
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 un Code:"
print_locate 10,30:print "Un Code  est fait pour saisir une ligne d'Opération sans avoir à chaque fois l'obligation d'écrire la ligne d'opération entierement. Voici un exemple pour bien comprendre:"
print_locate 10,50:print "M. DUPONT fait ses courses le plus souvent au magasin SUPERMARCHE et il paie le plus souvent en Carte Bancaire."
print_locate 10,70:print "Nous allons donc créer un Code [S] pour SUPERMARCHE ou [SP] ou [SPM] . ([S] est plus rapide à saisir). Le but est de choisir un Code que l'on peut retenir facilement."
print_locate 10,90:print "On crée le Libellé du Code: [Achats à SUPERMARCHE]. On sélectionne [CB] comme Mode de Règlement, comme il s'agit d'une dépense on sélectionne [-] comme Opérateur."
print_locate 10,110:print "A chaque fois que vous saisirez le Code [S] dans l ' Enregistrement d'une Opération tous ces éléments (et bien d'autres) apparaitront automatiquement."
print_locate 10,130:print "Pensez à vérifier (avant de créer votre Code) l'existence de la catégorie et du destinataire car vous ne pourrez pas les créer dans cette section du programme."
print_locate 10,160:print "Avant de continuer, observez bien tout les éléments de la fenêtre ci-dessus. En particulier le cadre d'aide qui vous conseillera à chaque saisie."
print_locate 10,180:print "Pour visualiser ce cadre cliquez maintenant sur une ligne d'un code (n'importe lequel). Des informations apparaissent dans le cadre d'aide."
print_locate 10,220:print "Pour Démarrer Cliquez dans le champ CODE."
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 cfpgcod.exe
fin:
terminate


Dernière édition par Jean Claude le Sam 19 Sep 2009 - 17:45, édité 2 fois
Revenir en haut Aller en bas
Jean Claude

Jean Claude


Nombre de messages : 5950
Age : 69
Localisation : 83 Var
Date d'inscription : 07/05/2009

CFP les codes Empty
MessageSujet: Re: CFP les codes   CFP les codes EmptyMar 15 Sep 2009 - 20:49

J'arrête la pour ce soir, car il a un truc sur France 2 que je ne veus pas rater.
La plupart des codes que je vous ais founis ne pourrons fonctionner correctement que quand vous aurez tous. Mais vous pouvez tout de même les ouvrir.

A demain pour la suite.
Revenir en haut Aller en bas
JL35




Nombre de messages : 7095
Localisation : 77
Date d'inscription : 29/11/2007

CFP les codes Empty
MessageSujet: Re: CFP les codes   CFP les codes EmptyMar 15 Sep 2009 - 20:58

C'est... titanesque !
edit: pardon Jean Claude, je n'ai pas fait mon commentaire au bon endroit...
Revenir en haut Aller en bas
Jean Claude

Jean Claude


Nombre de messages : 5950
Age : 69
Localisation : 83 Var
Date d'inscription : 07/05/2009

CFP les codes Empty
MessageSujet: Re: CFP les codes   CFP les codes EmptyMer 16 Sep 2009 - 8:00

JL35 tu as un Blame. La prochaine fois c'est une lettre recommandée.

le 11ème, cfpcrcpt, pour créer les comptes.

Code:

rem cfpcrcpt

label quit,aide,tf,rpcv,rp,type,libcpt,verifa,nrlv,verifb,verifc,sadc,validation
label chcptutil,creliste,sauveliste,chargeliste,enreg,fec,moav,anav,an,mo
label fin

dim n,nu,fe,a,nc
dim nu$,fi$,a$,ty$,nc$,an$,mo$
dim proga$,nomutil$,motutil$,gradutil$
dim cpt$(9),lcpt$(9),fec$(9),rec$(9),sldcpt$(9)

left 0,296
top 0,189
width 0,389
height 0,528
caption 0,"COMPTE FAMILIALE * Création d'un Compte  *"
 
button 1
left 1,306
top 1,12
width 1,25
caption 1,"?"
on_click 1,aide

combo 2
left 2,30
top 2,60
item_add 2,""
item_add 2,"COURRANT"
item_add 2,"EPARGNE"
item_add 2,"DEBIT DIFFERE"
on_click 2,type

alpha 3
left 3,29
top 3,31
width 3,141
caption 3,"Type de Compte:"

alpha 4
left 4,30
top 4,118
width 4,154
caption 4,"Nom du Compte:"
inactive 4

edit 5
left 5,31
top 5,150
width 5,144
inactive 5
on_change 5,libcpt

alpha 6
left 6,30
top 6,207
width 6,125
caption 6,"Numéro du dernier relevé :"
inactive 6

edit 7
left 7,31
top 7,240
width 7,46
inactive 7
on_change 7,nrlv

alpha 8
left 8,30
top 8,301
width 8,153
caption 8,"Solde Actuel du Compte:"
inactive 8

edit 9
left 9,30
top 9,340
inactive 9
on_change 9,sadc

button 10
left 10,30
top 10,400
caption 10,"Abandon"
on_click 10,quit

button 11
left 11,188
top 11,149
width 11,25
caption 11,"OK"
inactive 11
on_click 11,verifa

button 12
left 12,90
top 12,239
width 12,25
caption 12,"OK"
inactive 12
on_click 12,verifb

button 13
left 13,163
top 13,339
width 13,25
caption 13,"OK"
inactive 13
on_click 13,verifc

form 15
left 15,720
top 15,189
width 15,460
height 15,528
caption 15,"COMPTE FAMILIALE *  Aide *"
color 15,255,255,255
font_color 15,0,0,255
hide 15

gosub tf:gosub chcptutil:gosub rpcv


end
rem ----------------------------------------------------------------------------
aide:
show 15
print_target_is 15
print_locate 10,10:print "Pour Créer un Compte, vous devez en premier définir son Type:"
print_locate 60,30:print "1) COURRANT: la gestion de ce type de compte est Mensuelle"
print_locate 60,50:print "2) EPARGNE: la gestion de ce type de compte est Annuelle"
print_locate 60,70:print "3) DEBIT DIFFERE: la gestion de ce type de compte est Mensuelle"
print_locate 10,90:print "Sélectionnez le Type dans le premier champs"
print_locate 10,120:print "Ensuite indiquez son Nom dans le 2ème champs et cliquez sur OK"
print_locate 60,140:print "EX: Crédit Nationale Paris"
print_locate 10,180:print "Indiquez le Numéro du dernier Rélevé pointé de ce Compte et cliquez sur OK"
print_locate 60,200:print "Pour un dépard tapez zéro"
print_locate 10,240:print "Entrez le solde du dernier jour du mois précédent et cliquez sur OK"
print_locate 60,260:print "Pour un dépard tapez zéro"
print_locate 10,300:print "Valider par le boutton [Enregistrer]"
print_locate 10,340:print "Le fichier de dépard du compte sera du mois précédent le mois en cours"
print_locate 10,360:print "pour permettre l'enregistrement des Opérations Automatiques Mensuelles"
print_locate 10,380:print "Pour un compte annuel le fichier est l'année en cours"
print_target_is 0
return

fec:
if ty$="A" then an$=right$(date$,4):fec$(nc)="£"+cpt$(nc)+an$+".cfp": return
an$=right$(date$,2)
mo$=mid$(date$,4,2)
gosub moav
fec$(nc)="£"+cpt$(nc)+an$+mo$+".cfp"
print_locate 40,100:print fec$(nu)
return

moav:
n=val(mo$)
if n=1 then n=12: gosub anav:goto mo
n=n-1
mo:
if n<10 then mo$="0"+str$(n):return
mo$=str$(n)
return

anav:
a=val(an$)
if a=0 then a=99:goto an
a=a-1
if a<10 then an$="0"+str$(a):return
an:
an$=str$(a)
return

validation:
button 14
left 14,30
top 14,140
width 14,100
caption 14,"ENREGISTRER"
on_click 14,enreg
return

enreg:
hide 14:hide 15
gosub fec
gosub sauveliste
execute cfpgcomp.exe
goto fin
return

sadc:
active 13:hide 15:a$=""
a$=upper$(text$(9))
if len(a$)>10 then gosub verifc
return

verifc:
if len(a$)<1 then message "1 caractères Minimum":a$="":text 9,"":return
if len(a$)>10 then message "10 caractères Maximum":a$="":text 9,"":return
n=numeric(a$)
if n=0 then message "Vous devez saisir une valeur numérique":text 9,"":return
sldcpt$(nc)=a$
hide 9:hide 13
top 8,90
caption 8,"Solde Actuel du Compte: "+sldcpt$(nc)
gosub validation
return

nrlv:
active 12:hide 15:a$=""
a$=upper$(text$(7))
if len(a$)>3 then gosub verifb
return

verifb:
if len(a$)<1 then message "1 caractères Minimum":a$="":text 7,"":return
if len(a$)>3 then message "3 caractères Maximum":a$="":text 7,"":return
n=numeric(a$)
if n=0 then message "Vous devez saisir une valeur numérique":text 7,"":return
if len(a$)=1 then a$="00"+a$
if len(a$)=2 then a$="0"+a$
rec$(nc)=a$
hide 7:hide 12
top 6,70
caption 6,"Numéro du dernier relevé: "+rec$(nc)
active 8:active 9:set_focus 9
return

libcpt:
active 11:hide 15:a$=""
a$=upper$(text$(5))
if len(a$)>30 then gosub verifa
return

verifa:
if len(a$)<2 then message "2 caractères Minimum":a$="":text 5,"":return
if len(a$)>30 then message "30 caractères Maximum":a$="":text 5,"":return
lcpt$(nc)=a$
hide 5:hide 11
top 4,50:caption 4,"Nom du Compte: "+lcpt$(nc)
active 6:active 7:set_focus 7
return

type:
hide 15:ty$=""
a$=item_index$(2)
if a$ ="" then message "Sélection Vide":return
clear 2:hide 2
if a$="COURRANT" then ty$="M":caption 3,"Type de Compte: Mensuel"
if a$="EPARGNE" then ty$="A":caption 3,"Type de Compte: Annuel"
if a$="DEBIT DIFFERE" then ty$="R":message "Cette Option n'est pas encore accéssible":execute cfpcrcpt.exe:goto fin
cpt$(nc)=nu$+ty$+nc$
print_locate 5,5:print cpt$(nc)
active 4:active 5:set_focus 5
return

rpcv:
n=0
rp:
n=n+1
if n>9 then message "plus de place pour un nouveau compte":terminate
if cpt$(n)="" then nc$=str$(n):nc=n: return
goto rp


chcptutil:
nu$=str$(nu)
fi$="cfplc" + nu$ + ".cfp"
fe=file_exists (fi$)
if fe=0 then gosub creliste:execute cfpcrcpt.exe:goto fin
if fe=1 then gosub chargeliste:return
return

quit:
execute cfpgcomp.exe
goto fin
return
rem ----------------------------------------------------------------------------
creliste:
for n=1 to 8
cpt$(n)="":lcpt$(n)="":fec$(n)="":rec$(n)="":sldcpt$(n)=""
next n
cpt$(9)="9T ":lcpt$(9)="Tout Comptes":fec$(9)="":rec$(9)="":sldcpt$(9)=""
gosub sauveliste
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

sauveliste:
file_open_write 1,fi$
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

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,470:print "UTILISATEUR: "+nomutil$
print_locate 300,470:print date$
return
rem ---------------------------------------------------------------------------
fin:
terminate
Revenir en haut Aller en bas
Jean Claude

Jean Claude


Nombre de messages : 5950
Age : 69
Localisation : 83 Var
Date d'inscription : 07/05/2009

CFP les codes Empty
MessageSujet: Re: CFP les codes   CFP les codes EmptyMer 16 Sep 2009 - 8:16

Erratum le précédent portait le n°12

Le 13ème, cfpcrfca, pour créer les familles de catégories.

Code:

rem cfpcrfca

label quit,aide,tf,addlist,rpnv,nom,verifa,cont,enreg,fin
label sauvefam,chargefam

dim n,nu,l
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 * Création 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
inactive 2

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

alpha 4
left 4,293
top 4,64
width 4,130
caption 4,"Nouvelle Famille de Catégories"

edit 5
left 5,292
top 5,91
width 5,150
on_change 5,nom

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

button 7
left 7,452
top 7,91
width 7,20
height 7,20
caption 7,"OK"
on_click 7,verifa
hide 7

button 8
left 8,331
top 8,141
caption 8,"Enregistrer"
on_click 8,enreg
hide 8

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

gosub tf:gosub chargefam: gosub addlist
set_focus 5
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 créer jusqu'à 13 Nouvelles Familles"
print_locate 30,130:print "Il en existe déja 7 qui sont intégrées avec leurs catégories"
print_locate 10,170:print "Vous pouvez les modifier ou les supprimer dans les sections de programme prévues"
print_locate 10,250:print "Autre exemple: dans la Famille de Catégorie REVENU vous pouvez avoir 2 catégories"
print_locate 10,270:print "comme Salaire de monsieur, salaire de madame, etc.."
print_target_is 0
return

nom:
hide 11
show 7:a$=""
a$=upper$(text$(5))
if len(a$)>11 then gosub verifa
return

verifa:
hide 11
if len(a$)<3 then message "3 caractères Minimum":a$="":text 5,"":return
if len(a$)>11 then message "11 caractères Maximum":a$="":text 5,"":return
fam$(n)=a$+":"
show 8
return

enreg:
hide 11
a$="":l=len(fam$(n))
if l>6 then l=5
a$=lower$(left$(fam$(n),l-1))
fifam$(n)="fca"+a$+".cfp"
fi$=fifam$(n)
gosub sauvefam
file_open_write 1,fi$
for n=1 to 15
file_writeln 1,cat$(n)
next n
file_close 1
execute cfpcrfca.exe
goto fin
return

rpnv:
for n=1 to 20
if fam$(n)="" then return
next n
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
gosub rpnv
if n>19 then message "Plus de place pour une nouvelle Famille":goto quit
print_locate 10,55:print "  ":print_locate 10,55:print n-1
return

rem ----------------------------------------------------------------------------
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
Revenir en haut Aller en bas
Jean Claude

Jean Claude


Nombre de messages : 5950
Age : 69
Localisation : 83 Var
Date d'inscription : 07/05/2009

CFP les codes Empty
MessageSujet: Re: CFP les codes   CFP les codes EmptyMer 16 Sep 2009 - 8:28

Le 14ème, cfpgchq, Gestion des chéquiers.

Celui-ci m'a permis de m'exercer avec MAIN_MENU, je pense que la prochaine version utilisera plus cette méthode.


Code:

rem cfpgchq

label enregistrer,quit,fin,quitv

label annuler,copier,coller,supprimer
label declaration,cloture,visu,clot,vclot,validclot,sursi,visu2
label modif,npdollar,vch,mt,pas,pa,strig
label tf,chargechequiers,rpchqv,adollar,chargeliste,bank,type,spexist,spex,npch,npc
label ndch,ndc,abdec,enrchq,sauvechequiers,crechequier,sauvecheque,chargecheque
label validsitk,enrvsitk,rempli18

dim nu,a,b,n,ncq,nbch,npc,ndc,np,l,lt,ls,p,nc
dim nu$,a$,b$,c$,d$,e$,f$,fi$,fik$,fic$,prov$
dim proga$,nomutil$,motutil$,gradutil$
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 cpt$(9),lcpt$(9),fec$(9),rec$(9),sldcpt$(9)

left 0,100:top 0,100:width 0,900:height 0,750
caption 0,"COMPTE FAMILIALE  *  Gestion des chèques  *"


main_menu 1

rem CREATION DES MENUS
sub_menu 2 : caption 2,"Fichier" : parent 2, 1
sub_menu 3 : caption 3,"Edition" : parent 3, 1
sub_menu 4 : caption 4,"Gestion des chèquiers" : parent 4,1
sub_menu 5 : caption 5,"Gestion des chèques" : parent 5,1

rem OPTIONS DU MENU FICHIER
sub_menu 7 : caption 7,"Enregistrer" : parent 7, 2
sub_menu 8 : caption 8,"Quitter" : parent 8, 2
on_click 7,enregistrer:inactive 7
on_click 8,quit

rem OPTIONS DU MENU EDITION
sub_menu 9 : caption 9,"Annuler" : parent 9, 3
sub_menu 10 : caption 10,"Copier" : parent 10, 3
sub_menu 11 : caption 11,"Coller" : parent 11, 3
sub_menu 12 : caption 12,"Supprimer" : parent 12, 3
on_click 9,annuler:inactive 9
on_click 10,copier:inactive 10
on_click 11,coller:inactive 11
on_click 12,supprimer:inactive 12

rem OPTIONS DU MENU GESTION DES CHEQUIERS
sub_menu 13 : caption 13,"Déclaration d'un nouveau chèquier" : parent 13, 4
sub_menu 14 : caption 14,"Cloture d'un chèquier" : parent 14, 4
sub_menu 15 : caption 15,"Visualisation d'un chèquier" : parent 15, 4
sub_menu 6 : caption 6,"Visualisation d'un chèquier Cloturé Definitif" : parent 6, 4
on_click 13,declaration
on_click 14,cloture
on_click 15,visu
on_click 6,visu2

rem OPTIONS DU MENU GESTION DES CHEQUES
sub_menu 16 : caption 16,"Mofication d'un Chèques" : parent 16, 5
on_click 16,modif

form 17
font_name 17,"Fixedsys"
left 17,250:top 17,250:width 17,600:height 17,500
caption 17,"COMPTE FAMILIALE  *  Déclaration d'un nouveau Chèquier  *"
border_small 17
hide 17

gosub tf
if gradutil$="INACTIF" then message " "+nomutils+" Vous ne pouvez accèder a ce programme":goto quit
nu$=str$(nu)
fic$="cfp"+nu$+"chq.cfp"
gosub chargechequiers
if numchq$(1)="" then inactive 14:inactive 15:inactive 16
if nchk$(1)="" then inactive 5
inactive 3
prov$=""
end

visu2:
execute cfpvisu2.exe
goto fin
return
rem ----------------------------------------------------------------------------
cloture:
inactive 4:inactive 5:prov$="CLOTURE"
combo 34:top 34,590:left 34,100:width 34,340
hide 34
item_add 34,"DEFINITIVE: effacement du fichier chèquier"
item_add 34,"PROVISOIRE: Visualisation uniquement"
goto visu
clot:
n=nc
if sitchq$(n)="A FINIR" then message "ATTENTION: Ce chèquier n'est pas terminé"
if sitchq$(n)="PAS TOUT POINTE" then message "ATTENTION: Ce chèquier n'est pas complètement pointé"
show 34
print_locate 100,570:print "Choissisez le type de cloture"
on_click 34,vclot
return

vclot:
a=item_index(34)
button 35:top 35,585:left 35,590:width 35,200:caption 35,"Valider la CLOTURE"
on_click 35,sursi
print_locate 100,570:print "                              "
print_locate 100,550:print "                      Vous pouvez encore SORTIR par le menu fichier => Quitter"
return

sursi:
on_click 0,quit
if a=1 then file_delete fik$:fik$=left$(fik$,4)+"A"+right$(fik$,7):b=n:gosub sauvecheque:n=b
if a=1 then message "ATTENTION: Le Fichier est définitivement supprimé. vous pouvez le visualiser par l'option prévu, sous ce nom: "+fik$
gosub validclot
return

validclot:
if a=1 then numchq$(n)=" ":bkchq$(n)=" ":typchq$(n)=" ":npchk$(n)="":ndchk$(n)=" ":sitchq$(n)="":gosub sauvechequiers
if a=2 then sitchq$(n)="COTURE PROVISOIRE":gosub sauvechequiers
execute cfpgchq.exe:goto fin
return

rem ----------------------------------------------------------------------------
visu:
inactive 4
font_name 0,"Fixedsys"
combo 30:top 30,100:left 30,15:width 30,340
print_locate 15,80:print "Sélectionnez le Chèquier"
for n=1 to 10
item_add 30,numchq$(n)+" "+bkchq$(n)+" "+typchq$(n)+" "+npchk$(n)+"/"+ndchk$(n)+" "+sitchq$(n)
next n
on_click 30,vch
return

vch:
n=item_index(30):nc=n
if numchq$(n)="" then message "Sélection Vide":return
cls:hide 30
list 31:top 31,120:left 31,100:width 31,690:height 31,400
cls:print_locate 90,10:print "CHEQUIER N°"+numchq$(n)+" - BANQUE: "+bkchq$(n)+" - TYPE: "+typchq$(n)+" - N°"+npchk$(n)+" à "+ndchk$(n)+" - SITUATION: "+sitchq$(n)
print_locate 9,670:print "UTILISATEUR: "+nomutil$
print_locate 800,670:print date$
print_locate 96,105:print "|N°CHEQUE|  MONTANT  | DATE OPER. | DATE VAL.. |        ORDRE        | SITUATION | |"
fik$="cf"+nu$+"ch"+numchq$(n)+".cfp"
a=val(npchk$(n)):b=val(ndchk$(n)):nbch=1+(b-a)
gosub chargecheque
for n=1 to nbch
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 31,c$:c$=""
next n
if prov$="CLOTURE" then goto clot
active 5
on_click 0,quitv
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
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
cloture:
inactive 4:inactive 5:prov$="CLOTURE"
gosub visu
clot:
n=nc
if sitchq$(n)="A FINIR" then message "ATTENTION: Ce chèquier n'est pas terminé"
if sitchq$(n)="PAS TOUT POINTE" then message "ATTENTION: Ce chèquier n'est pas complètement pointé"
combo 34:top 34,590:left 34,100:width 34,240
item_add 34,"DEFINITIVE: effacement total du disque"
item_add 34,"PROVISOIRE: Visualisation uniquement"
hide 34
return

rem ----------------------------------------------------------------------------------
modif:
n=item_index(31)
if nchk$(n)="" then message "Vous devez sélectionner une ligne pour modifier":return
inactive 5
combo 32:top 32,590:left 32,100:width 32,140
print_locate 100,570:print "Modification de la Situation du Chèque N°"+nchk$(n)
item_add 32,"BLANC"
item_add 32,"EMIS"
item_add 32,"POINTE"
item_add 32,"ANNULE"
item_add 32,"PERDU"
on_click 32,validsitk
button 33:top 33,585:left 33,590:width 33,200:caption 33,"Valider la Modification"
inactive 33
on_click 0,quitv
return

validsitk:
active 33
on_click 33,enrvsitk
on_click 0,quitv
return

enrvsitk:
mtchk$(n)="0.00"
sitchk$(n)=text$(32)
gosub sauvecheque
execute cfpgchq.exe:goto fin
return

quitv:
execute cfpgchq.exe:goto fin
return


rem ----------------------------------------------------------------------------
declaration:
show 17:inactive 4:inactive 5
print_target_is 17
command_target_is 17
n=0:gosub rpchqv
a$=str$(ncq)
gosub adollar
numchq$(ncq)=a$
combo 18:top 18,160:left 18,15:width 18,230
alpha 19:top 19,130:left 19,15:Caption 19,"Sélectionnez la Banque"
gosub rempli18
on_click 18,bank
utilchq$(ncq)=nomutil$
print_locate 15,20:print "Numéro du Nouveau Chèquier: "+numchq$(ncq)
print_locate 15,40:print  "UTILISATEUR: "+utilchq$(ncq)
return

rempli18:
nu$=str$(nu):fi$="cfplc" + nu$ + ".cfp"
gosub chargeliste
for n=1 to 9
item_add 18,lcpt$(n)
next n
return

bank:
a$=text$(18)
if a$="Tout Comptes" then  message "Compte interdit pour cette fonction" :clear 18:gosub rempli18:return
if a$="" then message "Sélection Vide":return
n=item_index(18)
bkchq$(ncq)=cpt$(n)
hide 18:hide 19
print_locate 15,60:print "BANQUE: "+bkchq$(ncq)+" "+lcpt$(n)
alpha 20:top 20,160:left 20,15:Caption 20,"Sélectionnez le Type du chèquier"
combo 21:top 21,190:left 21,15:width 21,230
item_add 21,"PRINCIPAL"
item_add 21,"SECONDAIRE"
on_click 21,type
return

type:
a$=text$(21)
if a$="PRINCIPAL" then gosub spexist:rem si déja un chèquier principal
typchq$(ncq)=a$
hide 20:hide 21
print_locate 15,80:print "TYPE DE CHEQUIER: "+typchq$(ncq)
alpha 22:top 22,190:left 22,15:Caption 22,"Entrez le Numéro du Premier Chèque"
edit 23:top 23,220:left 23,15
on_change 23,npch
button 24:top 24,220:left 24,150:width 24,20:height 24,20:caption 24,"OK"
set_focus 23:inactive 24
return

npch:
active 24
on_click 24,npc
a$=text$(23)
a=numeric(a$)
if a=0 then message "Vous devez saisir une valeur numérique":text 23,"":return
return

npc:
npchk$(ncq)=a$
print_locate 15,100:print "NUMERO DU PREMIER CHEQUE: "+npchk$(ncq)
hide 22:hide 23:hide 24
alpha 27:top 27,190:left 27,15:Caption 27,"Entrez le Numéro du Premier Chèque"
Caption 27,"Entrez le Numéro du dernier Chèque"
edit 25:top 25,220:left 25,15
on_change 25,ndch
button 26:top 26,220:left 26,150:width 26,20:height 26,20:caption 26,"OK"
set_focus 25:inactive 26
return

ndch:
active 26
a$=text$(25)
a=numeric(a$)
if a=0 then message "Vous devez saisir une valeur numérique":text 25,"":return
on_click 26,ndc
return

ndc:
a=val(a$):b=val(npchk$(ncq))
if b>a then message "Impossible que le N° du dernier chèque soit supérieur au premier":text 25,"":return
ndchk$(ncq)=a$
print_locate 15,120:print "NUMERO DU DERNIER CHEQUE: "+ndchk$(ncq)
hide 25:hide 26:hide 27
nbch=a-b:a$=str$(nbch)
print_locate 15,140:print "NOMBRE DE CHEQUES: "+a$
sitchq$(ncq)="A FINIR"
print_locate 15,160:print "SITUATION DU CHEQUIER: "+sitchq$(ncq)
button 28:top 28,420:left 28,450:width 28,100:height 28,20:caption 28,"ENREGISTRER"
on_click 28,enrchq
button 29:top 29,420:left 29,30:width 29,100:height 29,20:caption 29,"ABANDON"
on_click 29,abdec
return

abdec:
execute cfpgchq.exe
goto fin
return

enrchq:
gosub sauvechequiers
gosub crechequier
execute cfpgchq.exe
goto fin
return

crechequier:
n=0:a=0
npc=val(npchk$(ncq)):ndc=val(ndchk$(ncq))
nbch=1+(ndc-npc)
for a=npc to ndc
n=n+1:gosub npdollar
next a
for n=1 to nbch
mtchk$(n)="0.00"
datoperchk$(n)="":datvalchk$(n)="":ordrechk$(n)=""
sitchk$(n)="BLANC"
next n
fik$="cf"+nu$+"ch"+numchq$(ncq)+".cfp"
gosub sauvecheque
return

npdollar:
a$=str$(a)
if a<10 then nchk$(n)="00000"+a$:return
if a>9 and a<100 then nchk$(n)="0000"+a$:return
if a>99 and a<1000 then nchk$(n)="000"+a$:return
if a>999 and a<10000 then nchk$(n)="00"+a$:return
if a>9999 and a<100000 then nchk$(n)="0"+a$:return
if a>99999 then nchk$(n)=""+a$:return
return

spexist:
for n=1 to 10
if numchq$(n)="" then goto spex
if n>10 then message "Cas non prévu au label spexist":terminate
if typchq$(n)="PRINCIPAL" then message "il y a déja un chèquier principal":a$="SECONDAIRE":return
spex:
next n
return

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

rpchqv:
n=n+1
if n>10 then message "Plus de pace pour Créer un nouveau Chèquier":n=0:return
if numchq$(n)="" then ncq=n:return
goto rpchqv
rem ----------------------------------------------------------------------------

annuler:
message "vous avez cliqué sur annuler"
return

copier:
message "vous avez cliqué sur copier"
return

coller:
message "vous avez cliqué sur coller"
return

supprimer:
message "vous avez cliqué sur supprimer"
return

enregistrer:
message "vous avez cliqué sur enregistrer"
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,670:print "UTILISATEUR: "+nomutil$
print_locate 800,670:print date$
return

rem -------------------------------------------------------------
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

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

quit:
execute cfpmenug.exe
fin:
terminate
Revenir en haut Aller en bas
Jean Claude

Jean Claude


Nombre de messages : 5950
Age : 69
Localisation : 83 Var
Date d'inscription : 07/05/2009

CFP les codes Empty
MessageSujet: Re: CFP les codes   CFP les codes EmptyMer 16 Sep 2009 - 8:32

Le 15ème, cfpgcod, le menu de gestion des codes.

Code:
rem cfpgcod

label quit,fin,tf,aide,creation,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 Codes *"
 
button 1
left 1,30
top 1,30
width 1,218
caption 1,"Créer un nouveau Code"
on_click 1,creation

button 2
left 2,30
top 2,80
width 2,218
caption 2,"Modifier ou Supprimer un Code"
on_click 2,modification


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 cfpsmcod.exe
goto fin
return


creation:
execute cfpcrcod.exe
goto fin
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
fin:
terminate


Dernière édition par Jean Claude le Jeu 17 Sep 2009 - 15:22, édité 1 fois
Revenir en haut Aller en bas
Jean Claude

Jean Claude


Nombre de messages : 5950
Age : 69
Localisation : 83 Var
Date d'inscription : 07/05/2009

CFP les codes Empty
MessageSujet: Re: CFP les codes   CFP les codes EmptyMer 16 Sep 2009 - 8:38

Le 16ème, cfpgdest, Gestion des destinataires ou emetteurs, en résumé une liste de noms de personnes, de sociétés, de magasins,.....

Code:
rem cfpgdest

label quit,aide,sauvedest,chargedest,addlist,gestionlist,verifsup,tf,ajout
label verifajout,enregajout,sup,tri,insert,sel,tride,ignore
label fin

dim n,nd,nx,nu,t,lv,maxn
dim dest$(99),destt$(99)
dim fi$,destp$,proga$,des$
dim nomutil$,motutil$,gradutil$

left 0,242
top 0,207
width 0,460
height 0,540
caption 0,"COMPTE FAMILIALE *  Destinataires ou Emetteurs *"
 
list 1
left 1,34
top 1,41
width 1,178
height 1,396
on_click 1,gestionlist

button 2
left 2,275
top 2,120
caption 2,"Ajouter"
inactive 2
on_click 2,verifajout

button 3
left 3,265
top 3,241
caption 3,"Supprimer"
inactive 3
on_click 3,sup

button 4
left 4,265
top 4,291
caption 4,"Sélectionner"
inactive 4
on_click 4,sel

button 5
left 5,255
top 5,400
width 5,100
caption 5,"Retour Au Menu"
on_click 5,quit

alpha 6
left 6,58
top 6,13
width 6,120
caption 6,"Destinataires ou Emetteurs"

button 7
left 7,371
top 7,15
width 7,30
height 7,30
caption 7,"?"
on_click 7,aide

edit 8
left 8,250
top 8,81
width 8,126
height 8,22
inactive 8
on_change 8,ajout

alpha 9
left 9,287
top 9,60
width 9,120
caption 9,"Nouveau"
inactive 9

button 10
left 10,270
top 10,120
width 10,90
caption 10,"CONFIRMATION"
hide 10
on_click 10,enregajout

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

gosub tf
gosub chargedest
gosub addlist
end
rem ---------------------------------------------------------------------------
aide:
show 11
print_target_is 11
print_locate 10,10
print "Cette section du programme sert à gérer les Destinataires ou Emetteurs."
print_locate 10,50
print "Un Destinataires ou un Emetteurs est le nom d'une personne ou d'un organisme, à qui vous"
print_locate 10,70
print "faites un règlement ou qui vous verse de l'argent."
print_locate 10,110
print "Vous ne pouvez modifier ou ajouter un élément, que si votre statut est: ACTIF ."
print_locate 10,150
print "Pour ajouter un élément à la liste, vous devez cliquer sur la première ligne vide."
print_locate 10,170
print "Puis sur  [Ajouter]  et ensuite sur  [Confirmation] "
print_locate 10,210
print "Pour supprimer ou sélectionner un élément de la liste, vous devez cliquer sur cet élément."
print_locate 10,230
print "Puis sur  [Supprimer]  ou  sur  [sélectionner] "


print_target_is 0
return

sel:
if dest$(nd)="" then beep: return
destp$=dest$(nd)
file_open_write 1,"cfptf02.cfp"
file_writeln 1,proga$
file_writeln 1,destp$
file_close 1
execute proga$
goto fin
return

ajout:
show 2:hide 10:active 2
destp$=upper$(text$(8))
if len(destp$)>20 then gosub verifajout
return

verifajout:
if len(destp$)<3 then message "3 caractères Minimum":destp$="":text 8,"":return
if len(destp$)>20 then message "20 caractères Maximum":destp$="":text 8,"":return
hide 2:show 10
return

enregajout:
dest$(nd)=destp$
gosub sauvedest
execute cfpgdest.exe
goto fin
return

sup:
if destp$="DIVERS" then message "Ce destinataire ne peut pas être supprimé":return
dest$(nd)=""
gosub tri
gosub sauvedest
execute cfpgdest.exe
goto fin
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,470:print "UTILISATEUR: "+nomutil$
if gradutil$="INACTIF" then message " "+nomutil$+" Votre statut ne permet que la consultation"
return

gestionlist:
hide 10:show 2:hide 11
inactive 9:inactive 8:inactive 3:inactive 4:inactive 2
text 8,""
if gradutil$="INACTIF" then return
nd=item_index(1)
print_locate 8,40:print "  ":print_locate 8,40:print nd
destp$=item_index$(1)
if destp$="" then gosub verifsup:return
if destp$<>"" then active 3:active 4
return

verifsup:
nx=nd-1
if dest$(nx)<>"" and destp$="" then active 9:active 8:return
inactive 9:inactive 8:inactive 2
return

addlist:
for n=1 to 99
item_add 1,dest$(n)
next n
return


tri:
t=0:lv=0
for n=1 to 99
 if dest$(n)<>"" then gosub insert
 if dest$(n)="" then lv=lv+1
next n
for n=1 to 99
dest$(n)=destt$(n)
next n
n=99-(lv-1)
dest$(n)=""
return
insert:
t=t+1
destt$(t)=dest$(n)
return
rem ---------------------------------------------------------------------------
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

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

tride:
dlist 12
for n=1 to 99
if dest$(n)="" then goto ignore
destp$=dest$(n)
item_add 12,destp$
ignore:
next n
sort 12
maxn=count(12)
for n=1 to maxn
des$=item_read$(12,n)
dest$(n)=des$
next n
return

quit:
execute cfpmenug.exe
fin:
terminate
Revenir en haut Aller en bas
Jean Claude

Jean Claude


Nombre de messages : 5950
Age : 69
Localisation : 83 Var
Date d'inscription : 07/05/2009

CFP les codes Empty
MessageSujet: Re: CFP les codes   CFP les codes EmptyMer 16 Sep 2009 - 8:42

Le 17ème, cfpgfca, Le menu de gestion des catégories et leurs familles.

Code:
rem cfpgfca

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,450
height 0,301
caption 0,"COMPTE FAMILIALE * Gestion des Famille de Catégories *"
 
button 1
left 1,30
top 1,30
width 1,218
caption 1,"Créer une nouvelle Famille de Catégories"
on_click 1,creation

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

button 3
left 3,30
top 3,130
width 3,218
caption 3,"Supprimer une Famille de Catégories"
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,700
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 cfpmofca.exe
terminate
return

suppression:
execute cfpsufca.exe
terminate
return

creation:
execute cfpcrfca.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
Revenir en haut Aller en bas
Jean Claude

Jean Claude


Nombre de messages : 5950
Age : 69
Localisation : 83 Var
Date d'inscription : 07/05/2009

CFP les codes Empty
MessageSujet: Re: CFP les codes   CFP les codes EmptyMer 16 Sep 2009 - 8:47

Le 18ème, cfpmocat, pour modifier une catégorie.

Code:
rem cfpmocat

label quit,aide,tf,addlist,fin,selfam,cont,selcat,aj,ajou,enreg,cnb,spf0
label sauvefam,chargefam,chargecat,sauvecat

dim n,nu,l,lt,lc,nf,nb,nc,pas
dim nu$,a$,b$,afam$,fi$
dim proga$,nomutil$,motutil$,gradutil$
dim fam$(20),fifam$(20)
dim cat$(15)

left 0,80
top 0,180
width 0,700
height 0,492
caption 0,"COMTE FAMILIALE * Modification d'une Catégorie *"
on_click 0,spf0

button 1
left 1,560
top 1,9
width 1,20
height 1,20
caption 1,"?"
on_click 1,aide

button 2
left 2,20
top 2,380
width 2,90
caption 2,"Retour au Menu"
on_click 2,quit

alpha 3
left 3,57
top 3,24
caption 3,"Liste des Familles"

list 4
left 4,20
top 4,50
width 4,170
height 4,270
on_click 4,selfam

alpha 5
left 5,255
top 5,24
caption 5,"Liste des Catégories"

list 6
left 6,217
top 6,50
width 6,190
height 6,270
on_click 6,selcat

alpha 7
left 7,420
top 7,80
hide 7

edit 8
left 8,430
top 8,110
hide 8
on_change 8,aj

button 9
left 9,560
top 9,112
width 9,20
height 9,20
caption 9,"OK"
hide 9
on_click 9,ajou

button 10
left 10,457
top 10,160
caption 10,"Enregistrer"
hide 10
on_click 10,enreg

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

gosub tf:gosub chargefam: gosub addlist:gosub aide

end
rem ----------------------------------------------------------------------------
spf0:
goto quit
return

aide:
show 12
print_target_is 12
print_locate 10,10:print "Pour Modifier une Catégorie, vous devez commencer par sélectionner une Famille."
print_locate 10,30:print "Dans la Fenêtre [Liste des Catégories] sélectionnez la Categorie à Modifier"
print_locate 10,50:print "Ajouter la nouvelle Catégorie dans le champ [Nouvelle Catégorie]"
print_locate 10,70:print "Ne tapez que la Catégorie, la famille est ajouté automatiquement"
print_locate 10,90:print "Validez la nouvelle Catégorie en cliquant sur le bouton [Enregistrer]"
print_locate 10,210:print "MISE EN GARDE: il est déconseillé de Modifier une Catégorie, car vous ne"
print_locate 102,230:print "pourrez plus avoir les Statistiques correspondantes"
print_target_is 0
return

aj:
show 9:hide 12:inactive 6
a$=text$(8)
if len(a$)>21 then gosub ajou
return

ajou:
inactive 7:inactive 8
if len(a$)<3 then message "3 caractères Minimum":a$="":text 8,"":return
if len(a$)>21 then message "21 caractères Maximum":a$="":text 8,"":return
show 10:hide 9
return

enreg:
cat$(nc)=afam$+": "+a$
gosub sauvecat
execute cfpmocat.exe
goto fin
return

selcat:
hide 12
inactive 4:show 7:show 8:set_focus 8
n=item_index(6):nc=n
a$=item_index$(6)
if cat$(n)="" then message "Sélection Vide":goto quit
lt=len(cat$(n)):lc=lt-l:lc=lc-1
b$=right$(a$,lc)
caption 7,"Remplacement de "+b$
return

selfam:
pas=pas+1:if pas >1 then clear 6
hide 12
n=item_index(4):nf=n
a$=item_index$(4)
if a$="" then message "Sélection Vide":goto quit
l=len(fam$(n)):afam$=left$(fam$(n),l-1)
fi$=fifam$(nf)
gosub chargecat
for n=1 to 15
item_add 6,cat$(n)
next n
gosub cnb
print_locate 202,50:print "  "
print_locate 202,50:print nb
return

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

addlist:
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 4,afam$
afam$=""
next n
print_locate 7,50:print "  "
print_locate 7,50:print nf
return

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

sauvecat:
file_open_write 1,fi$
for n=1 to 15
file_writeln 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 cfpgcat.exe
fin:
terminate
Revenir en haut Aller en bas
Jean Claude

Jean Claude


Nombre de messages : 5950
Age : 69
Localisation : 83 Var
Date d'inscription : 07/05/2009

CFP les codes Empty
MessageSujet: Re: CFP les codes   CFP les codes EmptyMer 16 Sep 2009 - 8:51

Le 19ème, cfpmocpt, pour modifier un compte.

Code:
rem cfpmocpt

label quit,aide,tf,chcptutil,addlist,sel,afiactu,afinouv,nom,enregedit,verifa
label chargeliste,sauveliste,enreg,rlv,verifb,verif,sld,verifc
label chargeoper,sauveoper,gereoper,ger

dim a,n,nu,fe,nc
dim a$,nu$,fi$,fio$,choix$,prov$
dim proga$,nomutil$,motutil$,gradutil$
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,223
top 0,182
width 0,550
height 0,492
caption 0,"COMPTE FAMILIALE * Modifier un Compte *"
 
button 1
left 1,466
top 1,10
width 1,25
caption 1,"?"
on_click 1,aide

alpha 2
left 2,41
top 2,40
width 2,95
caption 2,"Liste des Comptes"

list 3
left 3,28
top 3,60
height 3,156
on_click 3,sel

button 4
left 4,30
top 4,240
width 4,120
caption 4,"Modifier le  Nom"
hide 4
on_click 4,nom

button 5
left 5,31
top 5,290
width 5,120
caption 5,"Modifier le N° de Relevé"
hide 5
on_click 5,rlv

button 6
left 6,30
top 6,340
width 6,120
caption 6,"Modifier le Solde"
hide 6
on_click 6,sld

button 7
left 7,260
top 7,290
width 7,120
caption 7,"Valider la Modification"
hide 7
on_click 7,enreg

button 8
left 8,260
top 8,340
width 8,120
caption 8,"ABANDON"
on_click 8,quit

picture 9
left 9,190
top 9,60
width 9,267
height 9,156

alpha 10
left 10,192
top 10,40
width 10,263
caption 10,"Visualisation des données du Compte:"

edit 11
left 11,200
top 11,250
width 11,200
hide 11
on_change 11,enregedit

alpha 12
left 12,200
top 12,230
hide 12

button 13
left 13,420
top 13,250
width 13,20
caption 13,"OK"
height 13,20
on_click 13,verif
hide 13

form 14
left 14,780
top 14,190
width 14,460
height 14,280
caption 14,"COMPTE FAMILIALE *  Aide *"
color 14,255,255,255
font_color 14,0,0,255
hide 14

gosub tf:gosub chcptutil:gosub addlist

end
rem ---------------------------------------------------------------------------
aide:
show 14
print_target_is 14
print_locate 10,10:print "Vous ne pouvez modifier qu'une seule donnée à la fois"
print_locate 10,30:print "Sélectionnez le Compte à modifier dans la fenêtre Liste des Comptes"
print_locate 10,50:print "Dans la fenêtre de droite vous pouvez visualiser les données actuelles de ce Compte"
print_locate 10,70:print "Cliquez sur le bouton correspondant à la donnée que vous souhaitez modifier"
print_locate 10,90:print "Saisissez la nouvelle donnée et cliquez sur OK"
print_locate 10,110:print "Dans la fenêtre de droite apparaissent les données modifiées"
print_locate 10,130:print "Vous pouvez ou Valider ou Abandonner"
print_locate 10,170:print "Pour modifier une autre donnée de ce Compte vous devez revenir en passant par le menu."
print_locate 10,210:print "ATTENTION: les boutons ne paraissent que si vous avez sélectionné un Compte"
print_target_is 9
return

verif:
hide 14
if choix$="NOM" then gosub verifa
if choix$="RLV" then gosub verifb
if choix$="SLD" then gosub verifc
return

sld:
hide 14
show 11:show 12:show 13
set_focus 11
inactive 4:inactive 5:inactive 6
caption 12,"Nouveau Solde: "
choix$="SLD"
return

verifc:
if len(a$)<1 then message "1 caractères Minimum":a$="":text 11,"":return
if len(a$)>10 then message "10 caractères Maximum":a$="":text 11,"":return
n=numeric(a$)
if n=0 then message "Vous devez saisir une valeur numérique":text 11,"":return
sldcpt$(nc)=a$
prov$="SOLDE"
inactive 12:inactive 13:inactive 11:show 7
gosub afinouv
return

rlv:
hide 14
show 11:show 12:show 13
set_focus 11
inactive 4:inactive 5:inactive 6
caption 12,"Nouveau Relevé: "
choix$="RLV"
return

verifb:
if len(a$)<1 then message "1 caractères Minimum":a$="":text 11,"":return
if len(a$)>3 then message "3 caractères Maximum":a$="":text 11,"":return
n=numeric(a$)
if n=0 then message "Vous devez saisir une valeur numérique":text 11,"":return
if len(a$)=1 then a$="00"+a$
if len(a$)=2 then a$="0"+a$
rec$(nc)=a$
inactive 12:inactive 13:inactive 11:show 7
gosub afinouv
return

nom:
hide 14
show 11:show 12:show 13
set_focus 11
inactive 4:inactive 5:inactive 6
caption 12,"Nouveau Nom: "
choix$="NOM"
return

enregedit:
a$=""
a$=upper$(text$(11))
if choix$="NOM" and len(a$)>30 then gosub verifa
if choix$="RLV" and len(a$)>3 then gosub verifb
if choix$="SLD" and len(a$)>10 then gosub verifc
return

verifa:
if len(a$)<2 then message "2 caractères Minimum":a$="":text 11,"":return
if len(a$)>30 then message "30 caractères Maximum":a$="":text 11,"":return
lcpt$(nc)=a$
inactive 12:inactive 13:inactive 11:show 7
gosub afinouv
return

sel:
hide 14
nc= item_index (3)
if cpt$(nc)="" then message "Sélection Vide":return
caption 10,"Visualisation des données du Compte: "+lcpt$(nc)
inactive 3:show 4:show 5:show 6
afiactu:
print_target_is 9
print_locate 10,5:print "Donées Actuelles du Compte: "+cpt$(nc)
print_locate 10,20:print "NOM: "+lcpt$(nc)
print_locate 10,35:print "N° du relevé en cours: "+rec$(nc)
print_locate 10,50:print "Solde Actuel: "+sldcpt$(nc)
print_locate 10,65:print string$(36,"~")
return

afinouv:
print_locate 10,80:print "Donées Modifiées du Compte: "+cpt$(nc)
print_locate 10,95:print "NOM: "+lcpt$(nc)
print_locate 10,110:print "N° du relevé en cours: "+rec$(nc)
print_locate 10,125:print "Solde Actuel: "+sldcpt$(nc)
return

addlist:
for n=1 to 8
item_add 3,cpt$(n)+" "+lcpt$(n)
next n
return

chcptutil:
nu$=str$(nu)
fi$="cfplc" + nu$ + ".cfp"
fe=file_exists (fi$)
if fe=0 then message "il n'y a pas de Compte":terminate
if fe=1 then gosub chargeliste:return
return

enreg:
if prov$="SOLDE" then gosub gereoper
gosub sauveliste
goto quit
return

gereoper:
fio$=fec$(nc)
gosub chargeoper:n=0
for n=1 to 111
if n>111 then terminate
if nlig$(n)="" then a=n-1:goto ger
next n
ger:
sld$(a)=sldcpt$(nc)
gosub sauveoper
return

rem ---------------------------------------------------------------------------
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

sauveliste:
file_open_write 1,fi$
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

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

chargeoper:
file_open_read 1,fio$
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,fio$
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 cfpgcomp.exe
terminate
Revenir en haut Aller en bas
Jean Claude

Jean Claude


Nombre de messages : 5950
Age : 69
Localisation : 83 Var
Date d'inscription : 07/05/2009

CFP les codes Empty
MessageSujet: Re: CFP les codes   CFP les codes EmptyMer 16 Sep 2009 - 9:01

Le 21ème, cfpnvmoi, pour ouvrir un nouveau mois de comptes. Celui-la m'a donner beaucoups de sueurs.

Code:
rem cfpnvmoi

label nouvfich,nouvmoi,nouvan,tf,chargetf03,chargeliste,datfich,sauveliste
label chargecode,sauvecode,sauveoper,optermine
label chargedest,aide,demar,validnvmois,quit,fin,bleu,jaune,rose,vert
label ligreport,addlist,strig,pas,pa,pa2,mt,cont,rpca,piece,minmax
label adollar,solde,suite,suit,modilib,modlib,molib,montant,montan,monta,nvsld,nvs
label modidest,seldest,preparvir,addvir,prepvir,sauvevir

dim a,b,c,n,n1,n2,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$,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 ca$(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 nouvfich:gosub datfich
caption 0,"COMPTE FAMILIALE  *  Enregistrement des Opérations Automatiques Mensuelles 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 le Nouveau Mois"
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 le Changement de Mois"
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

preparvir:
n=0:vir$=""
for no=2 to 111
if n>111 then return
if nlig$(no)="" then goto prepvir
if left$(cod$(no),2)="VI" then gosub addvir
prepvir:
next no
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

validnvmois:
inactive 5:inactive 8:inactive 9:inactive 10:inactive 14
gosub vert
gosub preparvir
if vir$="O" then gosub sauvevir
gosub sauveoper
gosub sauvecode
gosub sauveliste
if vir$="" then execute "cfpeomen.exe"
if vir$="O" then execute "cfpvir.exe"
goto fin
return

suite:
active 5:active 8:active 10:active 9
active 16
gosub vert
print_target_is 0
print_locate 30,600:print "Faites  vos  modifications  eventuelles  en  cliquant  sur  la  ligne  à  modifier"
print_locate 40,650:print "Attention :  Vous  ne  pouvez  changer  qu ' un  seul  élément .  il  est  préférable  de  modifier  les  Codes"
on_click 1, suit
return

suit:
no=item_index(1)
if no=1 then message "Pas de Modif pour cette ligne":gosub jaune:return
on_click 5,modilib
on_click 9,montant
on_click 8,modidest
goto suite

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

seldest:
dest$(no)=item_index$(7)
hide 7:gosub jaune:gosub vert
clear 1:gosub addlist
return

montant:
text 23,""
inactive 5:inactive 8:inactive 9:inactive 10:inactive 14
if no=1 then inactive 9:return
if cod$(no)="CHA" then mt=0:mt$(no)="0.00":return
show 23:set_focus 23
on_change 23,montan
print_target_is 0
print_locate 980,520:print "Entrez le Montant"
print_target_is 1
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
mt$(no)=str$(mt)
gosub nvsld
print_target_is 0
print_locate 980,520:print string$(42," ")
print_target_is 1
hide 23:hide 24
clear 1:gosub addlist
return

nvsld:
gosub solde
nvs:
no=no+1
if no>111 then terminate
if nlig$(no)="" then return
gosub solde
goto nvs

modilib:
gosub vert
inactive 5:inactive 8:inactive 9:inactive 10:inactive 14
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$
hide 27:hide 31:gosub vert
clear 1:gosub addlist
return

demar:
inactive 14:inactive 11
gosub chargecode:nr=1
gosub ligreport:gosub addlist:no=1
gosub rpca:nr=0
cont:
nr=nr+1
if nr>99 then goto suite
if ca$(nr)="" then goto cont
wait 500
nc=val(ca$(nr))
no=no+1
if no>111 then message "plus de place pour une nouvelle Opération":terminate
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)
a$=dvc$(nc):b$=mid$(date$,4,2):c$=right$(date$,2)
datoper$(no)=a$+"/"+b$+"/"+c$
cod$(no)=cdc$(nc):lib$(no)=libc$(nc)
mr$(no)=mrc$(nc):op$(no)=opc$(nc)
gosub piece:gosub minmax
util$(no)=utilc$(nc):dest$(no)=desc$(nc):fam$(no)=famc$(nc):cat$(no)=catc$(nc)
mt$(no)=mtc$(nc)
gosub optermine
gosub solde
clear 1:gosub addlist
goto cont
return

optermine:
if piece$(no)="Terminé" then mt=0:mt$(no)="0.00":oac$(nc)="N"
if piece$(no)="Terminé" then message "le code "+lib$(no)+" est terminé. Si vous souhaitez le prolonger vous pouvez l'utiliser dans les enregistrements classiques. Le code est enlevé des opératios automatiques"
return

rpca:
nr=nr+1
if nr>99 then return
if oac$(nr)="O" and cbkc$(nr)=cpt$(ncpt) then ca$(nr)=str$(nr)
goto rpca


solde:
mt=val(mt$(no))
a= val(sld$(no-1))
if op$(no)="-" then c=a-mt
if op$(no)="+" then c=a+mt
a$=str$(c)
sld$(no)=a$:sldcpt$(ncpt)=a$
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

piece:
if cod$(no)="CHA" then piece$(no)="ANNULE"
if mid$(piece$(no),4,1)="/" then return
if mr$(no)="CH" and op$(no)="-" then 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):return
if mr$(no)="RG" and op$(no)="+" then piece$(no)=datoper$(no):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=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
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,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

nouvfich:
a$=left$(fec$(ncpt),4)
an$=mid$(fec$(ncpt),5,2):moi$=mid$(fec$(ncpt),7,2)
gosub nouvmoi
fi$=a$+an$+moi$+".cfp"
fec$(ncpt)=fi$
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

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

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


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

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


Dernière édition par Jean Claude le Mer 23 Sep 2009 - 8:44, édité 5 fois
Revenir en haut Aller en bas
Jean Claude

Jean Claude


Nombre de messages : 5950
Age : 69
Localisation : 83 Var
Date d'inscription : 07/05/2009

CFP les codes Empty
MessageSujet: Re: CFP les codes   CFP les codes EmptyMer 16 Sep 2009 - 9:05

Le 22ème, cfpprlv, pour pointer un rlevé de compte.

Code:
rem cfpprlv

label tf,quit,fin,chargeliste,sauveliste,chargetf03,nrlv,montant,montan,monta
label pmt,pas,pa,recherche,recherch,recherc,recher,reche,rech,fichdep,crop
label chargeoper,sauveoper,nouvfich,nouvan,add1,rose,vert,valid,enreg,rec,suit
label gestioncheque,rechchq,chargechequiers,chargecheque,sauvechequiers,sauvecheque
label recch,ctrch,ctrc,ctrchq,validrlv,erreur

dim sc%
dim a,b,c,n,nu,ncpt,nrlv,l,li,ls,lt,p,trouv,nch,ncq,chq
dim a$,b$,c$,d$,e$,fi$,fil$,nu$,nrlvp$,mtr$,mtp$,fin$,fic$,fik$
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)
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)


left 0,100:top 0,10:width 0,960:height 0,900
font_name 0,"Fixedsys"
list 1:left 1,45:top 1,150:width 1,853:height 1,500

button 2:left 2,50:top 2,20:width 2,210
caption 2,"Démarrer une Recherche"
on_click 2,montant

button 3:left 3,45:top 3,705:width 3,100
caption 3,"Confirmer"
hide 3

edit 4:left 4,280:top 4,56:width 4,100:hide 4

list 8:left 8,290:top 8,58:width 8,100:height 8,20:color 8,200,255,200
hide 8

button 5:left 5,150:top 5,705:width 5,100
caption 5,"Annuler"
hide 5

button 7:left 7,360:top 7,20:width 7,210
caption 7,"Retour au Menu Général"
on_click 7,quit

button 9:left 9,490:top 9,788:width 9,100
caption 9,"Recommencer"
hide 9

button 10:left 10,610:top 10,788:width 10,150
caption 10,"Créer l'Opération"
hide 10

button 11:left 11,680:top 11,20:width 11,210
caption 11,"Validation du relevé"
on_click 11,validrlv

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

trouv=0

end
rem ----------------------------------------------------------------------------
validrlv:
clear 1:gosub vert
print_locate 55,793:print "ATTENTION: Le relevé doit etre complètement Pointé pour continuer. [Entrée]=> continuer"
repeat:sc%=scancode:until sc%=13
fi$=fil$:proga$="cfpcrlv.exe"
file_open_write 1,"cfptf03.cfp"
file_writeln 1,proga$
file_writeln 1,fi$
file_writeln 1,ncpt
file_close 1
execute proga$:goto fin
return

enreg:
fi$=left$(a$,12)
b$=mid$(a$,16,3)
gosub chargeoper
n=val(b$)
ctr$(n)=nrlvp$
c$=right$(piece$(n),6)
if mr$(n)="CH" then gosub gestioncheque
gosub sauveoper
goto rec
return

gestioncheque:
gosub rechchq
sitchk$(nch)="POINTE"
gosub ctrchq
print numchq$(ncq)+" "+bkchq$(ncq)+" "+utilchq$(ncq)+" "+typchq$(ncq)+" "+npchk$(ncq)+" "+ndchk$(ncq)+" "+sitchq$(ncq)
print nchk$(nch)+" "+mtchk$(nch)+" "+datoperchk$(nch)+" "+datvalchk$(nch)+" "+ordrechk$(nch)+" "+sitchk$(nch)
gosub sauvechequiers
gosub sauvecheque
return

ctrchq:
for n=1 to 50
if n>50 then sitchq$(ncq)="PAS TOUT POINTE":typchq$(ncq)="SECONDAIRE":gosub ctrch:return
if sitchk$(n)="EMIS" then sitchq$(ncq)="PAS TOUT POINTE":return
next n

ctrch:
for n=1 to 50
if nchk$(n)="" then goto ctrc
if n>50 then sitchq$(ncq)="TOUT POINTE":typchq$(ncq)="SECONDAIRE":return
if sitchk$(n)<>"POINTE" then return
ctrc:
next n

rechchq:
nch=0:ncq=0
for chq=1 to 10
fic$="cfp"+nu$+"chq.cfp"
gosub chargechequiers
if chq>10 then message "Chèque non trouvé":terminate
if numchq$(chq)<>"" then gosub recch
if nch>0 then ncq=chq :return
next chq
return

recch:
fik$="cf"+nu$+"ch"+numchq$(chq)+".cfp"
gosub chargecheque
for b=1 to 50
if b>50 then return
if nchk$(b)=c$ then nch=b:return
next b
return

valid:
a$=item_index$(1)
gosub vert
print_locate 55,793:print a$+nrlvp$
show 3:show 5
on_click 3,enreg
on_click 5,rec
return

suit:
gosub vert
show 9:on_click 9,rec
show 10:on_click 10,crop
print_locate 55,793:print "Echec de la Recherche. Sélectionnez la bonne Option:"
print " "
return

monta:
hide 2:hide 4
mtr$=str$(a)
gosub pmt
show 8
item_add 8,mtp$
print_locate 45,60:print "Recherche pour un Montant de: "
recherche:
gosub fichdep:gosub rose
recherch:
if file_exists(fi$)=1 then goto recherc
if file_exists(fi$)=0 then gosub nouvfich
goto recherch
recherc:
gosub chargeoper
for n=1 to 111
if n>111 then goto reche
if nlig$(n)="" then goto recher
a=val(mt$(n)):b=val(mtr$)
if ctr$(n)="" and a=b then gosub add1
recher:
next n
reche:
if fin$="O" then goto rech
gosub nouvfich
goto recherc
rech:
if trouv =0 then goto suit
gosub vert
print_locate 55,793:print "Sélectionnez la bonne ligne"
on_click 1,valid
print " "
on_error_goto erreur
return

erreur:

return

vert:
2d_fill_color 200,255,200
2d_rectangle 45,780,900,820
return

add1:
trouv=trouv+1
mtp$=mt$(n):gosub pmt
lt=len(mtp$):l=12-lt
lt=len(lib$(n)):li=37-lt
item_add 1,fi$+" | "+nlig$(n)+" | "+datoper$(n)+" | "+string$(li," ")+lib$(n)+" | "+mr$(n)+op$(n)+" | "+string$(l," ")+mtp$+" |    |"
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

montant:
print_locate 45,60:print "Recherche pour un Montant de: "
hide 2:show 4:set_focus 4
on_change 4,montan
return

pmt:
if a=0 then mtp$="0.00"
p=0: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

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

rose:
2d_fill_color 255,235,235
2d_rectangle 45,110,896,140
print_locate 57,117:print "  FICHIER  |"
print_locate 160,117:print " LIG |"
print_locate 232,117:print " DATE  |"
print_locate 305,117:print "        LIBELLE    ou    MOTIF      |"
print_locate 618,117:print " MR"+chr$(177)+" |"
print_locate 673,117:print "  MONTANT  |"
print_locate 785,117:print " CTR |"
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

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

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,850:print "UTILISATEUR :  "+nomutil$
print_locate 750,850:print date$
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
rem ----------------------------------------------------------------------------
rec:
execute "cfpprlv.exe"
goto fin
quit:
execute "cfpmenug.exe"
fin:
terminate

crop:
hide 9:hide 10
gosub vert
print_locate 55,793:print "ATTENTION: au retour de l'enregistrement de l'opération vous devrez la pointer * [entrée]=>Continuer"
repeat:sc%=scancode:until sc%=13
execute "cfpeomen.exe":terminate
return

montan:
repeat:sc%=scancode:until sc%=13
a$=text$(4)
if a$="" then return
a=val(a$):if a=0 then return
goto monta
return


Dernière édition par Jean Claude le Mer 23 Sep 2009 - 9:54, édité 1 fois
Revenir en haut Aller en bas
Jean Claude

Jean Claude


Nombre de messages : 5950
Age : 69
Localisation : 83 Var
Date d'inscription : 07/05/2009

CFP les codes Empty
MessageSujet: Re: CFP les codes   CFP les codes EmptyMer 16 Sep 2009 - 9:09

Le 23ème, cfpsceop, pour sélectionner le compte sur lequel on va travailler.

Code:
rem cfpsceop

label quit,tf,fin,chcptutil,bk,valid
label chargeliste

dim proga$,nomutil$,motutil$,gradutil$
dim cpt$(9),lcpt$(9),fec$(9),rec$(9),sldcpt$(9)
dim n,nu,fe,a,ncpt
dim nu$,fi$,a$,ty$,nc$,an$,mo$

left 0,223
top 0,182
width 0,550
height 0,492
caption 0,"COMPTE FAMILIALE  *  Sélection d'un Compte  *"
 
button 1
left 1,227
top 1,300
caption 1,"RETOUR"
on_click 1,quit

combo 2
left 2,131
top 2,68
width 2,258
gosub tf:gosub chcptutil
for n=1 to 8
item_add 2,cpt$(n)+" => "+lcpt$(n)
next n
on_click 2,bk

button 3
left 3,227
top 3,247
caption 3,"VALIDER"
on_click 3,valid
inactive 3

font_name 0,"Fixedsys"
2d_fill_color 240,235,235
2d_rectangle 10,10,530,50
print_locate 55,20:print "Sélectionnez le Compte sur lequel vous voulez travailler."


end

rem ---------------------------------------------------------------------------
valid:
inactive 2
print_locate 20,150:print string$(200," ")
print_locate 20,150:print proga$
ncpt=n
ty$=mid$(cpt$(n),2,1)
print ty$
print ncpt
if ty$="A" and proga$="cfpmenug" then proga$="cfpeoanu.exe"
if ty$="M" and proga$="cfpmenug" then proga$="cfpeomen.exe"
if ty$="R" then message "Pas encore disponible":goto fin : rem proga$="cfpeorev"
print proga$
file_open_write 1,"cfptf03.cfp"
file_writeln 1,proga$
file_writeln 1,fi$
file_writeln 1,ncpt
file_close 1
execute proga$:goto fin
return

bk:
a$=text$(2)
n=item_index(2)
if cpt$(n)="" then message "Sélection Vide":return
print_locate 20,150:print string$(60," ")
print_locate 20,150:print "Vous travaillez sur le Compte: "+cpt$(n)+" => "+lcpt$(n)
active 3
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 d'ouvert":goto fin
if fe=1 then gosub chargeliste:return
return

rem ---------------------------------------------------------------------------
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

sauveliste:
file_open_write 1,fi$
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

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,435:print "UTILISATEUR: "+nomutil$
print_locate 460,435:print date$
return
rem ---------------------------------------------------------------------------
quit:
execute proga$
fin:
terminate


Dernière édition par Jean Claude le Mer 23 Sep 2009 - 8:46, édité 2 fois
Revenir en haut Aller en bas
Jean Claude

Jean Claude


Nombre de messages : 5950
Age : 69
Localisation : 83 Var
Date d'inscription : 07/05/2009

CFP les codes Empty
MessageSujet: Re: CFP les codes   CFP les codes EmptyMer 16 Sep 2009 - 9:19

Le 25 ème, cfpsucat, pour supprimer une catégorie.

Code:
rem cfpsucat

label quit,aide,tf,addlist,fin,selfam,rpcv,cont,selcat,enreg
label sauvefam,chargefam,chargecat,sauvecat

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

left 0,80
top 0,180
width 0,700
height 0,492
caption 0,"COMTE FAMILIALE * Suppression d'une Catégorie *"
 
button 1
left 1,560
top 1,9
width 1,20
height 1,20
caption 1,"?"
on_click 1,aide

button 2
left 2,20
top 2,380
width 2,90
caption 2,"Retour au Menu"
on_click 2,quit

alpha 3
left 3,57
top 3,24
caption 3,"Liste des Familles"

list 4
left 4,20
top 4,50
width 4,170
height 4,270
on_click 4,selfam

alpha 5
left 5,255
top 5,24
caption 5,"Liste des Catégories"

list 6
left 6,217
top 6,50
width 6,190
height 6,270
on_click 6,selcat

alpha 7
left 7,420
top 7,80
hide 7

button 10
left 10,500
top 10,110
caption 10,"Supprimer"
hide 10
on_click 10,enreg

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

gosub tf:gosub chargefam: gosub addlist:gosub aide

end
rem ----------------------------------------------------------------------------
aide:
show 12
print_target_is 12
print_locate 10,10:print "Pour Supprimer une Catégorie, vous devez commencer par sélectionner une Famille."
print_locate 10,30:print "Dans la Fenêtre [Liste des Catégories] sélectionnez la Categorie à Supprimer"
print_locate 10,90:print "Validez la Suppression de la Catégorie en cliquant sur le bouton [Supprimer]"
print_locate 10,210:print "MISE EN GARDE: il est déconseillé de Supprimer une Catégorie, car vous ne"
print_locate 102,230:print "pourrez plus avoir les Statistiques correspondantes"
print_target_is 0
return


enreg:
cat$(nc)=""
gosub sauvecat
execute cfpsucat.exe
goto fin
return

selcat:
hide 12
inactive 4:show 7
n=item_index(6):nc=n
a$=item_index$(6)
if cat$(n)="" then message "Sélection Vide":return
caption 7,"Suppression de "+a$
inactive 6 :show 10
return

selfam:
pas=pas+1:if pas >1 then clear 6
hide 12
n=item_index(4):nf=n
a$=item_index$(4)
if a$="" then message "Sélection Vide":return
l=len(fam$(n)):afam$=left$(fam$(n),l-1)
fi$=fifam$(nf)
gosub chargecat
for n=1 to 15
item_add 6,cat$(n)
next n
gosub rpcv
print_locate 202,50:print "  "
print_locate 202,50:print n-1
return

rpcv:
for n=1 to 20
if cat$(n)="" then return
next n
return
return

addlist:
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 4,afam$
afam$=""
next n
print_locate 7,50:print "  "
print_locate 7,50:print nf
return

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

sauvecat:
file_open_write 1,fi$
for n=1 to 15
file_writeln 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 cfpgcat.exe
fin:
terminate
Revenir en haut Aller en bas
Contenu sponsorisé





CFP les codes Empty
MessageSujet: Re: CFP les codes   CFP les codes Empty

Revenir en haut Aller en bas
 
CFP les codes
Revenir en haut 
Page 1 sur 2Aller à la page : 1, 2  Suivant
 Sujets similaires
-
» Calcul CRC pour Modbus RTU
» Sauvegarde des Codes
» DUO Panoramic : Editeur de codes et Constructeur d'objets
» Codes pas bien compliqué
» liste des codes NUMBER_ERROR

Permission de ce forum:Vous ne pouvez pas répondre aux sujets dans ce forum
FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC :: PANORAMIC :: Vos sources, vos utilitaires à partager-
Sauter vers: