| Patrick | #16 Posté le 29/6/2022 à 16:21:05 |
|---|
![]() | Et bien tout est dans le code dessous :
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
| INHERITS TextBox
EXPORT
PRIVATE $value AS FLOAT ''contient la valeur numérique
PRIVATE $reg AS STRING ''contient les expressions réguliéres
PRIVATE $format AS STRING ''contient le formatage de la variable
PRIVATE $regex AS NEW RegExp ''controle l'entrée, il faut activer gb.pcre
PUBLIC CONST num AS STRING = "-?[0-9]*[,]?[0-9]*" ''valeur numérique entrée au clavier. Si on veut le point et la virgule : "-?[0-9]*[,.]?[0-9]*" mais il faudra faire attention à la conversion
PROPERTY Value AS FLOAT ''valeur float de la textbox
PROPERTY Format AS STRING ''on passe le format que l'on souhaite voir en sortie
PUBLIC SUB _new()
DIM obs AS Observer
obs = NEW Observer(ME) AS "obs" 'on observe les event de la textbox
$reg = num 'par défault c'est un numérique que on rentre, on pourrait mettre plusieurs constantes
$regex.Compile($reg) 'on pre compile pour gagner du temps
END
PUBLIC SUB obs_Lostfocus()
'lorsque la textbox perd le focus on met en forme selon le format passé
IF ME.Text THEN
ME.Value = Val(ME.Text)
IF $format THEN ME.Text = Format($value, $format)
ELSE
ME.Clear
ENDIF
END
PUBLIC SUB obs_change()
'lorsque la textbox change de valeur on vérifie si le texte correspond
$regex.Exec(ME.Text)
ME.Text = $regex.Text 'si mon entrée au clavier ne correspond pas au patern seul la partie juste est retournée
END
PRIVATE FUNCTION Value_Read() AS FLOAT
RETURN $value
END
PRIVATE SUB Value_Write(Value AS FLOAT)
IF $format THEN ME.text = Format(Value, $format)
$value = Value
END
PRIVATE FUNCTION Format_Read() AS STRING
RETURN $format
END
PRIVATE SUB Format_Write(Value AS STRING)
$format = Value
END
|
|
| valaquarus | #17 Posté le 29/6/2022 à 18:08:23 |
|---|
-- Unus Ex Altera -- | Merci, Patrick, de ce petit paquet.
J'ai cette erreur après avoir rentrer un nombre à virgule : No subject provided dans la Sub obs_change().
Je suppose que c'est le subject de l'expression régulière mais je ne comprend pas de quoi il s'agit.
De plus comment fait on appel au format d'affichage ?
PhilippeSystème d'exploitation : KDE neon 6.0 ~ Version Gambas : 3.19.3 |
| valaquarus | #18 Posté le 29/6/2022 à 18:55:08 |
|---|
| -- Unus Ex Altera -- | @Patrick,
bon il suffit de rajouter un try devant : Try $regex.Exec(Me.Text) et le tour est joué, plus d'erreur mais je n'ai toujours pas de format alors que j'ai trouvé tb2.format
PhilippeSystème d'exploitation : KDE neon 6.0 ~ Version Gambas : 3.19.3 |
| valaquarus | #19 Posté le 29/6/2022 à 20:51:30 |
|---|
| -- Unus Ex Altera -- | Bonsoir,
voici ma class2 un peu modifiée :
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
| ' Gambas class file
INHERITS TextBox
EXPORT
PRIVATE $value AS FLOAT ''contient la valeur numérique
PRIVATE $reg AS STRING ''contient les expressions réguliéres
PRIVATE $format AS STRING ''contient le formatage de la variable
PRIVATE $regex AS NEW RegExp ''controle l'entrée, il faut activer gb.pcre
PUBLIC CONST numVirgule AS STRING = "^-?[0-9]*[,.]?[0-9]{0,2}$" ''valeurs numériques rentrées au clavier
PROPERTY Value AS FLOAT ''valeur float de la textbox
PROPERTY Format AS STRING ''on passe le format que l'on souhaite voir en sortie
PUBLIC SUB _new()
DIM obs AS Observer
obs = NEW Observer(ME) AS "obs"
$reg = numVirgule
$regex.Compile($reg)
END
PUBLIC SUB obs_KeyRelease()
IF NOT $regex.Match(ME.Value, numVirgule) THEN
ME.Value = 0
ME.SetFocus
STOP EVENT
ENDIF
END
PUBLIC SUB obs_change()
TRY $regex.Exec(ME.Text)
ME.Text = $regex.Text
IF ME.Text MATCH "." THEN ME.Text = Replace(ME.Text, ".", ",")
END
PRIVATE FUNCTION Value_Read() AS FLOAT
RETURN $value
END
PRIVATE SUB Value_Write(Value AS FLOAT)
IF $format THEN ME.text = Format(Value, $format)
$value = Value
END
PRIVATE FUNCTION Format_Read() AS STRING
RETURN $format
END
PRIVATE SUB Format_Write(Value AS STRING)
$format = Value
END
|
Dans la Class principale, j'ai créé un contenair nommé tb2 puis j'ai passé tb2.Format = "$#,###.##" mais je ne récupère pas le format.
Le contrôle de l'expression régulière se fait bien mais je ne récupère pas de valeur du tb2.value qui reste à zéro malgré l'affichage (sans format) du tb2.text.
J'avoue que je ne maîtrise pas tout mais ça me plait d'avancer pas à pas.
PhilippeSystème d'exploitation : KDE neon 6.0 ~ Version Gambas : 3.19.3 |
| Patrick | #20 Posté le 30/6/2022 à 06:08:57 |
|---|
![]() | Bonjour,
C'est parce qu'il manque le lostfocus :
1
2
3
4
5
6
7
8
9
10
| PUBLIC SUB obs_Lostfocus()
'lorsque la textbox perd le focus on met en forme selon le format passé
IF ME.Text THEN
ME.Value = Val(ME.Text)
IF $format THEN ME.Text = Format($value, $format)
ELSE
ME.Clear
ENDIF
END
|
Je n'ai pas d'erreur avec $regex.Exec
1
| IF NOT $regex.Match(ME.Value, numVirgule) THEN
|
Ce code ne peut pas fonctionner puisque me.Value n'est évalué que au lostfocus. La fonction KeyRelease ne me parait pas nécessaire ... a moins que tu es quelque chose de particulier à faire. |
| valaquarus | #21 Posté le 30/6/2022 à 10:22:03 |
|---|
| -- Unus Ex Altera -- | Bonjour Patrick,
chez moi le souci vient essentiellement de l'application du format envoyé à la class.
Si je diffère l'application du format à la perte de focus cela se fait bien sinon évidemment le texte du textbox amélioré n'est pas considéré comme un float et il y a plantus.
Pour les essai je n'ai pas fais avec les expressions régulières dans la class car je sais que ça fonctionne et je voulais me concentrer sur ce qui ne fonctionnait pas.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
| ' Gambas class file
INHERITS TextBox
EXPORT
PRIVATE $value AS FLOAT ''contient la valeur numérique
PRIVATE $format AS STRING ''contient le formatage de la variable
PROPERTY Value AS FLOAT ''valeur float de la textbox
PROPERTY Format AS STRING ''on passe le format que l'on souhaite voir en sortie
PRIVATE FUNCTION Value_Read() AS FLOAT
RETURN $value
END
PRIVATE SUB Value_Write(Value AS FLOAT)
$value = Value
END
PRIVATE FUNCTION Format_Read() AS STRING
RETURN $format
END
PRIVATE SUB Format_Write(sFormat AS STRING)
$format = sFormat
END
PUBLIC SUB _new()
DIM obs AS Observer
obs = NEW Observer(ME) AS "obs"
END
PUBLIC SUB obs_Lostfocus()
IF $format THEN ME.text = Format(Val(ME.Text), $format)
END
|
Là ça fonctionne même si je ne sais pas comment faire perdre le focus, vu que je n'ai gardé que le container de la class à tester.
Philippe
Si je laisse :
1
2
3
4
5
6
| PRIVATE SUB Value_Write(Value AS FLOAT)
IF $format THEN ME.text = Format(Value, $format)
$value = Value
END
|
ça ne fonctionne pas car la valeur retournée est toujours nulle.
Système d'exploitation : KDE neon 6.0 ~ Version Gambas : 3.19.3 |
| Patrick | #22 Posté le 30/6/2022 à 12:19:57 |
|---|
![]() | 1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
| PUBLIC SUB obs_Lostfocus()
'lorsque la textbox perd le focus on met en forme selon le format passé
IF ME.Text THEN
$value = Val(ME.Text)
IF $format THEN
Object.Lock(ME) 'on verrouille l'objet pour que l'event change ne soit pas appelé
ME.Text = Format($value, $format)
Object.Unlock(ME) 'on deverouille l'objet
ENDIF
ELSE
ME.Clear
ENDIF
END
PUBLIC SUB obs_Gotfocus()
'lorsque le texbox prend le focus on retransforme la valeur en string
IF $value = 0 THEN ME.Clear ELSE ME.Text = Str($value)
END
PUBLIC SUB obs_change()
'lorsque la textbox change de valeur on vérifie si le texte correspond
IF ME.Text THEN 'l'erreur est provoquée par un me.text null, c'est mieux de tester que d'utiliser un try
$regex.Exec(ME.Text)
ME.Text = $regex.Text 'si mon entrée au clavier ne correspond pas au patern seul la partie juste est retournée
ELSE
$value = 0
ENDIF
END
|
|
| valaquarus | #23 Posté le 30/6/2022 à 13:12:25 |
|---|
| -- Unus Ex Altera -- | Gooooooooooooooooooooooal! Système d'exploitation : KDE neon 6.0 ~ Version Gambas : 3.19.3 |
| valaquarus | #24 Posté le 30/6/2022 à 14:07:09 |
|---|
| -- Unus Ex Altera -- | @Patrick,
je ne sait pas combien de temps je vais mettre pour décortiquer et assimiler tout ça mais je peux te dire que cela m'a terriblement plut.
Je mettrai sur la forge le petit essai en version 4 (howmuch4).
PhilippeSystème d'exploitation : KDE neon 6.0 ~ Version Gambas : 3.19.3 |
| valaquarus | #25 Posté le 30/6/2022 à 19:34:27 |
|---|
| -- Unus Ex Altera -- | Bonsoir Patrick,
ça fonctionne bien mais pourquoi n'obtient on pas les mêmes résultats avec obs_Activate() qu'avec obs_Lostfocus.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
| PUBLIC SUB obs_Lostfocus() '<------------------------------------------------ le format ne sera appliqué qu'après
IF ME.Text THEN
$value = Val(ME.Text)
IF $format THEN
Object.Lock(ME) '<------------------------------------------------- on verrouille l'objet pour ne pas appeler l'event Change
ME.Text = Format($value, $format) '<----------------------------- on formate le texte comme voulu
Object.Unlock(ME) '<----------------------------------------------- on deverouille l'objet
ENDIF
ELSE
ME.Clear
ENDIF
END
' Public Sub obs_activate()
'
' If Me.Text Then
' $value = Val(Me.Text)
' If $format Then
' Object.Lock(Me) '<------------------------------------------------- on verrouille l'objet pour ne pas appeler l'event Change
' Me.Text = Format($value, $format) '<----------------------------- on formate le texte comme voulu
' Object.Unlock(Me) '<----------------------------------------------- on deverouille l'objet
' Endif
' Else
' Me.Clear
' Endif
'
' End
|
Merci.
PhilippeSystème d'exploitation : KDE neon 6.0 ~ Version Gambas : 3.19.3 |
| valaquarus | #26 Posté le 1/7/2022 à 09:38:00 |
|---|
| -- Unus Ex Altera -- | Bonjour Patrick,
je me réponds avec cette modification qui semble bien fonctionner :
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
| PUBLIC SUB obs_Lostfocus() '<------------------------------------------------ le format ne sera appliqué qu'après
IF ME.Text THEN
' $value = Val(Me.Text)
$value = Val(Format($value, "#.##"))
IF $format THEN
Object.Lock(ME) '<------------------------------------------------- on verrouille l'objet pour ne pas appeler l'event Change
ME.Text = Format($value, $format) '<----------------------------- on formate le texte comme voulu
Object.Unlock(ME) '<----------------------------------------------- on deverouille l'objet
ENDIF
ELSE
ME.Clear
ENDIF
END
PUBLIC SUB obs_Activate()
IF ME.Text THEN
' $value = Val(Me.Text)
$value = Val(Format($value, "#.##"))
IF $format THEN
Object.Lock(ME) '<------------------------------------------------- on verrouille l'objet pour ne pas appeler l'event Change
ME.Text = Format($value, $format) '<----------------------------- on formate le texte comme voulu
Object.Unlock(ME) '<----------------------------------------------- on deverouille l'objet
ENDIF
ELSE
ME.Clear
ENDIF
END
PUBLIC SUB obs_Gotfocus() '<------------------------------------------------- pour être certain d'avoir à la fois une valeur et un texte
IF $value = 0 THEN
ME.Clear
ELSE
ME.Text = Format($value, "#.##")
' Me.Text = Str($value)
ENDIF
END
|
Je m'assure que le texte n'est pas vide en le reformatant en suite de chiffres, j'obtiens donc l'affichage du nombre formaté dès la frappe sur entrée.
PhilippeSystème d'exploitation : KDE neon 6.0 ~ Version Gambas : 3.19.3 |
| valaquarus | #27 Posté le 1/7/2022 à 09:50:29 |
|---|
| -- Unus Ex Altera -- | @Patrick,
une variante amusante et fonctionnelle :
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
| PUBLIC SUB _new()
DIM obs AS Observer
obs = NEW Observer(ME) AS "obs" '<----------------------------------------- nouvel observateur pour récupérer les évènements
$regPat = numVirgule '<------------------------------------------------- pattern de l'expression régulière
$regex.Compile($regPat) '<------------------------------------------------- on précompile l'expression régulière
ME.Tag = 2
END
PUBLIC SUB obs_Change() '<-----------------------------------------------------
IF ME.text THEN '<--------------------------------------------------------- pour ne pas avoir d'erreur de texte vide
$regex.Exec(ME.Text) '<--------------------------------------------- test de la valeur au crible de l'expression régulière
ME.Text = $regex.Text '<--------------------------------------------- isNumber() donc on récupère chaque chiffre
IF ME.Text MATCH "." THEN ME.Text = Replace(ME.Text, ".", ",") '<----- pour récupérer la virgule à partir du point
IF ME.text THEN $value = Val(ME.Text)
IF ME.Value > 20000000 THEN '<----------------------------------------- pour ne pas dépasser la somme
ME.Value = 0
ME.Clear
ME.SetFocus
ENDIF
ELSE
$value = 0
ENDIF
END
PUBLIC SUB obs_Lostfocus() '<------------------------------------------------ le format ne sera appliqué qu'après
IF ME.Text THEN
' $value = Val(Me.Text)
$value = Val(Format($value, "#.##"))
IF $format THEN
Object.Lock(ME) '<------------------------------------------------- on verrouille l'objet pour ne pas appeler l'event Change
ME.Text = Format($value, $format) '<----------------------------- on formate le texte comme voulu
Object.Unlock(ME) '<----------------------------------------------- on deverouille l'objet
ENDIF
ME.Tag = 1
ELSE
ME.Clear
ENDIF
END
PUBLIC SUB obs_Activate()
SELECT CASE ME.Tag
CASE 2
obs_Lostfocus()
CASE 1
obs_Gotfocus()
END SELECT
END
PUBLIC SUB obs_Gotfocus() '<------------------------------------------------- pour être certain d'avoir à la fois une valeur et un texte
IF $value = 0 THEN
ME.Clear
ELSE
ME.Text = Format($value, "#.##")
' Me.Text = Str($value)
ME.Tag = 2
ENDIF
END
|
Philippe
Système d'exploitation : KDE neon 6.0 ~ Version Gambas : 3.19.3 |
| Patrick | #28 Posté le 1/7/2022 à 12:13:44 |
|---|
![]() | La bonne question est pourquoi gérer l'event Activate ici ? |
| valaquarus | #29 Posté le 1/7/2022 à 12:37:13 |
|---|
| -- Unus Ex Altera -- | @Patrick,
simplement pour obtenir l'affichage du format dès l'appui sur la touche entrée.
Philippe
J'avoue que ce qui me perturbe le plus c'est comment la machine fait le distinguo entre les évènements issus de la définition du composant et ceux issus de l'intégration du composant dans un formulaire.
La variante modifiée :
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
| ' Gambas class file
INHERITS TextBox '<--------------------------------------------------------- Tout l'héritage du composant TextBox
'<----------------------------------------------------------------------------- (Export) pour créer la class dans l'IDE
EXPORT
'<------------------------------- remarquez les doubles '' pour faire apparaître les commentaires en explication des objets dans l'IDE
PRIVATE $value AS FLOAT ''Contient la valeur numérique
PRIVATE $regPat AS STRING ''Pattern des expressions réguliéres
PRIVATE $format AS STRING ''Contient le formatage de la variable
PRIVATE $regex AS NEW RegExp ''Contrôle l'entrée, il faut activer gb.pcre
PRIVATE $bFocus AS BOOLEAN ''Boolean du focus
'<------------------- Début propriétés ajoutées à TextBox ---------------------
PROPERTY Value AS FLOAT ''Valeur float de la textbox
PROPERTY Format AS STRING ''On passe le format que l'on souhaite voir en sortie
PRIVATE SUB Value_Write(Value AS FLOAT) '<------------------------------------- la propriété Value de notre TextBox
$value = Value '<--------------------------------------------------------- récupération de la valeur et transmision à la variable locale
END
PRIVATE FUNCTION Value_Read() AS FLOAT '<------------------------------------- la propriété Value de notre TextBox
RETURN $value '<---------------------------------------------------------- renvoi de la propriété
END
PRIVATE SUB Format_Write(sFormat AS STRING) '<------------------------------- la propriété Format de notre TextBox
$format = sFormat '<------------------------------------------------------ récupération de la valeur et transmision à la variable locale
END
PRIVATE FUNCTION Format_Read() AS STRING '<--------------------------------- la propriété Format de notre TextBox
RETURN $format '<--------------------------------------------------------- renvoi de la propriété
END
'<-------------------- Fin propriétés ajoutées à TextBox ----------------------
PUBLIC SUB _new()
DIM obs AS Observer
obs = NEW Observer(ME) AS "obs" '<----------------------------------------- nouvel observateur pour récupérer les évènements
$regPat = Fmain.sRegTransf '<--------------------------------------------- pattern de l'expression régulière
$regex.Compile($regPat) '<------------------------------------------------- on précompile l'expression régulière
$bFocus = TRUE '<---------------------------------------------------------- initialisation du boolean
END
PUBLIC SUB obs_Change() ''Contrôle de la saisie
IF ME.text THEN '<--------------------------------------------------------- pour ne pas avoir d'erreur de texte vide
$regex.Exec(ME.Text) '<--------------------------------------------- test de la valeur au crible de l'expression régulière
ME.Text = $regex.Text '<--------------------------------------------- isNumber() donc on récupère chaque chiffre
IF ME.Text MATCH "." THEN ME.Text = Replace(ME.Text, ".", ",") '<----- pour récupérer la virgule à partir du point
IF ME.text THEN $value = Val(ME.Text)
IF ME.Value > 20000000 THEN '<----------------------------------------- pour ne pas dépasser la somme
ME.Value = 0
ME.Clear
ME.SetFocus
ENDIF
ELSE
$value = 0
ENDIF
END
PUBLIC SUB obs_Lostfocus() ''Le format ne sera appliqué qu'après
IF ME.Text THEN
$value = Val(Format($value, "#.##")) '<----------------------------- on s'assure que le texte est une suite de chiffres sans format
IF $format THEN
Object.Lock(ME) '<------------------------------------------------- on verrouille l'objet pour ne pas appeler l'event Change
ME.Text = Format($value, $format) '<----------------------------- on formate le texte comme voulu
Object.Unlock(ME) '<----------------------------------------------- on deverouille l'objet
ENDIF
$bFocus = NOT $bFocus '<--------------------------------------------- inversion du boolean
ELSE
ME.Clear
ENDIF
END
PUBLIC SUB obs_Gotfocus() ''Pour être certain d'avoir à la fois une valeur et un texte
IF $value = 0 THEN
ME.Clear
ELSE
ME.Text = Format($value, "#.##") '<--------------------------------- on s'assure que le texte est une suite de chiffres sans format
$bFocus = NOT $bFocus '<--------------------------------------------- inversion du boolean
ENDIF
END
PUBLIC SUB obs_Activate() ''L'utilisateur tape sur entrée et bascule l'affichage
SELECT CASE $bFocus
CASE TRUE
obs_Lostfocus() '<------------------------------------------------- le composant perd le focus
CASE FALSE
obs_Gotfocus() '<------------------------------------------------- le composant gagne le focus
END SELECT
END
|
Système d'exploitation : KDE neon 6.0 ~ Version Gambas : 3.19.3 |
| Patrick | #30 Posté le 1/7/2022 à 14:30:37 |
|---|
![]() | A mon avis il faut que l'affichage dans le composant se fasse uniquement a la perte du focus, sinon on mélange l'affichage et saisie. La perte du focus doit se gérer depuis la class appelante => j'appuie sur return et je donne le focus au contrôle suivant.
On pourrait aussi utiliser le tooltip pour afficher la valeur.
|
123