-
Notifications
You must be signed in to change notification settings - Fork 1
/
FM.xojo_code
684 lines (555 loc) · 16.7 KB
/
FM.xojo_code
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
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
#tag Module
Protected Module FM
#tag Method, Flags = &h1
Protected Function Average(ParamArray values As Double) As Double
Dim sum As Double
For Each v As Integer In values
sum = sum + v
Next
Return sum / (values.UBound + 1)
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function Base64Decode(value As Text) As Text
Return DecodeBase64(value).ToText
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function Base64Encode(value As Text) As Text
Return EncodeBase64(value).ToText
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function Ceiling(value As Double) As Double
Return Xojo.Math.Ceil(value)
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function Char(codepoint As Integer) As Text
Return Text.FromUnicodeCodepoint(codepoint)
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function Code(t As Text) As UInt32()
Dim codepoints() As UInt32
For Each codepoint As UInt32 In t.Codepoints
codepoints.Append(codepoint)
Next
Return codepoints
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function Date(month As Integer, day As Integer, year As Integer) As Xojo.Core.Date
Dim d As New Xojo.Core.Date(year, month, day, Xojo.Core.TimeZone.Current)
Return d
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function Day(d As xojo.Core.Date) As Integer
If d Is Nil Then Return -1
Return d.Day
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function DayName(d As xojo.Core.Date) As Text
If d Is Nil Then Return "n/a"
Select Case d.DayOfWeek
Case 1
Return "Sunday"
Case 2
Return "Monday"
Case 3
Return "Tuesday"
Case 4
Return "Wednesday"
Case 5
Return "Thursday"
Case 6
Return "Friday"
Case 7
Return "Saturday"
End Select
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function DayOfWeek(d As Xojo.Core.Date) As Integer
If d Is Nil Then Return -1
Return d.DayOfWeek
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function DayOfYear(d As xojo.Core.Date) As Integer
If d Is Nil Then Return -1
Return d.DayOfYear
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function Degrees(radians As Double) As Double
Dim d As Double
d = (180 * radians) / Pi
Return d
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function Exact(original As Text, comparison As Text) As Integer
Return 1 - Xojo.Math.Abs(original.Compare(comparison, Text.CompareCaseSensitive))
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function Filter(original As Text, filter As Text) As Text
// Filter(“(408)555-1212”;“0123456789”) returns 4085551212.
// Filter(“AaBb”;“AB”) returns AB.
#Pragma Warning "Not Implemented"
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function FilterValues(original As Text, filter As Text) As Text
// FilterValues("Plaid¶Canvas¶Suitcase";"Plaid¶Canvas") returns
// Plaid
#Pragma Warning "Not Implemented"
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function FV(payment As Currency, interestRate As Currency, periods As Integer) As Currency
// also see NPV, PMT, PV
Dim fv As Double = payment * ((1 + interestRate)^periods - 1) / interestRate
Return fv
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function GetApplicationArchitecture() As Text
If TargetARM Then
Return "arm7"
ElseIf Target64Bit Then
Return "x86_64"
ElseIf Target32Bit Then
Return "i386"
End If
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function GetAsDate(dateValue As Text) As Xojo.Core.Date
Try
Dim myDate As Xojo.Core.Date = Xojo.Core.Date.FromText(dateValue)
Return myDate
Catch e As Xojo.Core.BadDataException
Return Nil
End Try
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Sub GetAsNumber(t As Text)
#Pragma Warning "Not Implemented"
// GetAsNumber("FY98") returns 98.
// GetAsNumber("$1,254.50") returns 1254.5.
// GetAsNumber("2 + 2") returns 22.
End Sub
#tag EndMethod
#tag Method, Flags = &h1
Protected Sub GetAsText(data As Auto)
#Pragma Warning "Not Implemented"
// Check its type and convert to text usign appropriate method
// Date, Numbers
End Sub
#tag EndMethod
#tag Method, Flags = &h1
Protected Function GetAsURLEncoded(url As Text) As Text
Return EncodeURLComponent(url).ToText
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function Int(value As Double) As Integer
Return CType(value, Integer)
End Function
#tag EndMethod
#tag Method, Flags = &h21
Private Function IsSingleQuoteCharacter(charVal As Integer) As Boolean
if charVal = 39 or charVal = 213 or charVal = 8217 then
return true
else
return false
end if
End Function
#tag EndMethod
#tag Method, Flags = &h21
Private Function IsWordCharacter(charVal As Integer) As Boolean
dim isWordChar as boolean
select case true
case charVal < 48 // 0
case charVal > 57 and charVal < 65
case charVal > 90 and charVal < 97
case charVal > 122 and charVal < 192
else // Anything not in those ranges
isWordChar = true
end
return isWordChar
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function Left(t As Text, numChars As Integer) As Text
Try
Return t.Left(numChars)
Catch e As OutOfBoundsException
Return t
End Try
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function LeftValues(values() As Text, numValues As Integer) As Text()
#Pragma Warning "Change to use space-delimited text rather than array"
Dim newValues() As Text
For i As Integer = 0 To numValues
If i <= values.Ubound Then
newValues.Append(values(i))
End If
Next
Return newValues
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function LeftWords(words As Text, numWords As Integer) As Text
Dim wordArray() As Text = words.Split(" ")
ReDim wordArray(numWords - 1)
Return Text.Join(wordArray, " ")
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function Length(t As Text) As Integer
Return t.Length
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function Ln(value As Double) As Double
Return Xojo.Math.Log(value)
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function Lower(t As Text) As Text
Return t.Lowercase
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function Max(ParamArray values As Double) As Double
values.Sort
Return values(values.UBound)
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function Max(ParamArray values As Text) As Text
values.Sort
Return values(values.UBound)
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function Max(ParamArray values As Xojo.Core.Date) As Xojo.Core.Date
Dim seconds() As Double
For Each d As Xojo.Core.Date In values
seconds.Append(d.SecondsFrom1970)
Next
seconds.Sort
Dim maxDate As New Xojo.Core.Date(seconds(seconds.UBound), Xojo.Core.TimeZone.Current)
Return maxDate
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function Middle(t As Text, start As Integer, numChars As Integer) As Text
Try
Return t.Mid(start, numChars)
Catch e As OutOfBoundsException
Return ""
End Try
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function MiddleValues(original As Text, start As Integer, numValues As Integer) As Text
#Pragma Warning "Not Implemented"
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function MiddleWords(words As Text, start As Integer, numWords As Integer) As Text
Dim wordArray() As Text = words.Split(" ")
Dim wordText As Text
For i As Integer = start - 1 To start + numWords - 2
wordText = wordText + " " + wordArray(i)
Next
Return wordText.Trim
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function Min(ParamArray values As Double) As Double
values.Sort
Return values(0)
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function Min(ParamArray values As Text) As Text
values.Sort
Return values(0)
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function Min(ParamArray values As Xojo.Core.Date) As Xojo.Core.Date
Dim seconds() As Double
For Each d As Xojo.Core.Date In values
seconds.Append(d.SecondsFrom1970)
Next
seconds.Sort
Dim minDate As New Xojo.Core.Date(seconds(0), Xojo.Core.TimeZone.Current)
Return minDate
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function Month(d As xojo.Core.Date) As Integer
If d Is Nil Then Return -1
Return d.Month
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function MonthName(d As xojo.Core.Date) As Text
If d Is Nil Then Return "n/a"
Select Case d.Month
Case 1
Return "January"
Case 2
Return "February"
Case 3
Return "March"
Case 4
Return "April"
Case 5
Return "May"
Case 6
Return "June"
Case 7
Return "July"
Case 8
Return "August"
Case 9
Return "September"
Case 10
Return "October"
Case 11
Return "November"
Case 12
Return "December"
End Select
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function PatternCount(t As Text, searchText As Text) As Integer
#Pragma Warning "Not Implemented"
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function Position(original As Text, search As Text, start As Integer = 1, occurance As Integer = 1) As Integer
If occurance = 1 Then
Return original.IndexOf(start - 1, search) + 1
Else
// Repeat to find the specified occurance
End If
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function Proper(t As Text) As Text
Return t.TitleCase
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function Quote(original As Text) As Text
Return """" + original + """"
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function Radians(degrees As Double) As Double
Dim r As Double
r = (Pi * degrees) / 180
Return r
End Function
#tag EndMethod
#tag Method, Flags = &h1, CompatibilityFlags = (TargetConsole and (Target32Bit or Target64Bit)) or (TargetWeb and (Target32Bit or Target64Bit)) or (TargetDesktop and (Target32Bit or Target64Bit))
Protected Function Random() As Double
Return Rnd
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function Replace(original As Text, start As Integer, numChars As Integer, replacement As Text) As Text
#Pragma Warning "Not Implemented"
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function Right(t As Text, numChars As Integer) As Text
Try
Return t.Right(numChars)
Catch e As OutOfBoundsException
Return t
End Try
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function RightValues(original As Text, numValues As Integer) As Text
#Pragma Warning "Not Implemented"
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function RightWords(words As Text, numWords As Integer) As Text
Dim wordArray() As Text = words.Split(" ")
Dim wordText As Text
For i As Integer = wordArray.Ubound - (numWords - 1) To wordArray.Ubound
wordText = wordText + " " + wordArray(i)
Next
Return wordText.Trim
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function Substitute(t As Text, searchText As Text, replaceText As Text) As Text
Return t.ReplaceAll(searchText, replaceText)
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function Sum(ParamArray values As Double) As Double
Dim sum As Double
For Each d As Double In values
sum = sum + d
Next
Return sum
End Function
#tag EndMethod
#tag Method, Flags = &h1, CompatibilityFlags = (TargetDesktop and (Target32Bit or Target64Bit))
Protected Sub TextColor(ctrl As RectControl, c As Color)
If ctrl IsA Label Then
Label(ctrl).TextColor = c
ElseIf ctrl IsA TextField Then
TextField(ctrl).TextColor = c
ElseIf ctrl IsA TextArea Then
TextArea(ctrl).TextColor = c
End If
End Sub
#tag EndMethod
#tag Method, Flags = &h1
Protected Function Trim(t As Text) As Text
Return t.Trim
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function TrimAll(original As Text, trimSpaces As Boolean, trimType As Integer) As Text
#Pragma Warning "Not Implemented"
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function Truncate(value As Double, precision As Integer) As Double
#Pragma Warning "Not Implemented"
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function Upper(t As Text) As Text
Return t.Uppercase
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function ValueCount(original As Text) As Integer
#Pragma Warning "Not Implemented"
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Function WeekOfYear(d As Xojo.Core.Date) As Integer
If d Is Nil Then Return -1
Dim isoDayOfWeek As Integer = d.DayOfWeek - 1
If isoDayOfWeek < 1 Then isoDayOfWeek = 7
// https://en.wikipedia.org/wiki/ISO_week_date#Calculation
Dim week As Integer
week = (d.DayOfYear - isoDayOfWeek + 10) / 7
Return week
End Function
#tag EndMethod
#tag Method, Flags = &h1
Protected Sub WeekOfYearFiscal(d As Xojo.Core.Date, startingDay As Integer)
#Pragma Warning "Not Implemented"
End Sub
#tag EndMethod
#tag Method, Flags = &h1
Protected Function WordCount(src As String) As Integer
// From M_String: http://www.mactechnologies.com/index.php?page=downloads
// Used with permission of MacTechnologies Consulting,
// although I had to fix the spacing. :)
// Counts words in text.
// Words comprise of any letter or number.
// Once we get into unicode characters, what's considered a letter is dicey.
// A word may be begin, end or contain a single-quote character as long
// as it is bordered on one side with a letter or number.
// Massage the source
src = src.Trim.ConvertEncoding(Encodings.UTF8)
If src.LenB = 0 Then Return 0
// Break it into characters
Dim chars() As String = src.Split("")
chars.Append " " // Will properly count the last word
Dim counter As Integer
Dim inWord As Boolean
Dim singleQuoteFound As Boolean
Dim char As String
Dim charVal As Integer
For i As Integer = 0 To chars.Ubound
char = chars(i)
// Determine if this is a word character
charVal = char.Asc
If IsSingleQuoteCharacter(charVal) Then
If singleQuoteFound Then // Back to back quotes
If inWord Then
counter = counter + 1
inWord = False
End If
Else
singleQuoteFound = True
// This won't change the state of inWord
End If
Else // Not a single quote, so what is it?
singleQuoteFound = False
If IsWordCharacter(charVal) Then
inWord = True
Elseif inWord Then // Not a word char or a single quote
counter = counter + 1
inWord = False
End If
End If
Next
Return counter
End Function
#tag EndMethod
#tag Constant, Name = Pi, Type = Double, Dynamic = False, Default = \"3.1415926535897932", Scope = Protected
#tag EndConstant
#tag ViewBehavior
#tag ViewProperty
Name="Index"
Visible=true
Group="ID"
InitialValue="-2147483648"
Type="Integer"
#tag EndViewProperty
#tag ViewProperty
Name="Left"
Visible=true
Group="Position"
InitialValue="0"
Type="Integer"
#tag EndViewProperty
#tag ViewProperty
Name="Name"
Visible=true
Group="ID"
Type="String"
#tag EndViewProperty
#tag ViewProperty
Name="Super"
Visible=true
Group="ID"
Type="String"
#tag EndViewProperty
#tag ViewProperty
Name="Top"
Visible=true
Group="Position"
InitialValue="0"
Type="Integer"
#tag EndViewProperty
#tag EndViewBehavior
End Module
#tag EndModule