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
|