Nb: j'ai corrigé le titre car masque de saisie, n'était pas tout à fait correct
A quoi ça sert? à avoir ceci
Voici le début d'un code pour obtenir des masques d'affichage du type 123.860,10 € ou autres, ce module vas être complémentaire à mes autres modules
EditBox
http://www.purebasic.fr/french/viewtopi ... =6&t=14982Table
http://www.purebasic.fr/french/viewtopi ... =3&t=15010Je compte également ajouté des masques alpha type première lettre en majuscule et des masques personnalisés type +33 6 541201 30 ou FR 965.254.410 etc...
Le fonctionnement en gros, on crée le masque (actuellement numérique seulement et en débogage) on teste à chaque modification en envoyant le texte saisi et ça retourne le texte formaté.
Utilisation
;CaractereMasking::SetNumeriqueType --> Crée un masque de type numérique
;Id --> Identifiant du masque (si #Pb_Any l'Id est renvoyé par la procédure)
;DecadeNumber --> Le nombre de dizaines ou #Infinity (-1) si pas prix en compte
;DecimalNumber --> Le nombre de décimales ou #Infinity (-1) si pas prix en compte
;ThousandsSeparator --> Le séparateur des milliers (en code asci) Exemple 46 --> .
;DecimalSeparator --> Le séparateur des décimales (en code asci) Exemple 44 --> ,
;ExtendString$ --> Si vous désirez une extention en début ou fin de chaine Exemple: --> € --> % --> $ etc...
;PositionExtend --> Ou vous voulez vous l'extention --> #FirstPosition en début de chaine -->#EndPosition en fin de chaine
;NegativeOn --> #True Autorise un chiffre négatif --> #False N'autorise pas un chiffre négatif
;CaractereMasking::Free --> Libère le masque de la mémoire
;Id --> Identifiant du masque créer précédement
;Resultat$=CaractereMasking::GiveResult --> Retourne la chaine formatée
;Id --> Identifiant du masque créer précédement
;Txt$--> La chaine à formaté
;Resultat$ --> La chaine formatée
Je ne sais pas si cela pourra vous être utile, moi dans le cadre de certains de mes projets oui.
Le module actuel
Vers Beta 1--> Arrondi maintenant les valeurs (merci Falsam)
Vers Beta 2--> Correction de bug
Vers Beta 3--> Correction de bug, complétion des décimale si nulle
Code : Tout sélectionner
;////////////////////////////////////////////////////////////////////////////////////////////////////////////
; Nom: Masque de saisie et affichage
; Vers B3 du 2015-01-04
;Descrition : Mise en forme d'une chaine de caratere selon un masque donné
; © AllDev / MicrodevWeb / Bielen Pierre
;////////////////////////////////////////////////////////////////////////////////////////////////////////////
DeclareModule CaractereMasking
#Infinity=-1
#None=-1
Enumeration
#FirstPosition
#EndPosition
EndEnumeration
;SetNumeriqueType --> Crée un marque de type numérique
;Id --> Identifiant du masque (si #Pb_Any l'Id est renvoyé par la procédure)
;DecadeNumber --> Le nombre de dizaines ou #Infinity (-1) si pas prix en compte
;DecimalNumber --> Le nombre de décimales ou #Infinity (-1) si pas prix en compte
;ThousandsSeparator --> Le séparateur des milliers (en code asci) Exemple 46 --> .
;DecimalSeparator --> Le séparateur des décimales (en code asci) Exemple 44 --> ,
;ExtendString$ --> Si vous désirez une extention en début ou fin de chaine Exemple: --> € --> % --> $ etc...
;PositionExtend --> Ou vous voulez vous l'extention --> #FirstPosition en début de chaine -->#EndPosition en fin de chaine
;NegativeOn --> #True Autorise un chiffre négatif --> #False N'autorise pas un chiffre négatif
Declare SetNumeriqueType(Id,DecadeNumber.i=#Infinity,DecimalNumber=#Infinity,ThousandsSeparator=46,DecimalSeparator=44,ExtendString$="",PositionExtend=#EndPosition,NegativeOn.b=#True)
;Free --> Libère le masque de la mémoire
;Id --> Identifiant du masque créer précédement
Declare Free(Id)
;Resultat$=GiveResult --> Retourne la chaine formatée
;Id --> Identifiant du masque créer précédement
;Txt$--> La chaine à formaté
;Resultat$ --> La chaine formatée
Declare$ GiveResult(Id,Txt$)
EndDeclareModule
Module CaractereMasking
;-* Constantes
Enumeration Type
#NumeriqueType
#AlphaOnlyType
#AlphaNumeriqueType
#UserType
EndEnumeration
;} FIN
;-* Structures / Map
Structure sMask
smask$
sType.i
sLen.i
sDecadeNumber.i
sDecimalNumber.i
sThousandsSeparator.i
sDecimalSeparator.i
sExtendString$
sPositionExtend.i
sNegativeOn.b
EndStructure
Global NewMap myMask.sMask()
;} FIN Structures
;-* Procédures
Procedure Open(Id,ModeExist.b=#False)
Protected Res
Res=FindMapElement(myMask(),Str(Id))
Select ModeExist
Case #True ; La map doit exister
If Res=0
MessageRequester("Open CaractereMasking","This CaractereMasking not exist...")
ProcedureReturn #False
EndIf
Case #False ;La map ne doit pas exister
If Res<>0
MessageRequester("Open CaractereMasking","This CaractereMasking already exist...")
ProcedureReturn #False
EndIf
EndSelect
ProcedureReturn #True
EndProcedure
Procedure AddMask(Id)
Protected nId
If Id=#PB_Any
While FindMapElement(myMask(),Str(nId))<>0
nId+1
Wend
Else
If Open(Id)
ProcedureReturn #False
EndIf
EndIf
AddMapElement(myMask(),Str(nId))
ProcedureReturn #True
EndProcedure
Procedure Free(Id)
If Not Open(Id):ProcedureReturn #False :EndIf
DeleteMapElement(myMask())
ProcedureReturn #True
EndProcedure
Procedure SetNumeriqueType(Id,DecadeNumber.i=#Infinity,DecimalNumber=#Infinity,ThousandsSeparator=46,DecimalSeparator=44,ExtendString$="",PositionExtend=#EndPosition,NegativeOn.b=#True)
If Not AddMask(Id):ProcedureReturn -1 :EndIf
With myMask()
\sType=#NumeriqueType
\sDecadeNumber=DecadeNumber
\sDecimalNumber=DecimalNumber
\sThousandsSeparator=ThousandsSeparator
\sDecimalSeparator=DecimalSeparator
\sExtendString$=ExtendString$
\sPositionExtend=PositionExtend
\sNegativeOn=NegativeOn
EndWith
ProcedureReturn Val(MapKey(myMask()))
EndProcedure
Procedure$ ManageNumeriqueType(TxtTemp$)
Protected ValRet$,Decade$,Decimal$,Position,N
Protected NumCar$="0,1,2,3,4,5,6,7,8,9",Txt$,Nb,Lg
With myMask()
;{ Retire le signe négatif si il existe
If Left(TxtTemp$,1)="-"
Txt$=Right(TxtTemp$,Len(TxtTemp$)-1)
Else
Txt$=TxtTemp$
EndIf
;} FIN Retire le signe négatif si il existe
;{ Recherche des dizaines et les décimales
Position=FindString(Txt$,".")
Decade$=Txt$
Decimal$=""
If Position<>0
Decade$=Left(Txt$,Position-1)
Decimal$=Right(Txt$,Len(Txt$)-Position)
Else
Position=FindString(Txt$,",")
If Position<>0
Decade$=Left(Txt$,Position-1)
Decimal$=Right(Txt$,Len(Txt$)-Position)
EndIf
EndIf
;} FIN Recherche des dizaines
;{ Redimentionne si plus grand
If \sDecadeNumber<>#Infinity
If Len(Decade$)>\sDecadeNumber
Decade$=Left(Decade$,\sDecadeNumber)
EndIf
EndIf
If \sDecimalNumber<>#Infinity And Len(Decimal$)>0
Txt$=StrD(ValD(Decade$+"."+Decimal$),\sDecimalNumber)
Decade$=Left(Txt$,Len(Decade$))
Decimal$=Right(Txt$,Len(Decimal$))
EndIf
;} FIN Arrondi les valeurs
;{ Formate la chaine
For N=1 To Len(Decade$)
If FindString(NumCar$,Mid(Decade$,N,1))<>0
ValRet$+Mid(Decade$,N,1)
EndIf
Next
If Len(Decimal$)>0
ValRet$+Chr(\sDecimalSeparator)
For N=1 To Len(Decimal$)
If FindString(NumCar$,Mid(Decimal$,N,1))<>0
ValRet$+Mid(Decimal$,N,1)
EndIf
Next
Else
ValRet$+Chr(\sDecimalSeparator)
For N=1 To \sDecimalNumber
ValRet$+"0"
Next
EndIf
;Ajout des points de séparation des milliers
Protected NbThousand=Int(Len(Decade$)/3)
For N=1 To NbThousand
If Len(Decade$)>(N*3)
If Len(Decimal$)>0
Lg=Len(Decade$)-1
Else
Lg=Len(Decade$)
EndIf
ValRet$=InsertString(ValRet$,Chr(\sThousandsSeparator),(Lg-(N*3))+1)
EndIf
Next
;} FIN formate la chaine
;{ Ajout d'une extention si elle existe
If Len(\sExtendString$)>0
Select \sPositionExtend
Case #FirstPosition
ValRet$=\sExtendString$+ValRet$
Case #EndPosition
ValRet$+\sExtendString$
EndSelect
EndIf
;} FIN Ajout d'une extention si elle existe
EndWith
ProcedureReturn ValRet$
EndProcedure
Procedure$ GiveResult(Id,Txt$)
Protected ValRet$
If Not Open(Id,#True):ProcedureReturn "":EndIf
With myMask()
Select \sType
Case #NumeriqueType
ValRet$=ManageNumeriqueType(Txt$)
Case #AlphaOnlyType
Case #AlphaNumeriqueType
Case #UserType
EndSelect
EndWith
ProcedureReturn ValRet$
EndProcedure
;} FIN Procédures
EndModule
Code : Tout sélectionner
XIncludeFile "CaractereMasking.pbi"
Teste=CaractereMasking::SetNumeriqueType(#PB_Any,6,2,46,44," "+Chr(128),CaractereMasking::#EndPosition,#False)
Debug CaractereMasking::GiveResult(Teste,"123580.499")
) 
