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
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
| ' Gambas class file (CPropery)
PUBLIC ENUM TYPE_BOOLEAN, TYPE_BYTE, TYPE_SHORT, TYPE_INTEGER, TYPE_LONG, TYPE_SINGLE, TYPE_FLOAT, TYPE_DATE, TYPE_STRING, TYPE_VARIANT, TYPE_OBJECT, TYPE_POINTER
' on pourrait rajouter
' , TYPE_POINT, TYPE_POINTF, TYPE_RECT, TYPE_RECTF, TYPE_COLOR, TYPE_IMAGE, TYPE_PICTURE
PROPERTY IsReadOnly AS BOOLEAN
PROPERTY Name AS STRING
PROPERTY Type AS INTEGER
PRIVATE $propertyIsReadOnly AS BOOLEAN
PRIVATE $propertyName AS STRING
PRIVATE $propertyType AS INTEGER
PUBLIC FUNCTION _compare(otherProp AS CProperty) AS INTEGER
RETURN String.Comp(otherProp.Name, ME.Name, gb.IgnoreCase)
END
PUBLIC SUB _new()
' the constructor
$propertyIsReadOnly = FALSE
$propertyName = ""
$propertyType = TYPE_STRING
END
PUBLIC FUNCTION GetPropertyDeclaration() AS STRING
DIM sType AS STRING
DIM sRead AS STRING
sType = GetType(ME.Type)
IF ME.IsReadOnly THEN
sRead = "Read " ' space after is correct
ELSE
sRead = ""
ENDIF
RETURN "Property " & sRead & ME.Name & " As " & sType
END
PUBLIC FUNCTION GetVariableDeclaration() AS STRING
DIM sType AS STRING
sType = GetType(ME.Type)
RETURN "Private " & GetVariableName(ME.Name) & " As " & sType
END
PUBLIC FUNCTION GetVariableInitialisation() AS STRING
DIM sValue AS STRING
SELECT CASE $propertyType
CASE TYPE_BOOLEAN
sValue = "False"
CASE TYPE_BYTE
sValue = "0"
CASE TYPE_SHORT
sValue = "0"
CASE TYPE_INTEGER
sValue = "0"
CASE TYPE_LONG
sValue = "0"
CASE TYPE_SINGLE
sValue = "0.0"
CASE TYPE_FLOAT
sValue = "0.0"
CASE TYPE_DATE
sValue = "Null"
CASE TYPE_STRING
sValue = "Null" '"\"\""
CASE TYPE_VARIANT
sValue = "Null"
CASE TYPE_OBJECT
sValue = "Null"
CASE TYPE_POINTER
sValue = "0"
DEFAULT
Error.Raise("Error in GetVariableInitialisation(). Wrong Type! Stop. ")
END SELECT
RETURN GetVariableName(ME.Name) & " = " & sValue
END
PUBLIC FUNCTION GetFunction() AS STRING
DIM sFunction AS STRING
DIM sRead AS STRING
sFunction = GetReadFunction()
IF NOT ME.IsReadOnly THEN
sFunction &= GetWriteFunction()
ENDIF
RETURN sFunction
END
PRIVATE FUNCTION GetReadFunction() AS STRING
DIM sFunction AS STRING
sFunction = "Private Function " & $propertyName & "_Read() As " & GetType($propertyType) & "\n"
sFunction &= " Return " & GetVariableName($propertyName) & "\n"
sFunction &= "End" & "\n"
RETURN sFunction
END
PRIVATE FUNCTION GetWriteFunction() AS STRING
DIM sFunction AS STRING
sFunction = "Private Sub " & $propertyName & "_Write(Value As " & GetType($propertyType) & ")" & "\n"
sFunction &= " " & GetVariableName($propertyName) & " = Value" & "\n"
sFunction &= "End" & "\n"
RETURN sFunction
END
PRIVATE FUNCTION IsReadOnly_Read() AS BOOLEAN
RETURN $propertyIsReadOnly
END
PRIVATE SUB IsReadOnly_Write(Value AS BOOLEAN)
$propertyIsReadOnly = Value
END
PRIVATE FUNCTION Type_Read() AS INTEGER
RETURN $propertyType
END
PRIVATE SUB Type_Write(Value AS INTEGER)
$propertyType = Value
END
PRIVATE FUNCTION Name_Read() AS STRING
RETURN $propertyName
END
PRIVATE SUB Name_Write(Value AS STRING)
$propertyName = Value
END
PRIVATE FUNCTION GetType(type AS INTEGER) AS STRING
DIM sType AS STRING
SELECT CASE $propertyType
CASE TYPE_BOOLEAN
sType = "Boolean"
CASE TYPE_BYTE
sType = "Byte"
CASE TYPE_SHORT
sType = "Short"
CASE TYPE_INTEGER
sType = "Integer"
CASE TYPE_LONG
sType = "Integer"
CASE TYPE_SINGLE
sType = "Single"
CASE TYPE_FLOAT
sType = "Float"
CASE TYPE_DATE
sType = "Date"
CASE TYPE_STRING
sType = "String"
CASE TYPE_VARIANT
sType = "Variant"
CASE TYPE_OBJECT
sType = "Object"
CASE TYPE_POINTER
sType = "Pointer"
DEFAULT
Error.Raise("Error in GetType(). Wrong Type! Stop. ")
END SELECT
RETURN sType
END
PRIVATE FUNCTION GetVariableName(propertyName AS STRING) AS STRING
DIM variableName AS STRING
variableName = "$"
variableName &= LCase(Left(propertyName, 1))
variableName &= Right(propertyName, Len(propertyName) - 1)
RETURN variableName
END
' Gambas class file (CClass)
EVENT Changed
PRIVATE CONST const_iNotFound AS INTEGER = -1
PROPERTY Name AS STRING
PROPERTY READ Properties AS CProperty[]
PRIVATE $properties AS NEW CProperty[]
PRIVATE $className AS STRING
PUBLIC SUB _new()
' the constructor
$className = ""
END
PUBLIC SUB AddProperty(theProperty AS CProperty)
$properties.Add(theProperty)
$properties.Sort(gb.Descent)
RAISE Changed
END
PUBLIC SUB RemoveProperty(propertyName AS STRING)
DIM theIndex AS INTEGER = const_iNotFound
DIM i AS INTEGER
DIM prop AS CProperty
FOR i = 0 TO $properties.Count - 1
prop = $properties[i]
IF prop.Name = propertyName THEN
theIndex = i
BREAK
ENDIF
NEXT
IF (NOT (theIndex = const_iNotFound)) THEN
$properties.Remove(theIndex, 1)
ENDIF
RAISE Changed
END
PUBLIC FUNCTION GetCode() AS STRING
DIM sCode AS STRING
DIM theProperty AS CProperty
sCode = "' Gambas class file\n"
sCode &= "\n"
sCode &= "' " & $className & "\n"
sCode &= "\n"
FOR EACH theProperty IN $properties
sCode &= theProperty.GetPropertyDeclaration() & "\n"
NEXT
sCode &= "\n"
FOR EACH theProperty IN $properties
sCode &= theProperty.GetVariableDeclaration() & "\n"
NEXT
sCode &= "\n"
sCode &= "Public Sub _new()\n"
FOR EACH theProperty IN $properties
sCode &= " " & theProperty.GetVariableInitialisation() & "\n"
NEXT
sCode &= "End\n"
sCode &= "\n"
FOR EACH theProperty IN $properties
sCode &= theProperty.GetFunction() & "\n"
NEXT
RETURN sCode
END
PRIVATE FUNCTION Name_Read() AS STRING
RETURN $className
END
PRIVATE SUB Name_Write(Value AS STRING)
$className = Value
RAISE Changed
END
PRIVATE FUNCTION Properties_Read() AS CProperty[]
RETURN $properties
END
' Gambas class file (FCreateClass)
PRIVATE $class AS CClass
PRIVATE $property AS CProperty
PRIVATE $classObserver AS Observer
' événement quand on rempli le contrôle GridView ...
PUBLIC SUB gvwProperties_Data(Row AS INTEGER, Column AS INTEGER)
gvwProperties.Data.Text = $class.Properties[Row].Name
END
PUBLIC SUB Form_Open()
$class = NEW CClass
$property = NEW CProperty
$classObserver = NEW Observer($class, FALSE) AS "TheClass"
' TYPE_BOOLEAN, TYPE_STRING, TYPE_INTEGER, TYPE_FLOAT
cboTypes.Add("Boolean", 0)
cboTypes.Add("Byte", 1)
cboTypes.Add("Short", 2)
cboTypes.Add("Integer", 3)
cboTypes.Add("Long", 4)
cboTypes.Add("Single", 5)
cboTypes.Add("Float", 6)
cboTypes.Add("Date", 7)
cboTypes.Add("String", 8)
cboTypes.Add("Variant", 9)
cboTypes.Add("Object", 10)
cboTypes.Add("Pointer", 11)
cboTypes_Change()
gvwProperties.AddColumn("Propriétés"110, Align.Center)
btnAdd.Enabled = FALSE
END
PUBLIC SUB tbxClassName_Change()
$class.Name = tbxClassName.Text
END
PUBLIC SUB TheClass_Changed()
gvwProperties.Clear()
gvwProperties.Rows.Count = $class.Properties.Count
tarGeneratedCode.Text = $class.GetCode()
END
PUBLIC SUB tbxPropertyName_Change()
$property.Name = tbxPropertyName.Text
IF tbxPropertyName.Text THEN
btnAdd.Enabled = TRUE
ELSE
btnAdd.Enabled = FALSE
ENDIF
END
PUBLIC SUB cboTypes_Click()
'Debug "Event cboTypes_Click ... "
cboTypes_Change()
END
PUBLIC SUB cboTypes_KeyRelease()
'Debug "Event cboTypes_KeyRelease ... "
cboTypes_Change()
END
PUBLIC SUB cboTypes_Change()
'Debug "Event cboTypes_Change ... "
SELECT CASE cboTypes.Current.Text
CASE "Boolean"
$property.Type = CProperty.TYPE_BOOLEAN
'Debug "TYPE_BOOLEAN reconnu. "
CASE "Byte"
$property.Type = CProperty.TYPE_BYTE
CASE "Short"
$property.Type = CProperty.TYPE_SHORT
CASE "Integer"
$property.Type = CProperty.TYPE_INTEGER
'Debug "TYPE_INTEGER reconnu. "
CASE "Single"
$property.Type = CProperty.TYPE_SINGLE
CASE "Float"
$property.Type = CProperty.TYPE_FLOAT
'Debug "TYPE_FLOAT reconnu. "
CASE "Date"
$property.Type = CProperty.TYPE_DATE
CASE "String"
$property.Type = CProperty.TYPE_STRING
'Debug "TYPE_STRING reconnu. "
CASE "Variant"
$property.Type = CProperty.TYPE_VARIANT
CASE "Object"
$property.Type = CProperty.TYPE_OBJECT
CASE "Pointer"
$property.Type = CProperty.TYPE_POINTER
DEFAULT
Error.Raise("Error in cboTypes_Change(). Wrong value. Stop! ")
END SELECT
END
PUBLIC SUB cbxReadOnly_Click()
$property.IsReadOnly = cbxReadOnly.Value
END
PUBLIC SUB btnAdd_Click()
DIM newProperty AS CProperty
newProperty = NEW CProperty
WITH newProperty
.IsReadOnly = $property.IsReadOnly
.Name = $property.Name
.Type = $property.Type
END WITH
$class.RemoveProperty(newProperty.Name)
$class.AddProperty(newProperty)
END
PUBLIC SUB btnRemoveProperty_Click()
IF gvwProperties.Current THEN
$class.RemoveProperty(gvwProperties.Current.Text)
END IF
END
PUBLIC SUB btnDelete_Click()
IF gvwProperties.Current THEN
$class.RemoveProperty(gvwProperties.Current.Text)
END IF
END
|
