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
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
| ' 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
PRIVATE $listview1 AS ListView ''Le listview pour afficher et choisir l'expression régulière
PRIVATE $TextBox2 AS TextBox ''pour afficher les informations sur les expressions régul.
PRIVATE $lab AS Label ''pour afficher le nombre formaté selon l'express. régul.
PRIVATE ENUM sNumVirgule0, sNumVirgule1, sNumVirgule2, sNumVirgule3, sNumVirgule' ne sert qu'à rendre les valeurs plus explicites dans le code
PRIVATE $ListeC AS NEW String[] '<-------------------------------------------- instanciation de la liste des formats
PRIVATE $ListeB AS NEW String[] '<-------------------------------------------- instanciation de la liste des explications
PRIVATE $Liste AS NEW String[] '<--------------------------------------------- instanciation de la liste des expressions régulières
PRIVATE $obs AS Observer '<-------------------------------------------------- les observer peuvent être déclarés en local
PRIVATE $lvw1Obs AS Observer '<---------------------------------------------- ou en global
'<------------------- 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
PROPERTY TextReg AS INTEGER ''On passe l'expression régulière
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
PRIVATE FUNCTION TextReg_Read() AS INTEGER '<--------------------------------- la propriété TextReg de notre TextBox
RETURN $Liste.Find($regPat) '<---------------------------------------------- renvoi de la propriété
END
PRIVATE SUB TextReg_Write(Value AS INTEGER) '<------------------------------- la propriété TextReg de notre TextBox
$regPat = $Liste[Value] '<------------------------------------------------ récupération de la valeur et transmision à la variable locale
END
'<-------------------- Fin propriétés ajoutées à TextBox ----------------------
PUBLIC SUB _new() '<--------------------------------------------------------- création et instanciation de tous les objets nécessaires
' Dim obs As Observer '<--------------------------------------------------- les observer peuvent être déclarés en local
' Dim lvw1Obs As Observer '<----------------------------------------------- ou en global qui les rend privées
DIM sCste AS STRING '<----------------------------------------------------- variables locales pour alimenter le listview
DIM i AS INTEGER '<-------------------------------------------------------- variables locales pour alimenter le listview
$obs = NEW Observer(ME) AS "obs" '<---------------------------------------- instanciation observateur pour récupérer les évènements
$listview1 = NEW ListView(ME.Parent) '<--------------------------------- instanciation listview d'affichage des expressions régulmières
$TextBox2 = NEW TextBox(ME.Parent) '<----------------------------------- instanciation textbox d'affichage d'explications
$lvw1Obs = NEW Observer($listview1) AS "ListView1" '<---------------------- instanciation observer pour suivre l'évènement _Select
$lab = NEW Label(ME.Parent) '<--------------------------------------------- instanciation label d'affichage du format
$lab.Alignment = Align.Right '<------------------------------------------ définition du label d'affichage
$listview1.ShowCheck = TRUE '<--------------------------------------------- définition du listview1 par ses propriétés
$listview1.X = 7 '<----------------------------------------------------- position horizontale
$listview1.Y = 7 '<----------------------------------------------------- position verticale
$listview1.H = 150 '<----------------------------------------------------- hauteur du champ
$listview1.W = 250 '<----------------------------------------------------- largeur du champ
$listview1.Visible = TRUE '<--------------------------------------------- le champ est visible
$TextBox2.X = 7 '<--------------------------------------------------------- définition du textbox2 par ses propriétés
$TextBox2.Y = $listview1.Y + $listview1.H
$TextBox2.H = 35
$TextBox2.W = 250
$TextBox2.Visible = TRUE
$TextBox2.ReadOnly = TRUE
'<------------------------------------------------------------------------- initialisation des listes
$ListeC = ["$#,###", "$#,###.#", "$#,###.##", "$#,###.###", "$#,###.##############"] '<----- liste des formats
$ListeB = [("Valeur Numérique sans décimale" ("Valeur Numérique à une décimale"), ("Valeur Numérique à deux décimales"), ("Valeur Numérique à trois décimales"), ("Valeur Numérique à virgule")] '<------------------ liste des explications
$Liste = ["^-?[0-9]*[,.]?[0-9]{0,0}$", "^-?[0-9]*[,.]?[0-9]{0,1}$", "^-?[0-9]*[,.]?[0-9]{0,2}$", "^-?[0-9]*[,.]?[0-9]{0,3}$", "^-?[0-9]*[,.]?[0-9]*$"] '<------------------------------------------------ liste des expressions régulières
i = 0
FOR EACH sCste IN $Liste
$ListView1.Add(CStr(i), sCste) '<------------------------------------- initialisation, remplissage de la listview1 avec la $Liste
INC i
NEXT
$ListView1.Key = sNumVirgule2 '<----------------------------------------- initialisation de départ de l'expression régulière (ici 2)
listview1_select() '<----------------------------------------------------- premier appel pour obtenir le format et l'express. régul.
$bFocus = TRUE '<---------------------------------------------------------- initialisation du boolean
END
'<----------------------------------------------------------------------------- on utilise Me pour faire appel à toutes les propriétés
'<----------------------------------------------------------------------------- du composant à l'intérieur de la Class et bien sûr celles
'<----------------------------------------------------------------------------- qu'on vient de créer par l'utilisation des procédures
'<----------------------------------------------------------------------------- _read et _write
PUBLIC SUB defLabel() '<----------------------------------------------------- les propriétés pour le label d'affichage
$lab.X = ME.X
$lab.Y = ME.Y + ME.H + 2
$lab.h = ME.H - 3
$lab.w = ME.W - 3
$lab.Border = TRUE
$lab.Border = Border.Dotted
$lab.Visible = TRUE
$lab.Background = Color.ButtonBackground
$lab.Font = ME.Font '<----------------------------------------------------- même police que tb1 dans Fmain.Form
END
PUBLIC SUB ListView1_select() '<--------------------------------------------- évènement _select pour listview1
ME.TextReg = $ListView1.Key '<------------------------------------------- express. régul. sélectionnée (key=integer)
$TextBox2.Text = $ListeB[CInt($ListView1.Key)] '<------------------------ affichage des informations sur l'expression régulière pointée
TransFormat($regPat) '<------------------------------------------------- format transmis à notre class en fonction de $regPat
$regex.Compile($regPat) '<------------------------------------------------- précompile en fonction de l'expression régulière choisie
END
PUBLIC FUNCTION TransFormat(valeur AS STRING) AS STRING '<--------------------- renvoie du format en fonction de l'express. régul.
DIM i AS INTEGER
i = $Liste.Find(valeur)
IF valeur = $liste[i] THEN ME.Format = $ListeC[i]
RETURN ME.Format '<----------------------------------------------------- on utilise Me.propriété ou la variable privée $propriété
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) '<----------------------------- si j'ai du texte alors j'ai une valeur
IF ME.Value > 20000000 THEN '<----------------------------------------- pour ne pas dépasser la somme
ME.Value = 0 '<------------------------------------------------- la valeur est remise àzéro
ME.Clear '<----------------------------------------------------- le texte est effacé
ME.SetFocus '<----------------------------------------------------- le focus est remis au champ
$lab.Text = "" '<------------------------------------------------- la label d'affichage est effacé
ENDIF
ELSE
$value = 0
$lab.Text = ""
ENDIF
IF ME.Text AND IF $format THEN
$lab.Text = Format(Val(ME.Text), $format) '<------------------------- affichage dans le label selon le format
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
$lab.Visible = FALSE
$lab.Text = ""
END
PUBLIC SUB obs_Gotfocus() ''Pour être certain d'avoir à la fois une valeur et un texte
IF $value = 0 THEN '<----------------------------------------------------- pour être sûr que la valeur et le texte sont de concert
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
defLabel() '<------------------------------------------------------------- définition du label d'affichage (voir plus haut)
END
PUBLIC SUB obs_Activate() ''L'utilisateur tape sur entrée et bascule l'affichage
SELECT CASE $bFocus '<----------------------------------------------------- on alterne le focus en fonction du drapeau boolean
CASE TRUE
obs_Lostfocus() '<------------------------------------------------- le composant perd le focus
CASE FALSE
obs_Gotfocus() '<------------------------------------------------- le composant gagne le focus
END SELECT
END
|
Dans le formulaire principal nommé Fmain.Form, alterner entre tbxPerso et tbxPerso1
en gardant le même nom pour le composant à intégrer, à savoir tb1.
Les différences sont peu visibles mais sensibles surtout si l'on veut récupérer
des éléments pour d'autres programmes.
PilValaquarus