Saisie numérique dans un string gadget avec 1 à n décimales

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Avatar de l’utilisateur
GeBonet
Messages : 453
Inscription : ven. 29/févr./2008 16:17
Localisation : Belgique

Re: Saisie numérique dans un string gadget avec 1 à n décima

Message par GeBonet »

Aucune apparemment... Sauf une mise en forme et l'introduction d'un taux de TVA...
Quand à ton code MLD il est très valable aussi... Tout comme il y en à d'autre comme le disait Dobro.
Et comme celui-ci aussi, existant depuis un an... Du site officiel et British ! L'as tu vues celle là ?
http://www.purebasic.fr/english/viewtop ... tF#p319639

Code : Tout sélectionner

; Format Library
; written by Frank Hoogerbeets
; website: http://www.ditrianum.org
; e-mail: info@ditrianum.org
EnableExplicit
Define x.d
;{ DOCUMENTATION
; -----------------------------------------------------------------------
;                            FormatI, FormatF, FormatD
;
; Syntax  :            FormatX(Value, Format$)
;
; Parameters
;     Value     - number to be formatted
;     Format$   - format defintion
;
; Usage  :           Use the following symbols to define a format:
;
;       #   - digit placeholder
;       .   - as rightmost occurance, decimal point
;       ,   - as rightmost occurance, decimal comma
;       0   - as first character, fills leading placeholders with zeros
;       /   - as first character, removes leading placeholders
;
;     Any other character will be part of the format
;
; Note 1  :  Make sure to provide sufficient placeholders for a given number.
;
;       Example:  FormatI(21, "#") returns "1", not "21"
;                        FormatI(21, "##") returns "21"
;                        FormatI(21, "####") returns "  21"
;                        FormatI(21, "/####") returns "21"
;                        FormatI(-1, "#") returns "1"
;                        FormatI(-1, "##") returns "-1"
;
; Note 2 :    The number of placeholders behind the decimal point or comma
;                  determines the number of digits of the decimal part.
;       Example:  FormatD(2/3, "#.##") returns "0.67"
;                        FormatD(2/3, "#.####") returns "0.6667"
;                        FormatD(1/3, "#.##") returns "0.33"
;                        FormatD(1/3, "#.####") returns "0.3333"
;       Examples
;                         See below
; -----------------------------------------------------------------------
;}
Structure CharacterType
    c.c[0]
EndStructure
; ------------------------------------------------------------------------------
;- INTERNAL PROCEDURES:
Procedure.i Format_mDecPoint(*TFormat.CharacterType)
    ;return position of decimal point/comma
    Protected flen = MemoryStringLength(*TFormat) - 1, i.i
    For i = flen To 0 Step -1
        Select *TFormat\c[i]
            Case ',', '.'
                ProcedureReturn flen - i + 1
        EndSelect
    Next
EndProcedure

Procedure.s Format_mRound(Buffer.s, rpos.i)
    Protected fpos.i, ascii.i, result.s, i.i
 
    ; floating point position
    fpos = FindString(Buffer, Chr(46), 1)
    If fpos = 0
        ProcedureReturn Buffer
    EndIf
    result = Left(Buffer, fpos + rpos)
 
    ;get next digit to determine round-off
    If rpos = 0
        result = Left(Buffer, fpos - 1)
    EndIf
    ; < 5 means nothing to round off
    If Val(Mid(Buffer, fpos + rpos + 1, 1)) < 5
        Goto Format_mRound_Exit
    EndIf
 
    ;round off
    For i = Len(result) To 1 Step -1
        ascii = Asc(Mid(result, i, 1))
        Select ascii
            Case 46
                If i = 1
                    result = Chr(49) + result
                    Break
                EndIf
            Case 48 To 56
                result = Left(result, i - 1) + Chr(ascii + 1) + Mid(result, i + 1)
                Break
            Case 57
                result = Left(result, i - 1) + Chr(48) + Mid(result, i + 1)
                If i = 1
                    result = Chr(49) + result
                    Break
                EndIf
        EndSelect
    Next
    Format_mRound_Exit:
    If fpos = 1
        result = Chr(48) + result
    EndIf
    ProcedureReturn result
EndProcedure

Procedure.s Format_mFormat(Buffer.s, Format.s)
    Protected blen.i, flen.i, lzero.i, nospc.i, bdpnt.i, fdpnt.i, n.i
    Protected char.s, result.s, i.i
 
    Select Left(Format, 1)
        Case Chr(47) ;no (leading) space
            nospc = #True
        Case Chr(48) ;leading zero
            lzero = #True
    EndSelect
    ;remove special character if present
    If lzero Or nospc
        Format = Mid(Format, 2)
    EndIf
    flen = Len(Format)
    n = 0
    ;get round-off position (n)
    fdpnt = Format_mDecPoint(@Format)
    If fdpnt > 0
        For i = flen - fdpnt + 2 To flen
            If Mid(Format, i, 1) = Chr(35)
                n + 1
            EndIf
        Next
  EndIf
  Buffer = Format_mRound(Buffer, n)
  blen = Len(Buffer)
  bdpnt = Format_mDecPoint(@Buffer)
  fdpnt = flen - fdpnt + 1
  ; do the part left of the decimal point
  n = blen - bdpnt
    For i = fdpnt - 1 To 1 Step -1
        char = Mid(Format, i, 1)
        Select char
            Case Chr(35)
                If n > 0
                    char = Mid(Buffer, n, 1)
                    n - 1
                ElseIf lzero
                    char = Chr(48)
                ElseIf nospc
                    char = ""
                Else
                    char = Chr(32)
                EndIf
            Case Chr(44), Chr(46)
                If n = 0
                    If nospc
                        char = ""
                    Else
                        char = Chr(32)
                    EndIf
                EndIf
        EndSelect
        result = char + result
    Next
    ; do the part right of the decimal point
    n = blen - bdpnt + 2
    For i = fdpnt To flen
        char = Mid(Format, i, 1)
        Select char
            Case Chr(35)
                If n <= blen
                    char = Mid(Buffer, n, 1)
                     n + 1
                Else
                    char = Chr(48)
                EndIf
        EndSelect
        result + char
  Next
  ProcedureReturn result
EndProcedure

Procedure.s Format_mFloatD(Value.d, Format.s)
    Protected decimals.i
    ;find decimal sign (point or comma)
    decimals = Format_mDecPoint(@Format) - 1
    ;convert to string
    If decimals > 0
        ProcedureReturn StrD(Value, decimals)
    EndIf
    ProcedureReturn Str(Value)
EndProcedure

Procedure.s Format_mFloatF(Value.f, Format.s)
    Protected decimals.i
    ;find decimal sign (point or comma)
    decimals = Format_mDecPoint(@Format) - 1
    ;convert to string
    If decimals > 0
        ProcedureReturn StrF(Value, decimals)
    EndIf
    ProcedureReturn Str(Value)
EndProcedure
;- FORMAT PROCEDURES:
Procedure.s FormatD(Value.d, Format.s)
    Protected Buffer.s = Format_mFloatD(Value, Format)
    ProcedureReturn Format_mFormat(Buffer, Format) 
EndProcedure

Procedure.s FormatF(Value.f, Format.s)
    Protected Buffer.s = Format_mFloatF(Value, Format)
    ProcedureReturn Format_mFormat(Buffer, Format)
EndProcedure

Procedure.s FormatI(Value.q, Format.s)
    Protected Buffer.s = Str(Value)
    ProcedureReturn Format_mFormat(Buffer, Format)
EndProcedure
;- EXAMPLES
;{
; -----------------------------------------------------------------------
;
; ;6-digits precision with decimal *point*
x.d = 33 / 7
Debug x
Debug FormatD(x, "####.###") ;##)
; ;6-digits precision with decimal *comma*
; x.d = 33 / 7
; Debug x
; Debug FormatD(x, "#,######")

; ;leading zeros
; x.l = 75
; Debug FormatI(x, "0####")

; ;decimal notation with integer
; x.l = 75
; Debug FormatI(x, "$####.##")

; ;remove unused leading placeholders
; x.d = 333 / 7
; Debug x
; Debug FormatD(x, "/####.########")
; ;round to integer
; Debug FormatD(x, "/###")

; negative numbers
; Debug FormatD(-1.33435,"##.##")

; Define x.d = -33 / 7
; Debug x
; Debug FormatD(x, "##.######")

; currency notation
; OpenConsole()
;   PrintN(FormatD(1.35, "$ #.###.###,##"))
;   PrintN(FormatD(4895.208, "$ #.###.###,##"))
;   ; remove unused digit placeholders
;   PrintN(FormatD(4895.208, "/$ #.###.###,##"))
;   Input()
; CloseConsole()
; -----------------------------------------------------------------------
;}
; IDE Options = PureBasic 4.51 (Windows - x86)
; CursorPosition = 227
; FirstLine = 212
; Folding = --
; EnableXP
; EnableOnError
; CurrentDirectory = C:\0 0 PureBasic40\PureBasic\
; CompileSourceDirectory
Soit autant de manière que de sensibilité !
Et en faisant un effort je pourrais en trouver une !!! :wink:
Pour moi Le but n'est pas, a mon sens de savoir qui ou quoi est le plus beau, mais d'avoir justement des formes différentes c'est ce qui
donne au forum l'opportunité de montrer la diversité des approches et peut-être a chacun de comprendre mieux l'une ou l'autre approche !
Voir l'utilisation par l'un ou l'autre de l'une ou l'autre expression que l'on n'utilise pas ou oubliée...
Je ne suis pas là pour faire de la compétition, il y a "PurePunch" pour ça :lol:
Mais éventuellement pour partager ou apprendre :wink: Il n'est jamais tôt ou trop tard pour moi en tout cas !
Voilà, voilà !
Gerhard
Windows 7 et Windows 8.1 Pb 5.0 jusque 5.24 Lts 64 et 5.3 (64)/b]
“Ceux qui rêvent éveillés ont conscience de mille choses qui échappent à ceux qui ne rêvent qu’endormis.”
-Edgar Allan Poe-
Avatar de l’utilisateur
MLD
Messages : 1124
Inscription : jeu. 05/févr./2009 17:58
Localisation : Bretagne

Re: Saisie numérique dans un string gadget avec 1 à n décima

Message par MLD »

Bonjour GeBonnet

Te m'éprend pas, je suis 100% ok avec toi. :lol:
Je n'es pas bien compris ce que tu voulais dire dans ton intervention. :(
Bien sur chaque programmeur a sa propre sensibilité, et son approche sur la manière de résoudre un problème, et aussi sa manière de programmer. Il est trés amusant de proposer plusieurs solutions a un même problème. J'ai simplement voulu montrer qu'il n'y avait pas besoin d'un masque de format pour arriver au résulat voulu. :wink:
Sans vouloir faire de la compétition, il me semble qu'il soit intérêssant de faire des programmes court et le plus rapide possible. (Encore un reste du temps ou la quantité de mémoire était plus que limite.)
Bonne journée
Michel
Avatar de l’utilisateur
GeBonet
Messages : 453
Inscription : ven. 29/févr./2008 16:17
Localisation : Belgique

Re: Saisie numérique dans un string gadget avec 1 à n décima

Message par GeBonet »

Ma réponse est venue simplement parce que j'ai cru voir dans ta réponse un sentiment de frustration de ne pas avoir utilisé ou fait mention de ton code (et peut-être à tord) :wink:
Évidement qu'un code code court et répondant à tout ses objectifs est plus intéressant.
En générale c'est d'ailleurs une de mes ancienne pratique... Ou d'abord, je tentais de résoudre le problème puis une fois résolus, seconde ou troisième passe pour tenter d'optimiser et réduite le code un maximum...
Tu sais je viens de 1k à 4k pour mes première bécanes il y a 37 ans, puis 16, 32, 48 et ENFIN 64k... L'abondance de ce moment la jusque dans les années 90 :lol:
On n'avais pas le choix, chaque mots devais être pesé. J'ai des codes de gestions complet de certaine entreprise qui totalisaient entre 300k et 1,2 méga sur une ou deux disquettes de 340k... Aujourd'hui on télécharge allégrement un "mp3" de "seulement" 2 à 5 méga... Plus que les premiers disques dur.
Depuis on a fait du chemin, et surtout au cours des 15 dernières années ou tout à explosé. ON est dans un océan de mémoire et pire tout le monde fonctionne comme si c'était illimité. Et comme c'est à peut près le moment ou j'ai arrêté alors forcément pour moi, je me retrouve avec des drôle de réponses quand je demande certaines fonctions pour l'accès direct à un enregistrement par exemple, ou on me réponds "pourquoi t'embêter avec ça, charge le fichier ENTIER en mémoire"... Et c'est vrai du moins en partie quand on ne doit pas partager en simultané le fichier dans un réseau... Ou là, c'est pour bien faire seulement l'enregistrement qu'il faut bloquer (Lock Record et Unlock Record) et non le fichier entier.

Aussi, je ne peux qu'adhérer sur un code plus court et optimisé, comme le fait de montrer des alternatives utilisant d'autres "fonctions" permet de voir ou peuvent s'inscrire des formes peut ou pas utilisées, oublié et même ne sachant pas qu'elle existent parce pas lu les 900 et plus pages du manuel, ni même l'index. :wink:
Ou encore ajouter a un code une ou l'autre chose qui lui donne une forme plus "normale" d'utilisation et dans ce cas par exemple, entrer le code Tva et non le figer.
Et soit dit en passant, cette fonction de "Using" devraient exister en natif. :wink:
La dessus, merci de la réponse et excuse moi si je t'ai offensé c'était pas mon attention !
voilà, voilà, et a ++
Gerhard
Windows 7 et Windows 8.1 Pb 5.0 jusque 5.24 Lts 64 et 5.3 (64)/b]
“Ceux qui rêvent éveillés ont conscience de mille choses qui échappent à ceux qui ne rêvent qu’endormis.”
-Edgar Allan Poe-
anissa
Messages : 136
Inscription : mer. 13/oct./2010 15:43

Re: Saisie numérique dans un string gadget avec 1 à n décima

Message par anissa »

Personnellement, je n'ai pas de problème de ce côté là car j'ai tout préparé au début même avant de m'engager dans le développement de vrais logiciels. Exemple :

J'ai créé des procédures qui permettent de savoir si un champ est:
numérique, décimal, entier, chaine valide, etc...
J'ai également créé des procédures qui permettent d'aligner et de formater des nbres:
(alignement à droite, séparer les milliers, choisir le nbre de décimal etc..)

Donc on peut saisir n'importe quoi dans un gadget string mais je passe toujours par une procédure de contrôle de saisie avant d'enregistrer l'enregistrement (ajout ou modif).

Il suffit simplement de faire ceci:

If ErrorFound(N_Proc$)
MessageRequester ("Erreur de saisie",ErrorMsg$)
EndIf

If NbreEntier(Champ$)
Debug "C'est un nbre entier"
EndIf

If NbreDecimal(Champ$)
Debug "C'est un nbre décimal à :" + Str(wDec)
EndIf

If IsNumeric(Champ$)
Debug "C'est un numérique" ; avec ou sans décimaux
EndIf

If ChaineValide(Champ$)
Debug "Chaîne de caractères correcte"
EndIf

If SeparerLesMilliers
Separer_Les_Milliers(Champ$,nDec)
EndIf

If AlignerChaine
AlignerChaine(Champ$,Align$)
EndIf

Je suis tranquille de ce côté là à chaque fois que je trouve un obstacle de ce genre dans Pb
je crée alors une solution commune que j'utiliserais dans le futur.

Voilà

S'il y a des suggestions ou conseils ; bienvenus
Le Soldat Inconnu
Messages : 4312
Inscription : mer. 28/janv./2004 20:58
Localisation : Clermont ferrand OU Olsztyn
Contact :

Re: Saisie numérique dans un string gadget avec 1 à n décima

Message par Le Soldat Inconnu »

Impossible de rééditer une valeur, il y a un truc qui ne va pas.

Je tape un montant, je clic sur TTC, je reviens sur HT pour modifier et plus rien ne fonctionne.

pourr idée, voici un code qui laisse le temps à l'utilisateur de faire sa modification d'une valeur avant de la corriger. Ci cela peut t'aider. Moi je vais au lit, je te laisse bosser :mrgreen:

Code : Tout sélectionner

; Auteur : Le Soldat Inconnu
; Version de PB : 3.81
; 
; Explication du programme :
; Faire une requête sur une valeur numérique comprise entre 2 valeurs en laissant le temps à l'utilisateur de finir de taper le nombre avant de le corriger.
; Par exemple, on souhaite un nombre compris entre 1000 et 10000, le nombre par défaut est 5000, si l'utilisateur efface un 0, on se retrouve avec 500 qui n'est pas une valeur correcte.
; Si on change la valeur directement, on empêche l'utilisateur de taper la valeur qu'il souhaitait.
; Mon astuce permet de changer la valeur seulement au bout d'un certain temps pour que l'utilisateur puisse finir de taper la valeur.


Enumeration
  #String
  #Texte
EndEnumeration


Procedure ChangeValeur(Valeur)
	; On regarde le contenu du StringGadget n'a pas changer pendant 2 secondes
	Temps = ElapsedMilliseconds()
  Repeat
		Delay(100)
		
		If Valeur <> Val(GetGadgetText(#String))
			ProcedureReturn
		EndIf
		
	Until ElapsedMilliseconds() - Temps >= 2000
  
	; On corrige le contenu
	If Valeur < 1000
		SetGadgetText(#String, "1000")
	ElseIf Valeur > 10000
		SetGadgetText(#String, "10000")
	EndIf
  
EndProcedure


; Création de la fenêtre et dela GadgetList
If OpenWindow(0, 0, 0, 300, 100, "Test", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget) = 0
  End
EndIf

; On affiche les gadgets
TextGadget(#Texte, 5, 5, 290, 15, "Entrez un nombre compris entre 1000 et 10000 :")
StringGadget(#String, 5, 20, 290, 20, "5000", #PB_String_Numeric)
Nombre = 5000

; Boucle d'évènements
Repeat
  Event = WaitWindowEvent()
  
  If Event = #PB_Event_Gadget
    Select EventGadget() ; boutons, zone de texte, ...
      Case #String
        If Nombre <> Val(GetGadgetText(#String)) ; Si le contenu du StringGadget à changer
          Nombre = Val(GetGadgetText(#String)) ; On enregistre la nouvelle valeur
          
          If Nombre < 1000 ; si la valeur est inférieure à la limite
            CreateThread(@ChangeValeur(), Nombre) ; on lance un thread qui vérifiera le texte au bout de 2 secondes
            Nombre = 1000 ; on change la valeur
            
          ElseIf Nombre > 10000 ; si la valeur est supérieure à la limite
            CreateThread(@ChangeValeur(), Nombre) ; on lance un thread qui vérifiera le texte au bout de 2 secondes
            Nombre = 10000 ; on change la valeur
            
          EndIf
          
        EndIf
        
    EndSelect
  EndIf
  
Until Event = #PB_Event_CloseWindow

End
Je ne suis pas à moitié Polonais mais ma moitié est polonaise ... Vous avez suivi ?

[Intel quad core Q9400 2.66mhz, ATI 4870, 4Go Ram, XP (x86) / 7 (x64)]
Répondre