Formatage de nombre comme "#.###.###,##"

dim indexCodag%,longueurcodage%,NbDecimal%
dim n,nbTravail,zeronegatif,retourN ,nCoder
dim virg$,using$,codag$,chiffre$,separation$,entier$,decimal$

label using,go,fin

virg$=",":separation$="'"
' data pour faire des essais sur différents nombres
data .12,12354.215,5428.2,123,578452.2569,985487542,1.25,87,-1572.5 ,0
button 2:left 2,450:top 2,300 :caption 2,"essai":on_click 2,go

 using$="#'###,##"
 n=1948.2501:gosub using :print codag$ ;"          n était:";retourN
 n=-.487  :gosub using  :print codag$ ;"          n était:";retourN
 n=-0.5787  :gosub using  :print codag$ ;"          n était:";retourN
 print:print
end

go:
  using$="##'###'###'###,##"
  read n :if n=0 then goto fin
  gosub using
  print codag$ ;"          n était:";retourN ;"  n est devenu=";nCoder
return


' Pour faire appel à cette routine: définir using$ le nombre à envoyer est "n"

' au retour récupérer la variable codag$ qui a formatée le nombre
' retourN était le nombre envoyé
' nCoder est le nombre envoyé puis arrondi au formatage, peut-être repris
'      pour les calculs

using:
  retourN=n    :' seulement récuperer le nombre de départ non formaté
  nbTravail=n
  NbDecimal%=len(using$)-instr(using$,virg$) : zeronegatif=0
  if left$(str$(nbTravail),3)="-0." then zeronegatif=1
  nbTravail=int(nbTravail*power(10,NbDecimal%)+.5) :nCoder=nbTravail/power(10,NbDecimal%): codag$=str$(nbTravail)
  if zeronegatif=1 then codag$="-0"+mid$(codag$,2,len(codag$)-1)
  longueurcodage%=len(codag$) : decimal$=right$(codag$,NbDecimal%)
  codag$="              "+left$(codag$,instr(codag$,decimal$)-1)
  longueurcodage%=instr(using$,virg$)-1:indexCodag%=len(codag$):entier$=""
  while longueurcodage%>1
    if indexCodag%>0
        chiffre$=mid$(codag$,indexCodag%,1)
        if chiffre$=" " and indexCodag%=len(codag$)
          entier$="0"
        else
          if mid$(using$,longueurcodage%,1)=separation$
              if chiffre$=" "
                entier$=chiffre$+" "+entier$
              else
                entier$=chiffre$+separation$+entier$
              end_if
              longueurcodage%=longueurcodage%-1
          else
              entier$=chiffre$ + entier$
          end_if
        end_if
    else
          entier$=" "+entier$
    end_if
    indexCodag%=indexCodag%-1 : longueurcodage%=longueurcodage%-1
  end_while
  codag$=entier$+virg$+decimal$
 return

 fin:
 message "sortie"
 terminate

' à inclure dans les dim et labels du programme (vérifier si il y a doublon)
dim indexCodag%,longueurcodage%,NbDecimal%
dim n,nbTravail,zeronegatif,retourN ,nCoder[color=brown]
dim virg$,using$,codag$,chiffre$,separation$,entier$,decimal$

dim n :rem variable de transfert pour formater le nombre à voir si doublon VARIABLE SIMPLE pour faciliter la 
'      programmation

label using :rem à rajouter

rem déclaration
virg$=",":separation$="'" :' à modifier selon ses préférences
using$="##'###'###'###,##":' idem


rem REM rem **Ligne suivante à retirer** REM rem REM 
' exemple: (n est le nombre à formater et using$ la représentation)
using$="##'###'###,##":rem séparations et virgule identiques aux variables
n=-128.5487962 : gosub using : print codag$



' routine de codage du nombre n, selon le format "using$"
' PARTIE à INCLURE DANS LE PROGRAMME

using:
  retourN=n    :' seulement récuperer le nombre de départ non formaté
  nbTravail=n
  NbDecimal%=len(using$)-instr(using$,virg$) : zeronegatif=0
  if left$(str$(nbTravail),3)="-0." then zeronegatif=1
  nbTravail=int(nbTravail*power(10,NbDecimal%)+.5) :nCoder=nbTravail/power(10,NbDecimal%): codag$=str$(nbTravail)
  if zeronegatif=1 then codag$="-0"+mid$(codag$,2,len(codag$)-1)
  longueurcodage%=len(codag$) : decimal$=right$(codag$,NbDecimal%)
  codag$="              "+left$(codag$,instr(codag$,decimal$)-1)
  longueurcodage%=instr(using$,virg$)-1:indexCodag%=len(codag$):entier$=""
  while longueurcodage%>1
    if indexCodag%>0
        chiffre$=mid$(codag$,indexCodag%,1)
        if chiffre$=" " and indexCodag%=len(codag$)
          entier$="0"
        else
          if mid$(using$,longueurcodage%,1)=separation$
              if chiffre$=" "
                entier$=chiffre$+" "+entier$
              else
                entier$=chiffre$+separation$+entier$
              end_if
              longueurcodage%=longueurcodage%-1
          else
              entier$=chiffre$ + entier$
          end_if
        end_if
    else
          entier$=" "+entier$
    end_if
    indexCodag%=indexCodag%-1 : longueurcodage%=longueurcodage%-1
  end_while
  codag$=entier$+virg$+decimal$
 return

rem programme USING ###.## version 2
' =============insertion au du programme========================================
' dim à rajouter (attention au doublon)
dim indexCodag%,longueurcodage%,NbDecimal%
dim nbTravail,zeronegatif,retourN ,nCoder
dim virg$,sansVirg$,using$,codag$,chiffre$,separation$,entier$,decimal$
dim n : rem variable de transfert pour la routine
' dim du programme normal
dim a%

label using  :rem label à rajouter

rem DÉFINITION des caractères à pour séparer les mille.. et la virgule
rem dans ce programme, la SYNTAXE de using est toujours la même

separation$="'" : virg$="," :' c'est ici que l'on choisi la virgule (peut avoir plusieurs caractères)
using$="#.###.###.###,##"  :' ATTENTION la virgule est toujours "," pour using

' ========20 lignes qui ne font pas parties du programme mais explique==========

' Pour faire appel à cette routine: définir using$ le nombre à envoyer est "n"

' au retour récupérer la variable codag$ qui a formatée le nombre
' retourN était le nombre envoyé
' nCoder est le nombre envoyé puis arrondi au formatage, peut-être repris
'      pour les calculs
' ==============================================================================
'        _____9 lignes d'essais__+ END________________
memo 1:width 1,580:height 1,400  :print_target_is 1:font_name 1,"Courier New"
data 1, 1.12 , 15.24 , 5484.25 , 158  ,8957.54 , 5687956.54, 6.45879 , 0.2548
data 12 , 5.28 , 15.478 , 678.5 , 0
data 15 , 125 , 5
for a%=1 to 9:read n :gosub using :print codag$,"      retourN:",retourN,"          nCoder:",nCoder  :next a%
print :print "changement de virgule et using$" : using$="####,#":virg$="."
for a%=1 to 5:read n :gosub using :print codag$,"      retourN:",retourN,"          nCoder:",nCoder  :next a%
print:print "virgule texte":using$="#.###":virg$="litres"
for a%=1 to 3:read n :gosub using :print codag$,"      retourN:",retourN,"          nCoder:",nCoder  :next a%

end
' ================insertion de la sous-routine==================================
using:
  retourN=n    :' seulement récuperer le nombre de départ non formaté
  nbTravail=n  :decimal$="":sansVirg$=virg$
  NbDecimal%=len(using$)-instr(using$,",") : zeronegatif=0 :if instr(using$,",")=0 then NbDecimal%=0:sansVirg$=""
  if left$(str$(nbTravail),3)="-0." then zeronegatif=1
  nbTravail=int(nbTravail*power(10,NbDecimal%)+.5) :nCoder=nbTravail/power(10,NbDecimal%): codag$=str$(nbTravail)
  if zeronegatif=1 then codag$="-0"+mid$(codag$,2,len(codag$)-1)

  if NbDecimal%>0 then decimal$=right$(codag$,NbDecimal%):' ici if remplacer la virgule
  if NbDecimal%>0
    codag$="              "+left$(codag$,instr(codag$,decimal$)-1)
    longueurcodage%=instr(using$,","):indexCodag%=len(codag$):entier$="" :message "long ="+str$(longueurcodage%)
  else
    codag$="              "+codag$
    longueurcodage%=len(using$):indexCodag%=len(codag$):entier$=""
  end_if

  while longueurcodage%>1
    if indexCodag%>0
        chiffre$=mid$(codag$,indexCodag%,1)
        if chiffre$=" " and indexCodag%=len(codag$)
          entier$="0"
        else
          if mid$(using$,longueurcodage%,1)="."
              if chiffre$=" "
                entier$=chiffre$+" "+entier$
              else
                entier$=chiffre$+separation$+entier$
              end_if
              longueurcodage%=longueurcodage%-1
          else
              entier$=chiffre$ + entier$
          end_if
        end_if
    else
          entier$=" "+entier$
    end_if

    indexCodag%=indexCodag%-1 : longueurcodage%=longueurcodage%-1
  end_while
  codag$=entier$+sansVirg$+decimal$
 return
' ==============================================================================