2 BUGS (peut-être)

' création simplifiée d'un tableau. Jean Claude (Janvier 2010)

' ========================= DIM et LABEL =======================================

' les variables nécessaires au programme
dim format_nombre$,a$,limit$,nombre$,alignement$,v$,esp$
dim tableau$,vtab$,ptab$,printligne$
dim n,ne,nbe,nl,let,lg,ln,lt,lv,lv2,nombre,nbcav,limit,nbzav,nbzap,ypos

' vos éléments tableau
dim nlig$,libel$,op$,montant$,solde$,ligne$(10)
dim li,maxli
' tableau$="| N° Ligne  | Motif (Libèllé) | Montant | Solde |"
dim montant,solde

' vos label(s)
label fin,Nligne,entree_donnees,motif,mtf,op1,op2,op3,mt1,mt2

' les label(s) "obligatoires" pour les 2 routines (using et tab)
label nombre,recheche_la_virgule,sans_virgule,avec_virgule
label tabulation,alignement_gauche,alignement_droit,alignement_centre,affiche

' ============================= FORM et OBJETS =================================

top 0,200:left 0,200:width 0,950:height 0,600:caption 0,"TABLEAU AUTOMATIQUE"
list 1:top 1,50:left 1,50:width 1,800:height 1,300:font_name 1,"fixedsys"
edit 2:top 2,400:left 2,50
alpha 3:top 3,380:left 3,50:caption 3, "Entrée des données"
memo 4:top 4,380:left 4,200:width 4,650:height 4,50
print_target_is 4
' ==============================================================================
nbe=0:' remise à zéro du nombre d'éléments du tableau
solde=0: ' solde au démarrage
gosub entree_donnees: ' entrée des données du tableau
end
' ==============================================================================
'                LE PROGAMME création simplifiée d'un tableau
'                --------------------------------------------
entree_donnees:
ne=1: ' initialisation au premier élément du tableau
printligne$=""
li=li+1:maxli=10
' 1) définir le tableau ( "|" ce signe est obligatoire entre chaque élément du tableau)
tableau$="| N° Lig  |  Motif (Libèllé)  | OP  |    Montant    |    Solde    |" :' le tableau
' ------------------------------
' 2) le N° de Ligne (variable nl)
format_nombre$="###":' ici on definie le format de la variable nl pour son affichage
alignement$="G": ' choix de l'alignement - G=gauche, C=centrée, D=droite
gosub Nligne: ' le N° de ligne est automatique (Pas de saisie)
printligne$=printligne$+ptab$
' ------------------------------
' maintenant le Motif (2ème élément du tablau) par saisie de l'utilisateur
print_target_is 4: ' le memo 4 sert au indications pour l'utilisateur
print:print " <== Entrez le Motif de la dépense ou de la recette "
set_focus 2:on_key_up 2,motif
return

motif:
if key_up_code=13 then a$=upper$(text$(2)):gosub mtf
return

mtf:
' saisie du Motif
if len(a$)>18 then message "20 Caractéres Maximun":return' limitation de libel$
libel$=a$:vtab$=libel$:alignement$="C"
gosub tabulation
gosub affiche
' saisie de l'opérateur
clear 4:print_target_is 4: print:print " <== Entrez + pour une recette ou - pour une dépense "
a$="":text 2,"":set_focus 2:on_key_up 2,op1
return

op1:
if key_up_code=13 then a$=text$(2):gosub op2
return

op2:
if a$="+" or a$="-" then goto op3
message "Attendu + ou -":text 2,"":a$="":return
op3:
op$=a$:vtab$=op$:alignement$="C"
gosub tabulation
gosub affiche
' saisie du montant de l'opération
clear 4:print_target_is 4: print:print " <== Entrez le Montant de l'opération "
a$="":text 2,"":set_focus 2:on_key_up 2,mt1
return

mt1:
if key_up_code=13 then a$=text$(2):gosub mt2
return

mt2:
if numeric(a$)=0 then message "vous devez entrer un montant":text 2,"":a$="":return
montant=val(a$)
if montant>9999999 then message "Entrez un montant < à 10.000.000:text 2,"":a$="":return
nombre=montant:format_nombre$="&#######.##":gosub nombre
montant$=nombre$:vtab$=montant$:alignement$="D":gosub tabulation
gosub affiche
if op$="+" then solde=solde+montant
if op$="-" then solde=solde-montant
nombre=solde:format_nombre$="&#######.##":gosub nombre
solde$=nombre$:vtab$=solde$:alignement$="D":gosub tabulation
gosub affiche
ligne$(li)=printligne$:text 2,""
goto entree_donnees
return

Nligne:
nl=nl+1: ' valeur de la variable nl (N° de ligne)
nombre=nl: ' c'est la variable nl qui va être formatée (on la passe dans la variable nombre)
gosub nombre:' execute le sous programme de formatage nombre
nlig$=nombre$: ' on remet le valeur dans la bonne variable
vtab$=nlig$: '  on transfert nlig$ dans vtab$ pour le traitement
gosub tabulation:' ensuite execute le Sous Prog de Formatage variable pour tableau (TAB)
gosub affiche
return

affiche:
clear 1:print_target_is 1:print tableau$
for li=1 to maxli
if ligne$(li)="" then exit_for
print ligne$(li)
next li
printligne$=printligne$+ptab$:ptab$="":vtab$="": ' création de la ligne tableau
print printligne$: ' Affichage dans le memo
return

' ==============================================================================
'                  Sous Prog de Formatage variable pour tableau (TAB)
' ==============================================================================
tabulation:
n=0:lv=0:lt=0:let=0:a$="":ptab$="":ypos=0
lt=len(tableau$)
nbe=1:ne=ne+1:' incrémente le numéro de l'élément
for n=1 to lt
a$=mid$(tableau$,n,1)
if a$="|" then nbe=nbe+1
if ne=nbe then ypos=n+1:exit_for:'défini la position Y de l'élément
a$=""
next n
for n=ypos to lt
a$=mid$(tableau$,n,1)
if a$="|" then exit_for: ' défini la longueur de l'élément
let=let+1
next n
if alignement$<>"G" and alignement$<>"D" and alignement$<>"C" then message " "+alignement$+" est un Nom d'alignement incorrect":terminate
if alignement$="G" then gosub alignement_gauche
if alignement$="D" then gosub alignement_droit
if alignement$="C" then gosub alignement_centre
return

alignement_centre:
lv=len(vtab$):if lv>(let-2) then message "Longueur élément > largeur tableau":terminate
if even(lv)=1 then n=(let-lv)/2
if even(lv)=0 then n=(let-lv)/2
if ne=2 and frac(n)=0 then ptab$="|"+string$(n," ")+vtab$+string$(n," ")+"|"
if ne=2 and frac(n)<>0 then n=n+0.5:ptab$="|"+string$(n," ")+vtab$+string$(n-1," ")+"|"
if ne>2 and frac(n)=0 then ptab$=string$(n," ")+vtab$+string$(n," ")+"|"
if ne>2 and frac(n)<>0 then n=n+0.5:ptab$=string$(n," ")+vtab$+string$(n-1," ")+"|"
return

alignement_droit:
lv=len(vtab$):if lv>(let-2) then message "Longueur élément > largeur tableau":terminate
if ne=2 then ptab$="|"+string$(let-(lv+1)," ")+vtab$+" |"
if ne>2 then ptab$=string$(let-(lv+1)," ")+vtab$+" |"
return

alignement_gauche:
lv=len(vtab$):if lv>(let-2) then message "Longueur élément > largeur tableau":terminate
if ne=2 then ptab$="| "+vtab$+string$(let-(lv+1)," ")+"|"
if ne>2 then ptab$=" "+vtab$+string$(let-(lv+1)," ")+"|"
return

' ==============================================================================
'                  Sous Prog de Formatage nombre (genre USING)
' ==============================================================================
nombre:
' if nombre<0 then nombre$=str$(nombre):return
v$="":a$="":limit$="":nombre$="":n=0:lg=0:ln=0:nbcav=0:limit=0:nbzav=0:nbzap=0
if left$(format_nombre$,1)="&" then esp$=" "
if left$(format_nombre$,1)<>"&" then esp$="0"
lg=len(format_nombre$)
if lg=0 then message "Format nombre incorrect (longeur format = 0)":terminate
gosub recheche_la_virgule:' controle de la longeur du format et du nombre de chiffre après la virgule
if v$="OK" and nbcav=0 then message "Format nombre incorrect"+chr$(13)+"# oublié après la virgule":terminate
if nbcav>0 then limit$=string$(lg-(nbcav+1),"9")+"."+string$(nbcav,"9"):gosub avec_virgule
if nbcav=0 then limit$=string$(lg-(nbcav),"9"):gosub sans_virgule
limit=val(limit$)
if nombre > limit then message "Format nombre incorrect (valeur > Format)"
return

avec_virgule:
nombre$=str$(nombre):ln=len(nombre$)
for n=1 to ln
a$=mid$(nombre$,n,1)
if a$="."then nbzap=ln-n
if a$<>"." then n=n
next n
lg=lg-1:nbzav=lg-(ln+nbcav)
if nombre<0 then esp$=" "
if nbzap>nbcav then message "Format nombre incorrect: Saisie > nb de zéro après la virgule":terminate
if nbzap>nbcav-1 then nombre$=string$(nbzav,esp$)+nombre$:return
if nbzap=0 then nombre$=string$(nbzav,esp$)+nombre$+".00"
if nbzap>0 then nombre$=string$(nbzav,esp$)+nombre$+string$((nbcav-1),"0")
return

sans_virgule:
lg=lg-1:nbzav=lg
if nbzav=0 then nombre$=str$(nombre)
if nbzav>0 then nombre$=string$(nbzav,esp$)+str$(nombre)
return

recheche_la_virgule:
for n=1 to lg
a$=mid$(format_nombre$,n,1)
if a$="." then nbcav=lg-n:v$="OK"
if a$<>"." and a$<>"#" and a$<>"&" then message "Format nombre incorrect (caractère <> de . ou #)"
next n
return
' ------------------------------------------------------------------------------
fin:
terminate

if a$="."then nbcav=lg-n:v$="OK"

if a$<>"+" or  a$<>"-" then message "Attendu + ou -":text 2,"":a$="":return