OpenInclude, soon to be made a SMART code merger.

[codeguy]

Hi everyone, I'm not a BOT. I am the VERY same CodeGuy from QB64(net), which I think is PERMANENTLY dead. I have coded this nice little recursive merger for creating monolithic array of code, including nested $include: so you can save or load entire programs, exclusive of data files like BMP, jpeg and such. The smart version will exclude subs and functions not referenced by the source and will be left as an option in later releases. It successfully merged all 46050+ lines of the latest qb64 stable release (v1.2).
OpenInclude() v.009 dynamically resizes the string array, here TextArray$() approximately 10% at a time. It does not resize the array to the actual number of lines of code merged when finished, in this example, TextArrayLines& (yet, if ever). One caveat, it does not stop if an $include: file is not present. Thanks to those on QB64(org) who pointed the way to a successful download of the newest QB64. The new changes are GREAT. For those who want to STEAL MY CODE, feel free.

Code: QB64: [Select]

1. '************************
2. '* this is a test
3. cwdsave$ = _CWD$
4. CHDIR _CWD$ + "\source"
5.  
6. REDIM TextArray$(0 TO 1023)
7. TextArrayLines& = 0
8.  
9. REDIM alert$(0 TO 511)
10. alertcount& = 0
11.  
12. Result& = OpenInclude&("qb64.bas", TextArray$(), TextArrayLines&, alert$(), alertcount&)
13. IF alertcount& > 0 THEN
14.     FOR p& = 0 TO alertcount& - 1
15.         PRINT alert$(p&); " was not merged"
16.     NEXT
17.     DO
18.         x$ = INKEY$
19.     LOOP UNTIL x$ > ""
20. END IF
21. Result& = RemoveUnreferencedCode(TextArray$(), -1, -1)
22. CHDIR cwdsave$
23. beforelines& = TextArrayLines&
24. WHILE TextArray$(TextArrayLines&) = "" AND TextArrayLines& > 0
25.     TextArrayLines& = TextArrayLines& - 1
26. WEND
27.  
28. FOR x& = 0 TO TextArrayLines&
29.     PRINT x&; " "; TextArray$(x&)
30. NEXT
31. PRINT TextArrayLines&; Result&; beforelines&; UBOUND(textarray$)
32. '* this was only a test
33. '************************
34.  

Squashed some bugs:
Now Lists files that could not be merged. all files must be within the _cwd$.

Code: QB64: [Select]

1. '*********************
2. '* Loads QB64 source,i ncluding $include: files
3. '* accepts forms:
4. '*      $include:<any number of spaces>'whateverfile' -- if $ is the first non-blank character on a line, this is handled like an implied apostrophe before
5. '* also REM      <any number of spaces>$include:'whateverfile'
6. '* also '$include:<any number of spaces>'whateverfile'
7. '* provided the $include: files are present, this loads them into a string array provided the file exists
8. '*********************
9.  
10. FUNCTION OpenInclude& (OIFile$, OICodeText() AS STRING, OILinesIn&, Warning$(), WarningCount&)
11.     IF _FILEEXISTS(OIFile$) THEN
12.         OIFileIO& = FREEFILE
13.         IF OIFileIO& > 0 THEN
14.             OPEN OIFile$ FOR INPUT AS #OIFileIO&
15.             WHILE NOT EOF(OIFileIO&)
16.                 IF OILinesIn& > UBOUND(OICodeText) THEN
17.                     units& = 10 - UBOUND(OICodeText) MOD 10
18.                     NewUbound& = (UBOUND(OICodeText) + units&)
19.                     REDIM _PRESERVE OICodeText(LBOUND(OICodeText) TO NewUbound&)
20.                 END IF
21.                 LINE INPUT #OIFileIO&, OICodeText(OILinesIn&)
22.                 fx$ = IncludeFile$(OICodeText(OILinesIn&))
23.                 IF fx$ > "" THEN
24.                     OICodeText(OILinesIn&) = "'* Merged " + fx$ + " *"
25.                     r& = OpenInclude(fx$, OICodeText(), OILinesIn&, Warning$(), WarningCount&)
26.                 END IF
27.                 OILinesIn& = OILinesIn& + 1
28.             WEND
29.             CLOSE #OIFileIO&
30.             OpenInclude& = 1
31.             EXIT FUNCTION
32.         END IF
33.     ELSE
34.         Warning$(WarningCount&) = OIFile$
35.         WarningCount& = WarningCount& + 1
36.         '**********************
37.         '* maybe a dialog box for path or store in list of warnings
38.         '*******************
39.     END IF
40.     '* if this returns a 0 value, OpenInclude&() was not successful
41.     OpenInclude& = 0
42. END SUB
43.  
44. FUNCTION IncludeFile$ (IncludeFileTextX$)
45.     IncludeFile$ = ""
46.     '* do not alter the original code text
47.     TextX$ = LCASE$(LTRIM$(RTRIM$(IncludeFileTextX$)))
48.     q& = 1
49.     WHILE q& <= 3
50.         IF MID$(TextX$, q&, LEN("$include:")) = "$include:" THEN
51.             TextX$ = LTRIM$(MID$(TextX$, q& + LEN("$include:")))
52.             insc1& = INSTR(TextX$, "'")
53.             IF insc1& THEN
54.                 insc2& = INSTR(insc1& + 1, TextX$, "'")
55.                 IF insc2& > insc1& THEN
56.                     IncludeFile$ = MID$(TextX$, insc1& + 1, insc2& - (insc1& + 1))
57.                 END IF
58.             END IF
59.             EXIT FUNCTION
60.         END IF
61.         SELECT CASE LCASE$(LEFT$(TextX$, q&))
62.             CASE "$"
63.                 EXIT WHILE
64.             CASE "'$"
65.                 EXIT WHILE
66.             CASE "rem"
67.                 SELECT CASE MID$(TextX$, q& + 1, 1)
68.                     CASE " "
69.                         TextX$ = LTRIM$(MID$(TextX$, q& + 2))
70.                     CASE "$"
71.                         TextX$ = MID$(TextX$, q& + 1)
72.                     CASE ELSE
73.                         EXIT FUNCTION
74.                 END SELECT
75.                 q& = 1
76.         END SELECT
77.         q& = q& + 1
78.     WEND
79. END FUNCTION
80.  
81. FUNCTION RemoveUnreferencedCode (CodeIn() AS STRING, stripRemarks&, RemoveWhiteSpaceLines&)
82.     RUCCleanedLines& = LBOUND(codeIn)
83.     FOR RUCq& = LBOUND(codein) TO UBOUND(codein)
84.         t$ = LCASE$(LTRIM$(CodeIn(RUCq&)))
85.         T& = LEN(t$)
86.         DO
87.             IF T& > 0 THEN
88.                 IF MID$(t$, T&, 1) = CHR$(34) THEN
89.                     '* skip anything inside quotes -- might miss some
90.                     '* comments, but better safe than sorry
91.                     EXIT DO
92.                 END IF
93.                 IF MID$(t$, T&, 1) = "'" THEN
94.                     t$ = LEFT$(t$, T& - 1)
95.                     EXIT DO
96.                 ELSE
97.                     T& = T& - 1
98.                 END IF
99.             ELSE
100.                 EXIT DO
101.             END IF
102.         LOOP
103.         SELECT CASE LEFT$(t$, 1)
104.             CASE "'", ""
105.                 _CONTINUE
106.             CASE ELSE
107.                 IF IsWord&(t$, "rem", 1) THEN
108.                     SELECT CASE MID$(t$, LEN("rem") + 1, 1)
109.                         CASE " ", "", CHR$(13)
110.                         CASE ELSE
111.                     END SELECT
112.                     _CONTINUE
113.                 ELSEIF IsWord&(t$, "sub", 1) THEN
114.                     PRINT RUCCleanedLines&; t$
115.                 ELSEIF IsWord(t$, "function", 1) THEN
116.                     PRINT RUCCleanedLines&; t$
117.                 END IF
118.         END SELECT
119.         CodeIn(RUCCleanedLines&) = CodeIn(RUCq&)
120.         RUCCleanedLines& = RUCCleanedLines& + 1
121.     NEXT
122.     '* clear remaining lines of code that have been processed
123.     WHILE RUCCleanedLines& <= UBOUND(codein)
124.         CodeIn(RUCCleanedLines&) = ""
125.         RUCCleanedLines& = RUCCleanedLines& + 1
126.     WEND
127. END FUNCTION
128.  
129. FUNCTION IsWord& (t$, word$, position&)
130.     IF position& > 1 THEN
131.         SELECT CASE MID$(t$, position& - 1, 1)
132.             CASE "0" TO "9", "A" TO "Z", "a" TO "z", "_", "%", "$", "&", "#", "!", "~"
133.                 IsWord& = 0
134.                 EXIT FUNCTION
135.             CASE ELSE
136.                 SELECT CASE MID$(t$, position& + LEN(word$), 1)
137.                     CASE "0" TO "9", "A" TO "Z", "a" TO "z", "_", "%", "$", "&", "#", "!", "~"
138.                         IsWord& = 0
139.                         EXIT FUNCTION
140.                     CASE ELSE
141.                 END SELECT
142.         END SELECT
143.     END IF
144.     SELECT CASE MID$(t$, position& + LEN(word$), 1)
145.         CASE "0" TO "9", "A" TO "Z", "a" TO "z", "_", "%", "$", "&", "#", "!", "~"
146.             IsWord& = 0
147.             EXIT FUNCTION
148.         CASE ELSE
149.     END SELECT
150.     IF MID$(t$, position&, 1) = word$ THEN
151.         IsWord& = -1
152.     END IF
153. END FUNCTION
154.  

[codeguy]

Code: QB64: [Select]

1. WIDTH 160
2.  
3. TYPE BeginsEnds
4.     TheSubName AS STRING * 64
5.     Begins AS LONG
6.     ends AS LONG
7. END TYPE
8.  
9. '************************
10. '* this is a test
11. cwdsave$ = _CWD$
12. CHDIR _CWD$ + "\source"
13. junkcount& = 0
14. REDIM junk(0 TO 3) AS STRING
15. junk(0) = "sub testofbyval(byval T as integer, byval register as long, byval yellow as single, byref purple, byval a$())"
16. CLS
17. PRINT "BEFORE PROCESSING:"
18. PRINT junk(0)
19. PRINT junkcount&
20. HandleBYVAL junk(), junkcount&
21. PRINT "AFTER PROCESSING:"
22. FOR X& = 0 TO junkcount& - 1
23.     PRINT X&; junk(X&)
24. NEXT
25. ERASE junk
26. PRINT junkcount&
27. PRINT "------------DONE press a key"
28. DO
29.     X$ = INKEY$
30. LOOP UNTIL X$ > ""
31. CLS
32. REDIM TextArray$(0 TO 1023)
33. TextArrayLines& = 0
34.  
35. REDIM alert$(0 TO 511)
36. alertcount& = 0
37. TimeStartMerge! = TIMER(.001)
38. Result& = OpenInclude&("qb64.bas", TextArray$(), TextArrayLines&, alert$(), alertcount&)
39. TimeEndMerge! = TIMER(.001)
40. IF alertcount& > 0 THEN
41.     FOR p& = 0 TO alertcount& - 1
42.         PRINT alert$(p&); " was not merged"
43.     NEXT
44.     DO
45.         X$ = INKEY$
46.     LOOP UNTIL X$ > ""
47. END IF
48. TimeStartRemoveRemarks! = TIMER(.001)
49. Result& = RemoveCodeRemarks(TextArray$(), -1, -1)
50. TimeEndRemoveRemarks! = TIMER(.001)
51.  
52. MergeSubsCount& = 0
53. REDIM Subs(0 TO 511) AS BeginsEnds
54. FindSubsFunctions TextArray$(), "sub", "end", Subs(), MergeSubsCount&
55. IF MergeSubsCount& > 0 THEN
56.     PRINT MergeSubsCount&; " SUB found"
57.     _DELAY 10
58. END IF
59.  
60.  
61. MergeFunctionsCount& = 0
62. REDIM Functions(0 TO 511) AS BeginsEnds
63. FindSubsFunctions TextArray$(), "function", "end", Functions(), MergeFunctionsCount&
64. IF MergeFunctionsCount& THEN
65.     PRINT MergeFunctionsCount&; " FUNCTION found"
66.     _DELAY 10
67. END IF
68.  
69. CHDIR cwdsave$
70. beforelines& = TextArrayLines&
71. WHILE TextArray$(TextArrayLines&) = "" AND TextArrayLines& > 0
72.     TextArrayLines& = TextArrayLines& - 1
73. WEND
74.  
75. FOR X& = 0 TO TextArrayLines&
76.     PRINT X&; " "; TextArray$(X&)
77. NEXT
78. PRINT TextArrayLines&; Result&; beforelines&; UBOUND(textarray$)
79. PRINT "time to merge:"; (TimeEndMerge! - TimeStartMerge!)
80. PRINT "time to remove comments/unreferenced subs/functions:"; (TimeEndRemoveRemarks! - TimeStartRemoveRemarks!)
81. '* this was only a test
82. '************************
83. '*********************
84. '* Loads QB64 source, including $include: files
85. '* accepts forms:
86. '*      $include:<any number of spaces>'whateverfile' -- if $ is the first non-blank character on a line, this is handled like an implied apostrophe before
87. '* also REM      <any number of spaces>$include:'whateverfile'
88. '* also '$include:<any number of spaces>'whateverfile'
89. '* provided the $include: files are present, this loads them into a string array provided the file exists
90. '*********************
91.  
92. FUNCTION OpenInclude& (OIFile$, OICodeText() AS STRING, OILinesIn&, Warning$(), WarningCount&)
93.     IF _FILEEXISTS(OIFile$) THEN
94.         OIFileIO& = FREEFILE
95.         IF OIFileIO& > 0 THEN
96.             OPEN OIFile$ FOR INPUT AS #OIFileIO&
97.             WHILE NOT EOF(OIFileIO&)
98.                 IF OILinesIn& > UBOUND(OICodeText) THEN
99.                     units& = 10 - UBOUND(OICodeText) MOD 10
100.                     NewUbound& = (UBOUND(OICodeText) + units&) / 10 + 1
101.                     REDIM _PRESERVE OICodeText(LBOUND(OICodeText) TO UBOUND(OICodeText) + NewUbound&)
102.                 END IF
103.                 LINE INPUT #OIFileIO&, OICodeText(OILinesIn&)
104.                 fx$ = IncludeFile$(OICodeText(OILinesIn&))
105.                 IF fx$ > "" THEN
106.                     OICodeText(OILinesIn&) = "'* Merged " + fx$ + " *"
107.                     r& = OpenInclude(fx$, OICodeText(), OILinesIn&, Warning$(), WarningCount&)
108.                 ELSE
109.                     currentlines& = OILinesIn&
110.                     HandleBYVAL OICodeText(), OILinesIn&
111.                     IF OILinesIn& <> currentlines& THEN
112.                         OILinesIn& = OILinesIn& - 1
113.                     END IF
114.                 END IF
115.                 OILinesIn& = OILinesIn& + 1
116.             WEND
117.             CLOSE #OIFileIO&
118.             OpenInclude& = 1
119.             EXIT FUNCTION
120.         END IF
121.     ELSE
122.         Warning$(WarningCount&) = OIFile$
123.         WarningCount& = WarningCount& + 1
124.         '**********************
125.         '* maybe a dialog box for path or store in list of warnings
126.         '*******************
127.     END IF
128.     '* if this returns a 0 value, OpenInclude&() was not successful
129.     OpenInclude& = 0
130. END SUB
131.  
132. FUNCTION IncludeFile$ (IncludeFileTextX$)
133.     IncludeFile$ = ""
134.     '* do not alter the original code text
135.     TextX$ = LCASE$(LTRIM$(RTRIM$(IncludeFileTextX$)))
136.     q& = 1
137.     WHILE q& <= 3
138.         IF MID$(TextX$, q&, LEN("$include:")) = "$include:" THEN
139.             TextX$ = LTRIM$(MID$(TextX$, q& + LEN("$include:")))
140.             insc1& = INSTR(TextX$, "'")
141.             IF insc1& THEN
142.                 insc2& = INSTR(insc1& + 1, TextX$, "'")
143.                 IF insc2& > insc1& THEN
144.                     IncludeFile$ = MID$(TextX$, insc1& + 1, insc2& - (insc1& + 1))
145.                 END IF
146.             END IF
147.             EXIT FUNCTION
148.         END IF
149.         SELECT CASE LCASE$(LEFT$(TextX$, q&))
150.             CASE "$"
151.                 EXIT WHILE
152.             CASE "'$"
153.                 EXIT WHILE
154.             CASE "rem"
155.                 SELECT CASE MID$(TextX$, q& + 1, 1)
156.                     CASE " "
157.                         TextX$ = LTRIM$(MID$(TextX$, q& + 2))
158.                     CASE "$"
159.                         TextX$ = MID$(TextX$, q& + 1)
160.                     CASE ELSE
161.                         EXIT FUNCTION
162.                 END SELECT
163.                 q& = 1
164.         END SELECT
165.         q& = q& + 1
166.     WEND
167. END FUNCTION
168.  
169. FUNCTION RemoveCodeRemarks (CodeIn() AS STRING, stripRemarks&, RemoveWhiteSpaceLines&)
170.     RUCCleanedLines& = LBOUND(codeIn)
171.     FOR RUCq& = LBOUND(codein) TO UBOUND(codein)
172.         t$ = LCASE$(LTRIM$(CodeIn(RUCq&)))
173.         T& = LEN(t$)
174.         DO
175.             IF T& > 0 THEN
176.                 IF MID$(t$, T&, 1) = CHR$(34) THEN
177.                     '* skip anything inside quotes -- might miss some
178.                     '* comments, but better safe than sorry
179.                     EXIT DO
180.                 END IF
181.                 IF MID$(t$, T&, 1) = "'" THEN
182.                     t$ = LEFT$(t$, T& - 1)
183.                     EXIT DO
184.                 ELSE
185.                     T& = T& - 1
186.                 END IF
187.             ELSE
188.                 EXIT DO
189.             END IF
190.         LOOP
191.         SELECT CASE LEFT$(t$, 1)
192.             CASE "'", ""
193.                 _CONTINUE
194.             CASE ELSE
195.                 IF IsWord&(t$, "rem", 1) THEN
196.                     SELECT CASE MID$(t$, LEN("rem") + 1, 1)
197.                         CASE " ", "", CHR$(13)
198.                         CASE ELSE
199.                     END SELECT
200.                     _CONTINUE
201.                 ELSEIF IsWord&(t$, "sub", 1) THEN
202.                     PRINT RUCCleanedLines&; t$
203.                 ELSEIF IsWord(t$, "function", 1) THEN
204.                     PRINT RUCCleanedLines&; t$
205.                 END IF
206.         END SELECT
207.         CodeIn(RUCCleanedLines&) = CodeIn(RUCq&)
208.         RUCCleanedLines& = RUCCleanedLines& + 1
209.     NEXT
210.     '* clear remaining lines of code that have been processed
211.     WHILE RUCCleanedLines& <= UBOUND(codein)
212.         CodeIn(RUCCleanedLines&) = ""
213.         RUCCleanedLines& = RUCCleanedLines& + 1
214.     WEND
215. END FUNCTION
216.  
217. FUNCTION IsWord& (t$, word$, position&)
218.     IF position& > 1 THEN
219.         SELECT CASE MID$(t$, position& - 1, 1)
220.             CASE "0" TO "9", "A" TO "Z", "a" TO "z", "_", "%", "$", "&", "#", "!", "~"
221.                 IsWord& = 0
222.                 EXIT FUNCTION
223.             CASE ELSE
224.                 SELECT CASE MID$(t$, position& + LEN(word$), 1)
225.                     CASE "0" TO "9", "A" TO "Z", "a" TO "z", "_", "%", "$", "&", "#", "!", "~"
226.                         IsWord& = 0
227.                         EXIT FUNCTION
228.                     CASE ELSE
229.                 END SELECT
230.         END SELECT
231.     END IF
232.     SELECT CASE MID$(t$, position& + LEN(word$), 1)
233.         CASE "0" TO "9", "A" TO "Z", "a" TO "z", "_", "%", "$", "&", "#", "!", "~"
234.             IsWord& = 0
235.             EXIT FUNCTION
236.         CASE ELSE
237.     END SELECT
238.     IF MID$(t$, position&, 1) = word$ THEN
239.         IsWord& = -1
240.     END IF
241. END FUNCTION
242.  
243.  
244. '* FindSubsFunctions will scan for subs, functions once the code is merged and/or optionally comments stripped
245. SUB FindSubsFunctions (CodeIn() AS STRING, whattype$, terminal$, SubFunctionBeginEnd() AS BeginsEnds, subfunctioncount&)
246.     '* TheSubName AS STRING * 64
247.     '* Begins AS LONG
248.     '* ends AS LONG
249.     fsfx$ = LCASE$(whattype$) + " ": PRINT fsfx$
250.     FOR FSFScan& = LBOUND(CodeIn) TO UBOUND(CodeIn)
251.         text$ = LCASE$(LTRIM$(CodeIn(FSFScan&)))
252.         IF LEFT$(text$, LEN(whattype$) + 1) = fsfx$ THEN
253.             fsfxp& = INSTR(LEN(fsfx$), text$, "(")
254.             SubFunctionBeginEnd(subfunctioncount&).TheSubName = RTRIM$(LEFT$(text$, fsfxp& - 1))
255.             SubFunctionBeginEnd(subfunctioncount&).Begins = FSFScan&
256.         ELSEIF LEFT$(text$, LEN(terminal$ + " " + whattype$)) = terminal$ + " " + whattype$ THEN
257.             SubFunctionBeginEnd(subfunctioncount&).ends = FSFScan&
258.             'PRINT SubFunctionBeginEnd(subfunctioncount&).TheSubName
259.             'PRINT SubFunctionBeginEnd(subfunctioncount&).Begins
260.             'PRINT SubFunctionBeginEnd(subfunctioncount&).ends
261.             subfunctioncount& = subfunctioncount& + 1
262.         END IF
263.     NEXT
264. END SUB
265.  
266. SUB StringRemove (The$, whattoremove$, replaceitwith$)
267.     IF whattoremove$ <> replacewith$ THEN
268.         DO
269.             i& = INSTR(The$, whattoremove$)
270.             IF i& > 0 THEN
271.                 IF LEN(whattoremove$) = LEN(replacewith$) THEN
272.                     MID$(The$, i&, LEN(replacewith$)) = replacewith$
273.                 ELSE
274.                     The$ = LEFT$(The$, i& - 1) + replacewith$ + MID$(The$, i& + LEN(whattoremove$))
275.                 END IF
276.             ELSE
277.                 EXIT DO
278.             END IF
279.         LOOP
280.     END IF
281. END SUB
282.  
283. SUB HandleBYVAL (CodeIn() AS STRING, linecount&)
284.     text1$ = LCASE$(LTRIM$(RTRIM$(CodeIn(linecount&))))
285.     IF LEFT$(text1$, LEN("sub ")) = "sub " OR LEFT$(text1$, LEN("function ")) = "function " THEN
286.         IF INSTR(text1$, "byval ") OR INSTR(text1$, "byref ") THEN
287.             StringRemove text1$, "byref ", SPACE$(LEN("byref "))
288.             StringRemove text1$, SPACE$(2), SPACE$(1)
289.             StringRemove text1$, " )", ")"
290.             PRINT text1$
291.             inleftparen& = INSTR(text1$, "(")
292.             prefix$ = LEFT$(text1$, inleftparen& - 1)
293.             text1$ = MID$(text1$, inleftparen& + 1, LEN(text1$) - (inleftparen& + 1))
294.  
295.             '* isolate variables that are BYVAL by "[" and "]"
296.             DO
297.                 inbyval& = INSTR(text1$, "byval ")
298.                 IF inbyval& THEN
299.                     MID$(text1$, inbyval&, LEN("byval ") - 1) = SPACE$(LEN("byval ") - 1)
300.                     MID$(text1$, inbyval& + LEN("byval ") - 1, 1) = "["
301.                     sp& = INSTR(inbyval& + LEN("byval ") - 1, text1$, " ")
302.                     IF sp& > LEN(text1$) OR sp& = 0 THEN
303.                         text1$ = text1$ + "]"
304.                         EXIT DO
305.                     ELSE
306.                         MID$(text1$, sp&, 1) = "]"
307.                     END IF
308.                 ELSE
309.                     EXIT DO
310.                 END IF
311.             LOOP
312.             '* PRINT text1$
313.             '* BYVAL variables are now isolated between "[" and "]"
314.             '* knowing this, the appropriate DIM statements can be generated
315.             '* make a copy of this string -- copyText1$
316.             copytext1$ = text1$
317.             copytext2$ = ""
318.             dimreplace$ = "dim "
319.             DO
320.                 leftsquarebracket& = INSTR(copytext1$, "[")
321.                 IF leftsquarebracket& > 0 THEN
322.                     rightbracket& = INSTR(leftsquarebracket&, copytext1$, "]")
323.                     w$ = MID$(copytext1$, leftsquarebracket& + 1, rightbracket& - (leftsquarebracket& + 1))
324.                     '* PRINT w$
325.                     copytext2$ = copytext2$ + w$ + " = " + "byval_" + w$ + ": "
326.                     MID$(copytext1$, rightbracket&, 1) = " "
327.                     position& = leftsquarebracket& - LEN(dimreplace$) + 1
328.                     MID$(copytext1$, position&, LEN(dimreplace$)) = dimreplace$
329.                 ELSE
330.                     EXIT DO
331.                 END IF
332.             LOOP
333.             '* now replace all the "byval " in copytext1$ with "byval_"
334.             StringRemove copytext1$, "byval ", "byval_"
335.             'PRINT text1$; "---------- still yet to be transformed sub declaration ->"; prefix$
336.             'PRINT copytext1$; " in-sub declaration"
337.             'PRINT copytext2$; " in-sub assignments"
338.             DO
339.                 lb& = INSTR(text1$, "[")
340.                 IF lb& > 0 THEN
341.                     MID$(text1$, lb&, 1) = " "
342.                     rb& = INSTR(lb&, text1$, "]")
343.                     IF rb& > lb& THEN
344.                         MID$(text1$, rb&, 1) = " "
345.                         w$ = MID$(text1$, lb& + 1, rb& - (lb& + 1))
346.                         MID$(text1$, lb& - (LEN("byval_") - 1)) = "byval_"
347.                         '* PRINT w$
348.                     END IF
349.                 ELSE
350.                     EXIT DO
351.                 END IF
352.             LOOP
353.  
354.             '*************************
355.             '* now the transformations are done -- whew! what a mess
356.             '* PRINT text1$; "<------------------ transformed sub decclaration ---------->"; prefix$
357.             COPYTEXT0$ = prefix$ + " (" + LTRIM$(RTRIM$(text1$)) + ")"
358.             InsertCode CodeIn(), linecount&, COPYTEXT0$ '* insert the transformed sub/function line
359.             'InsertCode CodeIn(), linecount&, copytext1$ '* insert the in-sub/function declarations
360.             T& = 1
361.             DO
362.                 M& = INSTR(T& + 1, copytext1$, ",")
363.                 IF M& > T& THEN
364.                     '* PRINT MID$(copytext1$, T&, M& - T&)\
365.                     x$ = LTRIM$(MID$(copytext1$, T&, M& - T&))
366.                     IF INSTR(" " + x$, " dim ") THEN
367.                         InsertCode CodeIn(), linecount&, x$
368.                     END IF
369.                     T& = M& + 1
370.                 ELSE
371.                     '* PRINT MID$(copytext1$, T&)
372.                     x$ = LTRIM$(MID$(copytext1$, T&))
373.                     IF INSTR(" " + x$, " dim") THEN
374.                         InsertCode CodeIn(), linecount&, x$
375.                     END IF
376.                     EXIT DO
377.                 END IF
378.             LOOP
379.             '* PRINT "IN-SUB/FUNCTION VARIABLE DECLARATIONS FINISHED..."
380.             PRINT copytext2$
381.             T& = 1
382.             DO
383.                 M& = INSTR(T& + 1, copytext2$, ":")
384.                 IF M& > T& THEN
385.                     '* PRINT MID$(copytext2$, T&, M& - T&)
386.                     x$ = LTRIM$(MID$(copytext2$, T&, M& - T&))
387.                     IF x$ > "" THEN
388.                         InsertCode CodeIn(), linecount&, LTRIM$(MID$(copytext2$, T&, M& - T&))
389.                     END IF
390.                     T& = M& + 1
391.                 ELSE
392.                     '* PRINT MID$(copytext1$, T&)
393.                     x$ = LTRIM$(MID$(copytext2$, T&))
394.                     IF x$ > "" THEN
395.                         InsertCode CodeIn(), linecount&, LTRIM$(MID$(copytext2$, T&))
396.                     END IF
397.                     EXIT DO
398.                 END IF
399.             LOOP
400.             '* PRINT "in-sub/finction variable assignments finished"
401.             'InsertCode CodeIn(), linecount&, copytext2$ '* finally, insert the in-sub variable assignments
402.  
403.             '* now we can do the BYVAL variables, parsing between "{" and "_byv")
404.             'WHILE INSTR(text$, "()")
405.             '    k& = INSTR(text$, "()")
406.             '    typ$ = ""
407.             '    dontmess = -1
408.             '    FOR u& = 2 TO 1 STEP -1
409.             '        j& = k& - u&
410.             '        PRINT MID$(text$, j&, u&)
411.             '        SELECT CASE MID$(text$, j&, u&)
412.             '            CASE "~%"
413.             '                typ$ = "_byte"
414.             '            CASE "~%"
415.             '                typ$ = "_unsigned integer"
416.             '            CASE "~&"
417.             '                typ$ = "_unsigned long"
418.             '            CASE "~#"
419.             '                typ$ = "_unsigned double"
420.             '            CASE "%%"
421.             '                typ$ = "_integer64"
422.             '            CASE "##"
423.             '                typ$ = "_float"
424.  
425.             '            CASE "%" '* unary types here
426.             '                typ$ = "integer"
427.             '            CASE "$"
428.             '                typ$ = "string"
429.             '            CASE "&"
430.             '                typ$ = "long"
431.             '            CASE "#"
432.             '                typ$ = "double"
433.             '            CASE "!"
434.             '                typ$ = "single"
435.             '            CASE "~"
436.             '                typ$ = "_bit"
437.             '            CASE "0" TO "9", "A" TO "Z", "a" TO "z"
438.             '                dontmess = -1
439.             '                EXIT FOR
440.             '            CASE ELSE
441.             '        END SELECT
442.             '        IF typ$ > "" THEN EXIT FOR
443.             '    NEXT
444.             '    IF (dontmess) THEN '* this array has an alphanumeric character before (), not determined what type it is
445.             '        '****************
446.             '        '* project for later
447.             '        '****************
448.             '    ELSE
449.             '        text$ = LEFT$(text$, k& + 1) + " as " + typ$ + MID$(text$, k& + 2)
450.             '    END IF
451.             '    MID$(text$, k&, 2) = "??"
452.             'WEND
453.             'PRINT "Press a key..."
454.             'DO
455.             '    x$ = INKEY$
456.             'LOOP UNTIL x$ > ""
457.         END IF
458.     END IF
459. END SUB
460.  
461. SUB InsertCode (OICodetext() AS STRING, OILineIn&, the$)
462.     IF OILineIn& > UBOUND(OICodeText) THEN
463.         units& = 10 - UBOUND(OICodeText) MOD 10
464.         NewUbound& = (UBOUND(OICodeText) + units&) / 10 + 1
465.         REDIM _PRESERVE OICodetext(LBOUND(OICodeText) TO UBOUND(OICodeText) + NewUbound&) AS STRING
466.     END IF
467.     OICodetext(OILineIn&) = the$
468.     OILineIn& = OILineIn& + 1
469. END SUB
470.  

[codeguy]

do you have difficulty remembering ALL the data types in QB64 and/or their symbols? Well, here you go.

Code: QB64: [Select]

1. '* given a symbol, returns the string name of the type
2. '* or the symbol if given the name of the type
3. FUNCTION CodeGuyNameToSymbol$ (xName$)
4.     SELECT CASE xName$
5.         CASE "_BIT"
6.             s$ = "`"
7.         CASE "`"
8.             s$ = "_BIT"
9.         CASE "_BIT *"
10.         CASE "`"
11.         CASE "_UNSIGNED _BIT"
12.             s$ = "~`"
13.         CASE "~`"
14.             s$ = "_UNSIGNED _BIT"
15.         CASE "_BYTE"
16.             s$ = "%%"
17.         CASE "%%"
18.             s$ = "_BYTE"
19.         CASE "_UNSIGNED _BYTE"
20.             s$ = "~%%"
21.         CASE "~%%"
22.             s$ = "_UNSIGNED _BYTE"
23.         CASE "INTEGER"
24.             s$ = "%"
25.         CASE "%"
26.             s$ = "INTEGER"
27.         CASE "_UNSIGNED INTEGER"
28.             s$ = "~%"
29.         CASE "~%"
30.             s$ = "__UNSIGNED INTEGER"
31.         CASE "LONG"
32.             s$ = "&"
33.         CASE "&"
34.             s$ = "LONG"
35.         CASE "_UNSIGNED LONG"
36.             s$ = "~&"
37.         CASE "~&"
38.             s$ = "_UNSIGNED LONG"
39.         CASE "_INTEGER64"
40.             s$ = "&&"
41.         CASE "&&"
42.             s$ = "_INTEGER64"
43.         CASE "_UNSIGNED _INTEGER64"
44.             s$ = "~&&"
45.         CASE "~&&"
46.             s$ = "_UNSIGNED _INTEGER64"
47.         CASE "SINGLE"
48.             s$ = "!"
49.         CASE "!"
50.             s$ = "SINGLE"
51.         CASE "DOUBLE"
52.             s$ = "#"
53.         CASE "#"
54.             s$ = "DOUBLE"
55.         CASE "_FLOAT"
56.             s$ = "##"
57.         CASE "##"
58.             s$ = "_FLOAT"
59.         CASE "_OFFSET"
60.             s$ = "%&"
61.         CASE "%&"
62.             s$ = "_OFFSET"
63.         CASE "_UNSIGNED _OFFSET"
64.             s$ = "~%&"
65.         CASE "~%&"
66.             s$ = "_UNSIGNED _OFFSET"
67.         CASE ""
68.             s$ = "!"
69.         CASE "$"
70.             s$ = "STRING"
71.         CASE "STRING"
72.             s$ = "$"
73.         CASE ELSE
74.             IF LEFT$(xName$, LEN("BIT *")) = "BIT *" THEN
75.                 s$ = "`" + MID$(xName$, LEN("BIT *") + 1)
76.             ELSEIF LEFT$(xName$, LEN("`")) = "`" THEN
77.                 s$ = "BIT * " + MID$(xName$, LEN("`") + 1)
78.             END IF
79.     END SELECT
80.     CodeGuyNameToSymbol$ = s$
81. END FUNCTION
82. /code]

[bplus]

Hi codeguy,

Here's my cheat sheet:

Code: QB64: [Select]

1. 5 Integers Types:
2.  
3. name:           suffix: range:               unsigned:
4. _BIT            `       0 or 1               2 ^ 1
5. _BYTE           %%      -128 to 127          2 ^ 8 = 256 ^ 1
6. INTEGER         %       -32,768 to 32,767    256 ^ 2
7. LONG            &       10 digits            256 ^ 4
8. _INTEGER64      &&      very many digits     256 ^ 8
9.  
10.  
11. 3 Float Types:
12.  
13. SINGLE          !       4 bytes, 7 decimal
14. DOUBLE          #       8 bytes, 15 decimal
15. _FLOAT          ##      max precision
16.  
17. STRING          $      
18.  

eeeh spacing not preserved in quotes, try code then guys...

[codeguy]

I made code so you can find the appropriate extensions. It's to save time when tracking down variable types. Does not handle STRING *, but there are no symbolic replacements that will work in qb64. I think making $n usable in these cases would be nice. Wouldn't take much code to expand $1038 to STRING * 1023 or $(variable name) similarly. This code was made to be part of HandleBYVAL(), a mostly working prototype of being able to use variables in subs by value and not by reference, if you don't want the originals altered. In my Djikstra SmoothSort() code, this was necessary or the code would not work. VB can use BYVAL for all code. QB64 cannot, only for LIBRARY. I used HandleBYVAL() to convert other code too, saving me copy/paste/editing time. The only thing not worked out is array copying, so this function was made to be a power assist with a template idea I have. This could also allow other things using the same kind of code, just using different data types. This is essentially what BYVAL does: creates local copies of variables and uses them instead of the originals.

SUB SmoothSift (plngArray() AS dataelement, NodeIndex AS LONG, SubTreeSize AS LONG, LeftSubTreeSize AS LONG)
    DIM lngNodeIndex AS LONG: lngNodeIndex = NodeIndex
    DIM lngSubTreeSize AS LONG: lngSubTreeSize = SubTreeSize
    DIM lngLeftSubTreeSize AS LONG: lngLeftSubTreeSize = LeftSubTreeSize
    DIM lngChildIndex AS LONG

Code: QB64: [Select]

1. '* converted with thorough testing by CodeGuy 20Feb2018
2.  
3. TYPE dataelement
4.     thekey AS DOUBLE
5.     originalorder AS LONG
6. END TYPE
7. REDIM array(0 TO 2097151) AS dataelement
8. BitonicM& = LBOUND(array) + (UBOUND(array) - LBOUND(array)) \ 2
9. FOR method% = 0 TO 5
10.     FOR s& = LBOUND(array) TO UBOUND(array)
11.         SELECT CASE method%
12.             CASE 0
13.                 o$ = "descending"
14.                 '* (5.18s)
15.                 array(s&).thekey = UBOUND(ARRAy) - s&
16.             CASE 1
17.                 o$ = "ascending"
18.                 '* (.523s)
19.                 array(s&).thekey = s&
20.             CASE 2
21.                 o$ = "random"
22.                 '* (7.36s)
23.                 array(s&).thekey = RND
24.             CASE 3
25.                 o$ = "monotonic"
26.                 array(s&).thekey = 0
27.                 '*
28.             CASE 4
29.                 o$ = "bitonic"
30.                 '* (7.19s)
31.                 IF s& - 1 > BitonicM& THEN
32.                     array(s&).thekey = a&
33.                     a& = a& - 1
34.                 ELSE
35.                     array(s&).thekey = s&
36.                     a& = s&
37.                 END IF
38.             CASE 5
39.                 o$ = "few unique"
40.                 IF RND > .987654321 THEN
41.                     array(s&).thekey = RND
42.                 ELSE
43.                     array(s&).thekey = 0
44.                 END IF
45.         END SELECT
46.         array(s&).originalorder = s&
47.     NEXT
48.     startTimer! = TIMER(.001)
49.     SmoothSort array()
50.     endtimer! = TIMER(.001)
51.     h& = LBOUND(ARRAy)
52.     FOR s& = LBOUND(ARRAy) TO UBOUND(ARRAy)
53.         IF array(s&).thekey < array(h&).thekey THEN
54.             STOP
55.         ELSE
56.             'PRINT array(s&).thekey, ;
57.             'PRINT array(s&).originalorder
58.             IF array(s&).thekey > array(h&).thekey THEN
59.                 h& = s&
60.             END IF
61.         END IF
62.     NEXT
63.     PRINT (UBOUND(ARRAy) - LBOUND(ARRAy) + 1); " elements presented in "; o$; " order"
64.     PRINT (UBOUND(ARRAy) - LBOUND(ARRAy) + 1) / (endtimer! - startTimer!); " elements/second"; (endtimer! - startTimer!); "seconds..."
65. NEXT
66. '********************
67. '* Djikstra SmoothSort converted from VB 2018Feb20 by CodeGuy
68. '* There is no BYVAL, in QB64, so I did a workaround
69. '*************************
70. SUB SmoothSort (plngArray() AS dataelement)
71.     DIM lngOneBasedIndex AS LONG
72.     DIM lngNodeIndex AS LONG
73.     DIM lngLeftRightTreeAddress AS LONG
74.     DIM lngSubTreeSize AS LONG
75.     DIM lngLeftSubTreeSize AS LONG
76.  
77.     lngLeftRightTreeAddress = 1
78.     lngSubTreeSize = 1
79.     lngLeftSubTreeSize = 1
80.     lngOneBasedIndex = 1
81.     lngNodeIndex = 0
82.  
83.     DO WHILE lngOneBasedIndex <> UBOUND(plngArray) + 1
84.         IF lngLeftRightTreeAddress MOD 8 = 3 THEN
85.             SmoothSift plngArray(), lngNodeIndex, lngSubTreeSize, lngLeftSubTreeSize
86.             lngLeftRightTreeAddress = (lngLeftRightTreeAddress + 1) \ 4
87.             SmoothUp lngSubTreeSize, lngLeftSubTreeSize
88.             SmoothUp lngSubTreeSize, lngLeftSubTreeSize
89.         ELSEIF lngLeftRightTreeAddress MOD 4 = 1 THEN 'This is always true if it gets here
90.             IF lngOneBasedIndex + lngLeftSubTreeSize < UBOUND(plngArray) + 1 THEN
91.                 SmoothSift plngArray(), lngNodeIndex, lngSubTreeSize, lngLeftSubTreeSize
92.             ELSE
93.                 SmoothTrinkle plngArray(), lngNodeIndex, lngLeftRightTreeAddress, lngSubTreeSize, lngLeftSubTreeSize
94.             END IF
95.             DO
96.                 SmoothDown lngSubTreeSize, lngLeftSubTreeSize
97.                 lngLeftRightTreeAddress = lngLeftRightTreeAddress * 2
98.             LOOP WHILE lngSubTreeSize <> 1 'Continue until we reach the bottom of the tree
99.             lngLeftRightTreeAddress = lngLeftRightTreeAddress + 1
100.         END IF
101.         lngOneBasedIndex = lngOneBasedIndex + 1
102.         lngNodeIndex = lngNodeIndex + 1
103.     LOOP
104.  
105.     SmoothTrinkle plngArray(), lngNodeIndex, lngLeftRightTreeAddress, lngSubTreeSize, lngLeftSubTreeSize
106.     DO WHILE lngOneBasedIndex <> 1
107.         lngOneBasedIndex = lngOneBasedIndex - 1
108.         IF lngSubTreeSize = 1 THEN
109.             lngNodeIndex = lngNodeIndex - 1
110.             lngLeftRightTreeAddress = lngLeftRightTreeAddress - 1
111.             DO WHILE lngLeftRightTreeAddress MOD 2 = 0
112.                 lngLeftRightTreeAddress = lngLeftRightTreeAddress / 2
113.                 SmoothUp lngSubTreeSize, lngLeftSubTreeSize
114.             LOOP
115.         ELSEIF lngSubTreeSize >= 3 THEN 'It must fall in here, sub trees are either size 1,1,3,5,9,15 etc
116.             lngLeftRightTreeAddress = lngLeftRightTreeAddress - 1
117.             lngNodeIndex = lngNodeIndex + lngLeftSubTreeSize - lngSubTreeSize
118.             IF lngLeftRightTreeAddress <> 0 THEN
119.                 SmoothSemiTrinkle plngArray(), lngNodeIndex, lngLeftRightTreeAddress, lngSubTreeSize, lngLeftSubTreeSize
120.             END IF
121.             SmoothDown lngSubTreeSize, lngLeftSubTreeSize
122.             lngLeftRightTreeAddress = lngLeftRightTreeAddress * 2 + 1
123.             lngNodeIndex = lngNodeIndex + lngLeftSubTreeSize
124.             SmoothSemiTrinkle plngArray(), lngNodeIndex, lngLeftRightTreeAddress, lngSubTreeSize, lngLeftSubTreeSize
125.             SmoothDown lngSubTreeSize, lngLeftSubTreeSize
126.             lngLeftRightTreeAddress = lngLeftRightTreeAddress * 2 + 1
127.         END IF
128.     LOOP
129. END SUB
130.  
131. SUB SmoothUp (lngSubTreeSize AS LONG, lngLeftSubTreeSize AS LONG)
132.     DIM sutemp AS LONG
133.     sutemp = lngSubTreeSize + lngLeftSubTreeSize + 1
134.     lngLeftSubTreeSize = lngSubTreeSize
135.     lngSubTreeSize = sutemp
136. END SUB
137.  
138. SUB SmoothDown (lngSubTreeSize AS LONG, lngLeftSubTreeSize AS LONG)
139.     DIM sdtemp AS LONG
140.     sdtemp = lngSubTreeSize - lngLeftSubTreeSize - 1
141.     lngSubTreeSize = lngLeftSubTreeSize
142.     lngLeftSubTreeSize = sdtemp
143. END SUB
144.  
145. SUB SmoothSift (plngArray() AS dataelement, NodeIndex AS LONG, SubTreeSize AS LONG, LeftSubTreeSize AS LONG)
146.     DIM lngNodeIndex AS LONG: lngNodeIndex = NodeIndex
147.     DIM lngSubTreeSize AS LONG: lngSubTreeSize = SubTreeSize
148.     DIM lngLeftSubTreeSize AS LONG: lngLeftSubTreeSize = LeftSubTreeSize
149.     DIM lngChildIndex AS LONG
150.  
151.     DO WHILE lngSubTreeSize >= 3
152.         lngChildIndex = lngNodeIndex - lngSubTreeSize + lngLeftSubTreeSize
153.         IF plngArray(lngChildIndex).thekey < plngArray(lngNodeIndex - 1).thekey THEN
154.             lngChildIndex = lngNodeIndex - 1
155.             SmoothDown lngSubTreeSize, lngLeftSubTreeSize
156.         END IF
157.  
158.         IF plngArray(lngNodeIndex).thekey >= plngArray(lngChildIndex).thekey THEN
159.             lngSubTreeSize = 1
160.         ELSE
161.             Exchange plngArray(), lngNodeIndex, lngChildIndex
162.             lngNodeIndex = lngChildIndex
163.             SmoothDown lngSubTreeSize, lngLeftSubTreeSize
164.         END IF
165.     LOOP
166. END SUB
167.  
168. SUB SmoothTrinkle (plngArray() AS dataelement, NodeIndex AS LONG, LeftRightTreeAddress AS LONG, SubTreeSize AS LONG, LeftSubTreeSize AS LONG)
169.     DIM lngNodeIndex AS LONG: lngNodeIndex = NodeIndex
170.     DIM lngLeftRightTreeAddress AS LONG: lngLeftRightTreeAddress = LeftRightTreeAddress
171.     DIM lngSubTreeSize AS LONG: lngSubTreeSize = SubTreeSize
172.     DIM lngLeftSubTreeSize AS LONG: lngLeftSubTreeSize = LeftSubTreeSize
173.     DIM lngChildIndex AS LONG
174.     DIM lngPreviousCompleteTreeIndex AS LONG
175.     DO WHILE lngLeftRightTreeAddress > 0
176.         DO WHILE lngLeftRightTreeAddress MOD 2 = 0
177.             lngLeftRightTreeAddress = lngLeftRightTreeAddress \ 2
178.             SmoothUp lngSubTreeSize, lngLeftSubTreeSize
179.         LOOP
180.         lngPreviousCompleteTreeIndex = lngNodeIndex - lngSubTreeSize
181.         IF lngLeftRightTreeAddress = 1 THEN
182.             lngLeftRightTreeAddress = 0
183.         ELSEIF plngArray(lngPreviousCompleteTreeIndex).thekey <= plngArray(lngNodeIndex).thekey THEN
184.             lngLeftRightTreeAddress = 0
185.         ELSE
186.             lngLeftRightTreeAddress = lngLeftRightTreeAddress - 1
187.             IF lngSubTreeSize = 1 THEN
188.                 Exchange plngArray(), lngNodeIndex, lngPreviousCompleteTreeIndex
189.                 lngNodeIndex = lngPreviousCompleteTreeIndex
190.             ELSEIF lngSubTreeSize >= 3 THEN
191.                 lngChildIndex = lngNodeIndex - lngSubTreeSize + lngLeftSubTreeSize
192.                 IF plngArray(lngChildIndex).thekey < plngArray(lngNodeIndex - 1).thekey THEN
193.                     lngChildIndex = lngNodeIndex - 1
194.                     SmoothDown lngSubTreeSize, lngLeftSubTreeSize
195.                     lngLeftRightTreeAddress = lngLeftRightTreeAddress * 2
196.                 END IF
197.                 IF plngArray(lngPreviousCompleteTreeIndex).thekey >= plngArray(lngChildIndex).thekey THEN
198.                     Exchange plngArray(), lngNodeIndex, lngPreviousCompleteTreeIndex
199.                     lngNodeIndex = lngPreviousCompleteTreeIndex
200.                 ELSE
201.                     Exchange plngArray(), lngNodeIndex, lngChildIndex
202.                     lngNodeIndex = lngChildIndex
203.                     SmoothDown lngSubTreeSize, lngLeftSubTreeSize
204.                     lngLeftRightTreeAddress = 0
205.                 END IF
206.             END IF
207.         END IF
208.     LOOP
209.     SmoothSift plngArray(), lngNodeIndex, lngSubTreeSize, lngLeftSubTreeSize
210. END SUB
211.  
212. SUB SmoothSemiTrinkle (plngArray() AS dataelement, NodeIndex AS LONG, LeftRightTreeAddress AS LONG, SubTreeSize AS LONG, LeftSubTreeSize AS LONG)
213.     DIM lngNodeIndex AS LONG: lngNodeIndex = NodeIndex
214.     DIM lngLeftRightTreeAddress AS LONG: lngLeftRightTreeAddress = LeftRightTreeAddress
215.     DIM lngSubTreeSize AS LONG: lngSubTreeSize = SubTreeSize
216.     DIM lngLeftSubTreeSize AS LONG: lngLeftSubTreeSize = LeftSubTreeSize
217.     DIM lngIndexTopPreviousCompleteHeap AS LONG
218.     lngIndexTopPreviousCompleteHeap = lngNodeIndex - lngLeftSubTreeSize
219.     IF plngArray(lngIndexTopPreviousCompleteHeap).thekey > plngArray(lngNodeIndex).thekey THEN
220.         Exchange plngArray(), lngNodeIndex, lngIndexTopPreviousCompleteHeap
221.         SmoothTrinkle plngArray(), lngIndexTopPreviousCompleteHeap, lngLeftRightTreeAddress, lngSubTreeSize, lngLeftSubTreeSize
222.     END IF
223. END SUB
224.  
225. SUB Exchange (mlngArray() AS dataelement, plng1 AS LONG, plng2 AS LONG)
226.     SWAP mlngArray(plng1), mlngArray(plng2)
227.  
228.     'lngSwap.thekey = mlngArray(plng1).thekey
229.     'mlngArray(plng1).thekey = mlngArray(plng2).thekey
230.     'mlngArray(plng2).thekey = lngSwap.thekey
231.  
232.     'lngSwap.originalorder = mlngArray(plng1).originalorder
233.     'mlngArray(plng1).originalorder = mlngArray(plng2).originalorder
234.     'mlngArray(plng2).originalorder = lngSwap.originalorder
235. END SUB
236.  

[bplus]

Hi codeguy,

Oh yeah, I forgot about fixed strings too. As I recall, that is all you can use in a TYPE definition.

I use to do fixed strings all the time with Database stuff for file records QBsomething... and VBDOS

Ran into host of problems using fixed strings in Defined Type because of spacing.

[codeguy]

SUB GenericCopyArray(GenericDataTypeArrayDest@(),GenericDataTypeArraySource@())
GenericCopyArrayLBBV&=LBOUND(GenericDataTypeArraySource@)
GenericCopyArrayUBBV&=UBOUND(GenericDataTypeArraySource@)
REDIM (GenericDataTypeArrayDest@(GenericCopyArrayLBBV& to GenericCopyArrayUBBV&)
    FOR GenericDataTypeArraySource& = GenericCopyArrayLBBV& to GenericCopyArrayUBBV&
    GenericDataTypeArrayDest@(GenericDataTypeArraySource&) = GenericDataTypeArraySource@(GenericDataTypeArraySource&)
NEXT
END SUB

this would allow me to include code like this array copy code and change the @ with the actual data types of the array.