QB64.org Forum

Active Forums => QB64 Discussion => Topic started by: badger on September 29, 2020, 12:00:38 pm

Title: memory leak and question
Post by: badger on September 29, 2020, 12:00:38 pm

Hello

First the question. When a sub is call when the end sub or exit sub is encountered does it return to the next statement after the call

memory leak i am going to post my code here. I use rem statement to an excess do to my eyes so the code will not run together so please dont pound on me about the clutter ok just look at the prompt area and tell me if i left any memory leaks

thanks in advance
Badger
if this is not allowed sorry please delete and let me know how to post code


REM ***************************************************************************
REM **** Program Bridal Store *************************************************
REM ***************************************************************************
REM ***************************************************************************
REM **** Author Philip King  **************************************************
REM ***************************************************************************
REM ***************************************************************************
REM ***************************************************************************
REM **** Includes go here *****************************************************
REM ***************************************************************************

REM ***************************************************************************
REM ***************************************************************************
REM **** Sreen statements here ************************************************
REM ***************************************************************************

$COLOR:32

REM ***************************************************************************

REM ***************************************************************************
REM **** Listing of subs and funtions *****************************************
REM ***************************************************************************

REM ***************************************************************************

REM ***************************************************************************
REM **** arrays decleared here ************************************************
REM ***************************************************************************
imenu = 4
DIM SHARED smenu(imenu) AS STRING

REM ***************************************************************************

REM ***************************************************************************
REM **** arrays set to data here **********************************************
REM ***************************************************************************

smenu(1) = "1) Edit Customer Info": smenu(2) = "3) Edit Inventory Data "
smenu(3) = "2) Edit Sales ": smenu(4) = "4) System Maintenance "

REM ***************************************************************************
REM **** variables declares go here *******************************************
REM ***************************************************************************
DIM SHARED sr AS STRING
CONST null = ""
REM ***************************************************************************

REM ***************************************************************************
REM **** customer info record type ********************************************
REM ***************************************************************************
TYPE customer
        id AS LONG
        sfirst_name AS STRING * 25
        slast_name AS STRING * 25
        saddress AS STRING * 30
        scity AS STRING * 25
        sstate AS STRING * 2
        szip AS STRING * 5
        sphone AS STRING * 10
END TYPE
REM ***************************************************************************

REM ***************************************************************************
REM **** inventory record type ************************************************
REM ***************************************************************************
TYPE inventory
        ienventory AS LONG
        sdesc AS STRING * 250
        sdate_bought AS STRING * 8
        sdate_sold AS STRING * 8
        fcost AS _FLOAT
        fretail AS _FLOAT
        ssize AS STRING * 2
        ssold AS STRING * 1
END TYPE
REM ***************************************************************************

REM ***************************************************************************
REM **** point of sale type ***************************************************
REM ***************************************************************************
TYPE spos
        lposid AS LONG
END TYPE
REM ***************************************************************************
DIM SHARED custinforec AS customer
custinforeclen = LEN(custinforec)

CLS


REM ***************************************************************************
REM **** defines for quick use data types *************************************
REM ***************************************************************************
_DEFINE I AS INTEGER : _DEFINE S AS STRING : _DEFINE D AS DOUBLE :
_DEFINE F AS _FLOAT : _DEFINE L AS LONG
REM ***************************************************************************


REM ***************************************************************************
REM **** main modual **********************************************************
REM ***************************************************************************
SCREEN _NEWIMAGE(640, 400, 32)
COLOR LightCyan, MidnightBlue
iflag2 = 0
iflag3 = 1
CLS
'SCREEN 12
_FULLSCREEN
IF se = "X" THEN END
GOSUB menuloop:
IF saction = "X" THEN END
'if se ="1" then call that prompt
'LINE INPUT siy: END
REM ***************************************************************************
REM **** main menu loop *******************************************************
REM ***************************************************************************

menuloop:
CALL systemheader
CALL printmain
CALL mainmenuchoice
IF sr = "" OR sr = CHR$(13) THEN GOTO menuloop
IF sr = "X" THEN END
'IF sr = "1" THEN CALL custinfo: 'GOSUB custinfo1
IF sr = "1" THEN
        CALL promptid
        CALL promptfname
        CALL promptlname
        CALL promptaddress
        CALL promptcity
        CALL promptsstate
        CALL promptszip
        CALL promptphone
        RETURN
END IF
REM ***************************************************************************




REM ***************************************************************************
REM **** customer input modual ************************************************
REM ***************************************************************************

's0:
SUB custinput
        CALL systemheader
        LOCATE 10, 1: PRINT "Customer ID           ";: PRINT custinforec.id
        LOCATE 11, 1: PRINT "Customer First Name   ";: PRINT custinforec.sfirst_name
        LOCATE 12, 1: PRINT "customer Last Name    ";: PRINT custinforec.slast_name
        LOCATE 13, 1: PRINT "Customer Address      ";: PRINT custinforec.saddress
        LOCATE 14, 1: PRINT "Customer City         ";: PRINT custinforec.scity
        LOCATE 15, 1: PRINT "customer State        ";: PRINT custinforec.sstate
        LOCATE 16, 1: PRINT "customer Zip          ";: PRINT custinforec.szip
        LOCATE 17, 1: PRINT "Customer Phone Number ";
        PRINT LEFT$(custinforec.sphone, 3) + "/"; MID$(custinforec.sphone, 4, 3) + "/"; RIGHT$(custinforec.sphone, 4)
        'RETURN
END SUB
REM ********************************************************************
's1:
SUB promptid
        CALL custinput
        saction = "Enter Customer ID X to Exit "
        ib = 9
        ilow = 1
        ihigh = 999999999
        iflag1 = 1
        IF iflag2 = 1 THEN
                CALL clearprompt
                CALL salphainput(saction, ib, ilow, ihigh, iflag1)
        ELSE
                CALL clearprompt
                CALL salphainput(saction, ib, ilow, ihigh, iflag1)
        END IF
        IF sr = "-" THEN
                EXIT SUB
                RETURN
        END IF
        IF sr = "X" THEN
                iflag1 = 0
                EXIT SUB
                RETURN
        END IF
        custinforec.id = VAL(sr): CALL custinput
END SUB
REM ********************************************************************
's2:
SUB promptfname
        CALL custinput
        saction = "Enter First Name X to Exit - To Backup "
        ib = 25
        ilow = 99
        ihigh = 99
        iflag1 = 0
        IF iflag2 = 1 THEN
                CALL clearprompt
                CALL salphainput(saction, ib, ilow, ihigh, iflag1)
        ELSE
                CALL clearprompt
                CALL salphainput(saction, ib, ilow, ihigh, iflag1)
        END IF

        IF sr = "-" THEN
                EXIT SUB
                CALL promptid
        END IF
        IF sr = "X" THEN
                EXIT SUB
        END IF

        custinforec.sfirst_name = sr: CALL custinput
END SUB
REM ***************************************************************************
's3:
SUB promptlname
        CALL custinput
        saction = "Enter Last Name X to Exit To Back up "
        ib = 25
        ilow = 99
        ihigh = 99
        iflag1 = 0
        IF iflag2 = 1 THEN
                CALL clearprompt
                CALL salphainput(saction, ib, ilow, ihigh, iflag1)
        ELSE
                CALL clearprompt
                CALL salphainput(saction, ib, ilow, ihigh, iflag1)
        END IF

        '        IF sr = "-" THEN
        '                EXIT SUB
        '                CALL promptfname
        '       END IF
        IF sr = "X" THEN
                EXIT SUB
                RETURN
        END IF
        custinforec.slast_name = sr
        CALL custinput
END SUB
REM ***************************************************************************
's4:
SUB promptaddress
        CALL custinput
        saction = "Enter Address X to Exit - To Back up "
        ib = 30
        ilow = 99
        ihigh = 99
        iflag1 = 0

        IF iflag2 = 1 THEN
                CALL clearprompt
                CALL salphainput(saction, ib, ilow, ihigh, iflag1)
        ELSE
                CALL clearprompt
                CALL salphainput(saction, ib, ilow, ihigh, iflag1)
        END IF

        IF sr = "-" THEN
                EXIT SUB
                CALL promptlname
        END IF



        IF sr = "X" THEN
                EXIT SUB
                RETURN
        END IF
        custinforec.saddress = sr
        CALL custinput
END SUB
REM ***************************************************************************
's5:
SUB promptcity
        CALL custinput
        saction = "Enter City Name X to Exit - To Back up "
        ib = 25
        ilow = 99
        ihigh = 99
        iflag1 = 0
        IF iflag2 = 1 THEN
                CALL clearprompt
                CALL salphainput(saction, ib, ilow, ihigh, iflag1)
        ELSE
                CALL clearprompt
                CALL salphainput(saction, ib, ilow, ihigh, iflag1)
        END IF

        IF sr = "-" THEN
                EXIT SUB
                CALL promptaddress
        END IF
        IF sr = "X" THEN
                EXIT SUB
                RETURN
        END IF
        custinforec.scity = sr
        CALL custinput
END SUB
REM ***************************************************************************
's6:
SUB promptsstate
        CALL custinput
        saction = "Enter State X to Exit - To Back up "
        ib = 2
        ilow = 99
        ihigh = 99
        iflag1 = 0
        IF iflag2 = 1 THEN
                CALL clearprompt
                CALL salphainput(saction, ib, ilow, ihigh, iflag1)
        ELSE
                CALL clearprompt
                CALL salphainput(saction, ib, ilow, ihigh, iflag1)
        END IF

        IF sr = "-" THEN
                EXIT SUB
                CALL promptcity
        END IF
        IF sr = "X" THEN
                EXIT SUB
                RETURN
        END IF
        custinforec.sstate = sr
        CALL custinput
END SUB

REM ***************************************************************************

's7:
SUB promptszip
        CALL custinput
        saction = "Enter Zip Code Name X to Exit - To Back up "
        ib = 5
        ilow = 99
        ihigh = 99
        iflag1 = 0
        IF iflag2 = 1 THEN
                CALL clearprompt
                CALL salphainput(saction, ib, ilow, ihigh, iflag1)
        ELSE
                CALL clearprompt
                CALL salphainput(saction, ib, ilow, ihigh, iflag1)
        END IF

        IF sr = "-" THEN
                EXIT SUB
                CALL promptsstate
        END IF
        IF sr = "X" THEN
                EXIT SUB
                RETURN
        END IF
        custinforec.szip = sr
        CALL custinput
END SUB
REM ***************************************************************************
's8:
SUB promptphone
        CALL custinput
        saction = "Enter Phone Number X to Exit - To Back up "
        ib = 30
        ilow = 99
        ihigh = 99
        iflag1 = 0
        IF iflag2 = 1 THEN
                CALL clearprompt
                CALL salphainput(saction, ib, ilow, ihigh, iflag1)
        ELSE
                CALL clearprompt
                CALL salphainput(saction, ib, ilow, ihigh, iflag1)
        END IF

        IF sr = "-" THEN
                EXIT SUB
                CALL promptszip
        END IF
        IF sr = "X" THEN
                EXIT SUB
                RETURN
        END IF
        custinforec.sphone = sr
        CALL custinput
        LINE INPUT sr
END SUB

REM ***************************************************************************


REM ***************************************************************************
REM **** set custinforrec variables to zero or null ***************************
REM ***************************************************************************
SUB custinforec_null
        custinforec.id = 0
        custinforec.sfirst_name = null
        custinforec.slast_name = null
        custinforec.saddress = null
        custinforec.scity = null
        custinforec.sstate = null
        custinforec.szip = null
        custinforec.sphone = null
END SUB
REM ***************************************************************************

REM ***************************************************************************
REM **** Sytem Header *********************************************************
REM ***************************************************************************
SUB systemheader
        COLOR White, Blue
        CLS
        LOCATE 1, 1: PRINT CHR$(201): LOCATE 1, 80: PRINT CHR$(187)
        LOCATE 1, 2: PRINT STRING$(78, 205):
        FOR ix = 2 TO 7
                LOCATE ix, 1: PRINT CHR$(186)
                LOCATE ix, 80: PRINT CHR$(186)
        NEXT ix
        LOCATE 7, 2: PRINT STRING$(78, 205)
        LOCATE 7, 1: PRINT CHR$(200): LOCATE 7, 80: PRINT CHR$(188)
        LOCATE 4, 30: PRINT "Main System Menu"
        LOCATE 4, 63: PRINT "Date ": LOCATE 4, 68: PRINT DATE$
        LOCATE 4, 4: PRINT "Virsion 1.0"
END SUB



REM ***************************************************************************
REM **** printes in system erros **********************************************
REM ***************************************************************************
SUB sprintserrors (se)
        CLS
        SCREEN 0
        IF se = "" THEN se = "INVALID RESPONSE"
        itemp = LEN(se)
        itemp1 = 40 - (itemp / 2)
        BEEP
        COLOR 16, 7
        'COLOR Yellow, Blue
        LOCATE 25, itemp1: _BLINK ON: PRINT se;
        Delay 1.5
        _BLINK OFF
        $COLOR:0
        iflag2 = 1
END SUB
REM ***************************************************************************

REM *****************************************************************************
REM **** numeric input sub ******************************************************
REM *****************************************************************************
SUB snumeric (sr, ilow, ihigh)

        ftemp = VAL(sr)
        IF ftemp < ilow OR ftemp > ihigh THEN
                se = "INPUT OUT OF BOUNDS"
                CALL sprintserrors(se)
        END IF

END SUB
REM ***************************************************************************

REM ***************************************************************************
REM **** alpha input sub ******************************************************
REM ***************************************************************************
SUB salphainput (saction, ib, ilow, ihigh, iflag1)

        iflag2 = 0
        ilength1 = LEN(sr)
        ilength2 = LEN(saction) + 2

        LOCATE 23, 1: PRINT saction; '               prints action menu
        LOCATE 23, ilength2 '                        set prompt one space after action menu print
        COLOR Yellow, Black: PRINT SPC(ib); '                changes color and prints ib spaces to screen for input lenght
        LOCATE 23, ilength2 '                        sets curser at the begining of input space from previouse line
        LINE INPUT sr: sr = UCASE$(sr) '             inputs data from user changes it to upper case

        IF LEN(sr) > ib THEN
                se = "ENVALID INPUT LENGTH"
                CALL sprintserrors(se)
                sr = ""
                iflag2 = 1
        END IF
        IF iflag1 = 1 AND sr = "X" THEN iflag1 = 0
        IF iflag1 = 1 AND VAL(sr) < ilow AND VAL(sr) > ihigh THEN CALL snumeric(sr, ilow, ihigh)

        COLOR White, Blue
END SUB


REM ***************************************************************************
REM **** main menu to the screen **********************************************
REM ***************************************************************************
SUB printmain
        COLOR White, Blue
        FOR ix = 11 TO imenu
                READ smenu(ix): LOCATE ix, 20: PRINT smenu(ix)
        NEXT ix

        LOCATE 11, 15: PRINT smenu(1)
        LOCATE 11, 40: PRINT smenu(2)
        LOCATE 13, 15: PRINT smenu(3)
        LOCATE 13, 40: PRINT smenu(4)

END SUB
REM ***************************************************************************

REM ***************************************************************************
REM **** array data goes here *************************************************
REM ***************************************************************************

SUB Delay (dlay!)
        start! = TIMER
        DO WHILE start! + dlay! >= TIMER
                IF start! > TIMER THEN start! = start! - 86400
        LOOP
END SUB

REM ***************************************************************************

REM ***************************************************************************
REM **** menu prompts start here **********************************************
REM ***************************************************************************
SUB mainmenuchoice
        ib = 1
        ihigh = 99
        ilow = 1
        saction = "Choose Menu Option or X to Quit "
        CALL salphainput(saction, ib, ilow, ihigh, iflag1)
END SUB
REM ***************************************************************************

REM ***************************************************************************
REM **** clean up the prompt area *********************************************
REM ***************************************************************************

SUB clearprompt
        LOCATE 23, 1: PRINT STRING$(79, 32)
END SUB

REM ***************************************************************************

Title: Re: memory leak and question
Post by: bplus on September 29, 2020, 12:20:30 pm

Quote

First the question. When a sub is call when the end sub or exit sub is encountered does it return to the next statement after the call

Yes!

For posting code here at forum,
paste copy of code into editor, select it, and then use Code Tag button looks like QB64 icon:
  [ This attachment cannot be displayed inline in 'Print Page' view ]  

Title: Re: memory leak and question
Post by: badger on September 29, 2020, 12:27:27 pm

Hello

will do

Badger
like this

Code: QB64: [Select]

1. REM ***************************************************************************
2. REM **** Program Bridal Store *************************************************
3. REM ***************************************************************************
4. REM ***************************************************************************
5. REM **** Author Philip King  **************************************************
6. REM ***************************************************************************
7. REM ***************************************************************************
8. REM ***************************************************************************
9. REM **** Includes go here *****************************************************
10. REM ***************************************************************************
11.  
12. REM ***************************************************************************
13. REM ***************************************************************************
14. REM **** Sreen statements here ************************************************
15. REM ***************************************************************************
16.  
17. $COLOR:32
18.  
19. REM ***************************************************************************
20.  
21. REM ***************************************************************************
22. REM **** Listing of subs and funtions *****************************************
23. REM ***************************************************************************
24.  
25. REM ***************************************************************************
26.  
27. REM ***************************************************************************
28. REM **** arrays decleared here ************************************************
29. REM ***************************************************************************
30. imenu = 4
31. DIM SHARED smenu(imenu) AS STRING
32.  
33. REM ***************************************************************************
34.  
35. REM ***************************************************************************
36. REM **** arrays set to data here **********************************************
37. REM ***************************************************************************
38.  
39. smenu(1) = "1) Edit Customer Info": smenu(2) = "3) Edit Inventory Data "
40. smenu(3) = "2) Edit Sales ": smenu(4) = "4) System Maintenance "
41.  
42. REM ***************************************************************************
43. REM **** variables declares go here *******************************************
44. REM ***************************************************************************
45. DIM SHARED sr AS STRING
46. CONST null = ""
47. REM ***************************************************************************
48.  
49. REM ***************************************************************************
50. REM **** customer info record type ********************************************
51. REM ***************************************************************************
52. TYPE customer
53.         id AS LONG
54.         sfirst_name AS STRING * 25
55.         slast_name AS STRING * 25
56.         saddress AS STRING * 30
57.         scity AS STRING * 25
58.         sstate AS STRING * 2
59.         szip AS STRING * 5
60.         sphone AS STRING * 10
61. END TYPE
62. REM ***************************************************************************
63.  
64. REM ***************************************************************************
65. REM **** inventory record type ************************************************
66. REM ***************************************************************************
67. TYPE inventory
68.         ienventory AS LONG
69.         sdesc AS STRING * 250
70.         sdate_bought AS STRING * 8
71.         sdate_sold AS STRING * 8
72.         fcost AS _FLOAT
73.         fretail AS _FLOAT
74.         ssize AS STRING * 2
75.         ssold AS STRING * 1
76. END TYPE
77. REM ***************************************************************************
78.  
79. REM ***************************************************************************
80. REM **** point of sale type ***************************************************
81. REM ***************************************************************************
82. TYPE spos
83.         lposid AS LONG
84. END TYPE
85. REM ***************************************************************************
86. DIM SHARED custinforec AS customer
87. lcustinforeclen = LEN(custinforec)
88.  
89. CLS
90.  
91.  
92. REM ***************************************************************************
93. REM **** defines for quick use data types *************************************
94. REM ***************************************************************************
95. _DEFINE I AS INTEGER : _DEFINE S AS STRING : _DEFINE D AS DOUBLE :
96. _DEFINE F AS _FLOAT : _DEFINE L AS LONG
97. REM ***************************************************************************
98.  
99.  
100. REM ***************************************************************************
101. REM **** main modual **********************************************************
102. REM ***************************************************************************
103. SCREEN _NEWIMAGE(640, 400, 32)
104. COLOR LightCyan, MidnightBlue
105. iflag2 = 0
106. iflag3 = 1
107. CLS
108. _FULLSCREEN
109. IF se = "X" THEN END
110. GOSUB menuloop:
111. REM ***************************************************************************
112. REM **** main menu loop *******************************************************
113. REM ***************************************************************************
114.  
115. menuloop:
116. CALL systemheader
117. CALL printmain
118. CALL mainmenuchoice
119. IF sr = "" OR sr = CHR$(13) THEN GOTO menuloop
120. IF sr = "X" THEN END
121. 'IF sr = "1" THEN CALL custinfo: 'GOSUB custinfo1
122.  
123. IF sr = "1" THEN
124.         CALL promptid
125.         IF sr = "X" THEN RETURN
126.         CALL promptfname
127.         IF sr = "X" THEN RETURN
128.         CALL promptlname
129.         IF sr = "X" THEN RETURN
130.         CALL promptaddress
131.         IF sr = "X" THEN RETURN
132.         CALL promptcity
133.         IF sr = "X" THEN RETURN
134.         CALL promptsstate
135.         IF sr = "X" THEN RETURN
136.         CALL promptszip
137.         IF sr = "X" THEN RETURN
138.         CALL promptphone
139.         IF sr = "X" THEN RETURN
140.         RETURN
141. END IF
142. REM ***************************************************************************
143.  
144. REM ***************************************************************************
145. REM **** customer input modual ************************************************
146. REM ***************************************************************************
147.  
148. 's0:
149. SUB custinput
150.         CALL systemheader
151.         LOCATE 10, 1: PRINT "Customer ID           ";: PRINT custinforec.id
152.         LOCATE 11, 1: PRINT "Customer First Name   ";: PRINT custinforec.sfirst_name
153.         LOCATE 12, 1: PRINT "customer Last Name    ";: PRINT custinforec.slast_name
154.         LOCATE 13, 1: PRINT "Customer Address      ";: PRINT custinforec.saddress
155.         LOCATE 14, 1: PRINT "Customer City         ";: PRINT custinforec.scity
156.         LOCATE 15, 1: PRINT "customer State        ";: PRINT custinforec.sstate
157.         LOCATE 16, 1: PRINT "customer Zip          ";: PRINT custinforec.szip
158.         LOCATE 17, 1: PRINT "Customer Phone Number ";
159.         PRINT LEFT$(custinforec.sphone, 3) + "/"; MID$(custinforec.sphone, 4, 3) + "/"; RIGHT$(custinforec.sphone, 4)
160.         'RETURN
161. END SUB
162.  
163. REM ********************************************************************
164.  
165. 's1:
166. SUB promptid
167.         CALL custinput
168.         saction = "Enter Customer ID X to Exit "
169.         ib = 9
170.         ilow = 1
171.         ihigh = 999999999
172.         iflag1 = 1
173.         IF iflag2 = 1 THEN
174.                 CALL clearprompt
175.                 CALL salphainput(saction, ib, ilow, ihigh, iflag1)
176.         ELSE
177.                 CALL clearprompt
178.                 CALL salphainput(saction, ib, ilow, ihigh, iflag1)
179.         END IF
180.         IF sr = "X" THEN
181.                 iflag1 = 0
182.                 EXIT SUB
183.                 ' RETURN
184.         END IF
185.         custinforec.id = VAL(sr): CALL custinput
186. END SUB
187.  
188. REM ********************************************************************
189.  
190. 's2:
191. SUB promptfname
192.         CALL custinput
193.         saction = "Enter First Name X to Exit - To Backup "
194.         ib = 25
195.         ilow = 99
196.         ihigh = 99
197.         iflag1 = 0
198.         IF iflag2 = 1 THEN
199.                 CALL clearprompt
200.                 CALL salphainput(saction, ib, ilow, ihigh, iflag1)
201.         ELSE
202.                 CALL clearprompt
203.                 CALL salphainput(saction, ib, ilow, ihigh, iflag1)
204.         END IF
205.  
206.         IF sr = "-" THEN
207.                 EXIT SUB
208.                 CALL promptid
209.         END IF
210.         IF sr = "X" THEN
211.                 EXIT SUB
212.         END IF
213.  
214.         custinforec.sfirst_name = sr: CALL custinput
215. END SUB
216.  
217. REM ***************************************************************************
218.  
219. 's3:
220.  
221. SUB promptlname
222.         CALL custinput
223.         saction = "Enter Last Name X to Exit - To Back up "
224.         ib = 25
225.         ilow = 99
226.         ihigh = 99
227.         iflag1 = 0
228.         IF iflag2 = 1 THEN
229.                 CALL clearprompt
230.                 CALL salphainput(saction, ib, ilow, ihigh, iflag1)
231.         ELSE
232.                 CALL clearprompt
233.                 CALL salphainput(saction, ib, ilow, ihigh, iflag1)
234.         END IF
235.  
236.         '        IF sr = "-" THEN
237.         '                EXIT SUB
238.         '                CALL promptfname
239.         '       END IF
240.         IF sr = "X" THEN
241.                 EXIT SUB
242.                 RETURN
243.         END IF
244.         custinforec.slast_name = sr
245.         CALL custinput
246. END SUB
247. REM ***************************************************************************
248.  
249. 's4:
250. SUB promptaddress
251.         CALL custinput
252.         saction = "Enter Address X to Exit - To Back up "
253.         ib = 30
254.         ilow = 99
255.         ihigh = 99
256.         iflag1 = 0
257.  
258.         IF iflag2 = 1 THEN
259.                 CALL clearprompt
260.                 CALL salphainput(saction, ib, ilow, ihigh, iflag1)
261.         ELSE
262.                 CALL clearprompt
263.                 CALL salphainput(saction, ib, ilow, ihigh, iflag1)
264.         END IF
265.  
266.         IF sr = "-" THEN
267.                 EXIT SUB
268.                 CALL promptlname
269.         END IF
270.  
271.  
272.  
273.         IF sr = "X" THEN
274.                 EXIT SUB
275.                 RETURN
276.         END IF
277.         custinforec.saddress = sr
278.         CALL custinput
279. END SUB
280. REM ***************************************************************************
281.  
282. 's5:
283. SUB promptcity
284.         CALL custinput
285.         saction = "Enter City Name X to Exit - To Back up "
286.         ib = 25
287.         ilow = 99
288.         ihigh = 99
289.         iflag1 = 0
290.         IF iflag2 = 1 THEN
291.                 CALL clearprompt
292.                 CALL salphainput(saction, ib, ilow, ihigh, iflag1)
293.         ELSE
294.                 CALL clearprompt
295.                 CALL salphainput(saction, ib, ilow, ihigh, iflag1)
296.         END IF
297.  
298.         IF sr = "-" THEN
299.                 EXIT SUB
300.                 CALL promptaddress
301.         END IF
302.         IF sr = "X" THEN
303.                 EXIT SUB
304.                 RETURN
305.         END IF
306.         custinforec.scity = sr
307.         CALL custinput
308. END SUB
309. REM ***************************************************************************
310. 's6:
311. SUB promptsstate
312.         CALL custinput
313.         saction = "Enter State X to Exit - To Back up "
314.         ib = 2
315.         ilow = 99
316.         ihigh = 99
317.         iflag1 = 0
318.         IF iflag2 = 1 THEN
319.                 CALL clearprompt
320.                 CALL salphainput(saction, ib, ilow, ihigh, iflag1)
321.         ELSE
322.                 CALL clearprompt
323.                 CALL salphainput(saction, ib, ilow, ihigh, iflag1)
324.         END IF
325.  
326.         IF sr = "-" THEN
327.                 EXIT SUB
328.                 CALL promptcity
329.         END IF
330.         IF sr = "X" THEN
331.                 EXIT SUB
332.                 RETURN
333.         END IF
334.         custinforec.sstate = sr
335.         CALL custinput
336. END SUB
337.  
338. REM ***************************************************************************
339.  
340. 's7:
341. SUB promptszip
342.         CALL custinput
343.         saction = "Enter Zip Code Name X to Exit - To Back up "
344.         ib = 5
345.         ilow = 99
346.         ihigh = 99
347.         iflag1 = 0
348.         IF iflag2 = 1 THEN
349.                 CALL clearprompt
350.                 CALL salphainput(saction, ib, ilow, ihigh, iflag1)
351.         ELSE
352.                 CALL clearprompt
353.                 CALL salphainput(saction, ib, ilow, ihigh, iflag1)
354.         END IF
355.  
356.         IF sr = "-" THEN
357.                 EXIT SUB
358.                 CALL promptsstate
359.         END IF
360.         IF sr = "X" THEN
361.                 EXIT SUB
362.                 RETURN
363.         END IF
364.         custinforec.szip = sr
365.         CALL custinput
366. END SUB
367. REM ***************************************************************************
368.  
369. 's8:
370. SUB promptphone
371.         CALL custinput
372.         saction = "Enter Phone Number X to Exit - To Back up "
373.         ib = 30
374.         ilow = 99
375.         ihigh = 99
376.         iflag1 = 0
377.         IF iflag2 = 1 THEN
378.                 CALL clearprompt
379.                 CALL salphainput(saction, ib, ilow, ihigh, iflag1)
380.         ELSE
381.                 CALL clearprompt
382.                 CALL salphainput(saction, ib, ilow, ihigh, iflag1)
383.         END IF
384.  
385.         IF sr = "-" THEN
386.                 EXIT SUB
387.                 CALL promptszip
388.         END IF
389.         IF sr = "X" THEN
390.                 EXIT SUB
391.                 RETURN
392.         END IF
393.         custinforec.sphone = sr
394.         CALL custinput
395.         LINE INPUT sr
396. END SUB
397.  
398. REM ***************************************************************************
399.  
400.  
401. REM ***************************************************************************
402. REM **** set custinforrec variables to zero or null ***************************
403. REM ***************************************************************************
404. SUB custinforec_null
405.         custinforec.id = 0
406.         custinforec.sfirst_name = null
407.         custinforec.slast_name = null
408.         custinforec.saddress = null
409.         custinforec.scity = null
410.         custinforec.sstate = null
411.         custinforec.szip = null
412.         custinforec.sphone = null
413. END SUB
414. REM ***************************************************************************
415.  
416. REM ***************************************************************************
417. REM **** Sytem Header *********************************************************
418. REM ***************************************************************************
419. SUB systemheader
420.         COLOR White, Blue
421.         CLS
422.         LOCATE 1, 1: PRINT CHR$(201): LOCATE 1, 80: PRINT CHR$(187)
423.         LOCATE 1, 2: PRINT STRING$(78, 205):
424.         FOR ix = 2 TO 7
425.                 LOCATE ix, 1: PRINT CHR$(186)
426.                 LOCATE ix, 80: PRINT CHR$(186)
427.         NEXT ix
428.         LOCATE 7, 2: PRINT STRING$(78, 205)
429.         LOCATE 7, 1: PRINT CHR$(200): LOCATE 7, 80: PRINT CHR$(188)
430.         LOCATE 4, 30: PRINT "Main System Menu"
431.         LOCATE 4, 63: PRINT "Date ": LOCATE 4, 68: PRINT DATE$
432.         LOCATE 4, 4: PRINT "Virsion 1.0"
433. END SUB
434.  
435.  
436.  
437. REM ***************************************************************************
438. REM **** printes in system erros **********************************************
439. REM ***************************************************************************
440. SUB sprintserrors (se)
441.         CLS
442.         SCREEN 0
443.         IF se = "" THEN se = "INVALID RESPONSE"
444.         itemp = LEN(se)
445.         itemp1 = 40 - (itemp / 2)
446.         BEEP
447.         COLOR 16, 7
448.         'COLOR Yellow, Blue
449.         LOCATE 25, itemp1: _BLINK ON: PRINT se;
450.         Delay 1.5
451.         _BLINK OFF
452.         $COLOR:0
453.         iflag2 = 1
454. END SUB
455. REM ***************************************************************************
456.  
457. REM *****************************************************************************
458. REM **** numeric input sub ******************************************************
459. REM *****************************************************************************
460. SUB snumeric (sr, ilow, ihigh)
461.  
462.         ftemp = VAL(sr)
463.         IF ftemp < ilow OR ftemp > ihigh THEN
464.                 se = "INPUT OUT OF BOUNDS"
465.                 CALL sprintserrors(se)
466.         END IF
467.  
468. END SUB
469. REM ***************************************************************************
470.  
471. REM ***************************************************************************
472. REM **** alpha input sub ******************************************************
473. REM ***************************************************************************
474. SUB salphainput (saction, ib, ilow, ihigh, iflag1)
475.  
476.         iflag2 = 0
477.         ilength1 = LEN(sr)
478.         ilength2 = LEN(saction) + 2
479.  
480.         LOCATE 23, 1: PRINT saction; '               prints action menu
481.         LOCATE 23, ilength2 '                        set prompt one space after action menu print
482.         COLOR Yellow, Black: PRINT SPC(ib); '                changes color and prints ib spaces to screen for input lenght
483.         LOCATE 23, ilength2 '                        sets curser at the begining of input space from previouse line
484.         LINE INPUT sr: sr = UCASE$(sr) '             inputs data from user changes it to upper case
485.  
486.         IF LEN(sr) > ib THEN
487.                 se = "ENVALID INPUT LENGTH"
488.                 CALL sprintserrors(se)
489.                 sr = ""
490.                 iflag2 = 1
491.         END IF
492.         IF iflag1 = 1 AND sr = "X" THEN iflag1 = 0
493.         IF iflag1 = 1 AND VAL(sr) < ilow AND VAL(sr) > ihigh THEN CALL snumeric(sr, ilow, ihigh)
494.  
495.         COLOR White, Blue
496. END SUB
497.  
498.  
499. REM ***************************************************************************
500. REM **** main menu to the screen **********************************************
501. REM ***************************************************************************
502. SUB printmain
503.         COLOR White, Blue
504.         FOR ix = 11 TO imenu
505.                 READ smenu(ix): LOCATE ix, 20: PRINT smenu(ix)
506.         NEXT ix
507.  
508.         LOCATE 11, 15: PRINT smenu(1)
509.         LOCATE 11, 40: PRINT smenu(2)
510.         LOCATE 13, 15: PRINT smenu(3)
511.         LOCATE 13, 40: PRINT smenu(4)
512.  
513. END SUB
514. REM ***************************************************************************
515.  
516. REM ***************************************************************************
517. REM **** array data goes here *************************************************
518. REM ***************************************************************************
519.  
520. SUB Delay (dlay!)
521.         start! = TIMER
522.         DO WHILE start! + dlay! >= TIMER
523.                 IF start! > TIMER THEN start! = start! - 86400
524.         LOOP
525. END SUB
526.  
527. REM ***************************************************************************
528.  
529. REM ***************************************************************************
530. REM **** menu prompts start here **********************************************
531. REM ***************************************************************************
532. SUB mainmenuchoice
533.         ib = 1
534.         ihigh = 99
535.         ilow = 1
536.         saction = "Choose Menu Option or X to Quit "
537.         CALL salphainput(saction, ib, ilow, ihigh, iflag1)
538. END SUB
539. REM ***************************************************************************
540.  
541. REM ***************************************************************************
542. REM **** clean up the prompt area *********************************************
543. REM ***************************************************************************
544.  
545. SUB clearprompt
546.         LOCATE 23, 1: PRINT STRING$(79, 32)
547. END SUB
548.  
549. REM ***************************************************************************
550.  
551.  

Title: Re: memory leak and question
Post by: bplus on September 29, 2020, 12:32:23 pm

Yes! Much better!

Not seeing a loop here:

Code: QB64: [Select]

1. menuloop:
2. CALL systemheader
3. CALL printmain
4. CALL mainmenuchoice
5. IF sr = "" OR sr = CHR$(13) THEN GOTO menuloop
6. IF sr = "X" THEN END
7. 'IF sr = "1" THEN CALL custinfo: 'GOSUB custinfo1
8. IF sr = "1" THEN
9.     CALL promptid
10.     CALL promptfname
11.     CALL promptlname
12.     CALL promptaddress
13.     CALL promptcity
14.     CALL promptsstate
15.     CALL promptszip
16.     CALL promptphone
17.     RETURN ' <<<<<<<<<<<<<<<<<<<<<<< this is trouble!
18. END IF
19.  
20. 's0:
21. SUB custinput
22.  

How are you coming back from SUB calls and looping around for menu again?
A simple

Code: QB64: [Select]

1. GOTO menuloop

would do it, just before the first SUB.

BTW you don't have to CALL a sub, the sub name will do it.


Update: O hell now I see you put that dang mainLoop in a GOSUB, missed this

Code: QB64: [Select]

1. IF se = "X" THEN END
2. GOSUB menuloop:  ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< oh here it is
3. REM ***************************************************************************
4. REM **** main menu LOOP *******************************************************
5. REM

Well pooh, who puts the mainloop in a GOSUB?

Title: Re: memory leak and question
Post by: MelliLewis on September 29, 2020, 12:39:58 pm

Hello...There are various wellsprings of memory spills. The utilization of strings is one. An instructional exercise on all memory spill issues would take what might be compared to a section in an Intro to DXL book.

String source memory holes can be diminished yet not disposed of by utilizing cushions. It is significant when utilizing supports to abstain from string link when adding string factors to the cushion. For instance if S1, S2 and S3 are string factors and buText is a support, don't do the accompanying to connect the strings.

Title: Re: memory leak and question
Post by: badger on September 29, 2020, 12:43:17 pm

Hello

i will try that i have other things to do off the main menu but i can always go back to the main by goto as well

Badger

Title: Re: memory leak and question
Post by: bplus on September 29, 2020, 12:44:59 pm

Code: QB64: [Select]

1.     CALL promptid
2.     CALL promptfname
3.     CALL promptlname
4.     CALL promptaddress
5.     CALL promptcity
6.     CALL promptsstate
7.     CALL promptszip
8.     CALL promptphone
9.  

You have this code so fragmented and broken up, that it is way more complex than need be.

The above code can just be one or two screens of INPUT lines, one sub routine!

Title: Re: memory leak and question
Post by: badger on September 29, 2020, 12:50:36 pm

Hello

I think i understand what you are trying to say. but i only use one input statement then set conditions on each prompt

Badger

this was the way i was taught. This is also the first time of using subs i can to this much easier with gosubs and gotos

Title: Re: memory leak and question
Post by: bplus on September 29, 2020, 12:59:26 pm

Well I appreciate the fact you are trying to use SUBs for first time but you can write a Customer Data Entry Form with 1 SUB in about 50 lines.

You just want to get all this into a customer record:

Code: QB64: [Select]

1. TYPE customer
2.     id AS LONG
3.     sfirst_name AS STRING * 25
4.     slast_name AS STRING * 25
5.     saddress AS STRING * 30
6.     scity AS STRING * 25
7.     sstate AS STRING * 2
8.     szip AS STRING * 5
9.     sphone AS STRING * 10
10. END TYPE
11.  

Correct?

Title: Re: memory leak and question
Post by: badger on September 29, 2020, 01:02:28 pm

Hello

yes that is correct then the next step is into a random file

Phil

Title: Re: memory leak and question
Post by: bplus on September 29, 2020, 01:16:35 pm

Imagine how one SUB can take over screen and get all this info and return a Customer Record:

Code: QB64: [Select]

1. SUB GetCustomerInfo(custRecord as Customer)
2. DIM rec as Customer
3.  
4. CLS
5. PRINT " Customer Data Form:"
6. PRINT
7. INPUT "Enter customer first name "; rec.name_first
8. INPUT "Enter customer last name "; rec.name_last
9. ...
10.  
11. 'rec.id   ' probably assigned according to record number so leave black and fill in later
12.  
13. custRecord = rec ' Sub passes custRec back to main caller code
14. END SUB

As time goes on you can refine this very crude input form with checks and nice formatting. I would just get a crude outline working first.

Title: Re: memory leak and question
Post by: badger on September 29, 2020, 01:27:39 pm

hello

Let me ask this.. if you mess up on one of the input statements how do you go back up to that statement. with gotos and gosubs that is easy with the way you are explaining you would have to start all over to do that... All the same can you send me a small code snipit on doing what you are suggesting. Please

thanks in advance
Badger

Title: Re: memory leak and question
Post by: bplus on September 29, 2020, 01:34:46 pm

The beauty of INPUT is that before you press Enter to move on you can check what you wrote, but yes surely there will be a screw up any way!

So before you exit the sub you can confirm the whole record is good to send back to main code or eh... start over is definitely easiest but who wants that?

OK I will work on data Entry Form, I had a nice generic one made with EDIT way, way back in 90's with QB4.5

But go ahead and try a crude one as I suggest so you can get to work on saving data to file and loading a records view or making queries or getting on with the whole of the thing. Get that working good then refine later.

Customer ID? will that be the same as record number?

Title: Re: memory leak and question
Post by: badger on September 29, 2020, 01:36:30 pm

Hello

Thanks i want to see that i am willing to learn new tricks i am not that old LOL

Badger

Title: Re: memory leak and question
Post by: bplus on September 29, 2020, 02:42:17 pm

Apology to badger, sorry I missed the place where GOSUB'd to mainloop in reply #3.

Now the RETURN makes more sense.

I hope I can help show how nice working with SUBs are. But remember one main thing, variable values are private to SUB, what happens in a SUB stays in the SUB unless you DIM SHARE variables in main or pass info in and out through arguments to the SUB (or FUNCTION). This is the main difference between a SUB and a GOSUB.

Title: Re: memory leak and question
Post by: badger on September 29, 2020, 02:47:14 pm

Hello

That is ok i figured as much i had to recheck that spot to make sure it was ok being in side the if statement. I understate how they work just not use to using them i have done so visual stuff in vb and vc but quick basic is my choice. I am so glade it has been ported to the 64 bit platform. I just need to see how what you are talking about works.

Badger

Title: Re: memory leak and question
Post by: badger on September 29, 2020, 02:55:40 pm

Hello

i posted i thought i dont think i hit post ugg.

NO problems on the mistake it made me look at that spot to make sure that return should be in that if statement.

I know how subs and functions work i do a little work in vb and vc but my first love is qb 4.5. I am really glad you all ported qb to 64 bit.

badger

Title: Re: memory leak and question
Post by: SMcNeill on September 29, 2020, 04:24:56 pm

A very quick demo of a customer input routine:

Code: QB64: [Select]

1. DIM SHARED n(3) AS STRING
2.  
3.  
4. CLS
5. GetRecord
6. CLS
7. PRINT "This is the record you entered:"
8. PRINT "Customer Name: "; n(1)
9. PRINT "Customer Age :"; n(2)
10. PRINT "Customer Sex :"; n(3)
11.  
12.  
13.  
14.  
15.  
16. SUB GetRecord
17.     'A simple three field record:  name, age, sex
18.     'I could use a TYPE with these, but there's not much point in that.  At least not for just a simple demo
19.     'Instead, I'm just going to use a simple 3 element array, which I dimmed and shared in the main module
20.     DIM c(3) AS STRING * 1 ' And this is just a simple array to hold a cursor so we know where we're entering data at
21.     EntryOn = 1 'Start with the first field by default
22.  
23.     DO
24.         IF EntryOn < 1 THEN EntryOn = 3 'same basic error checking to loop around our fields
25.         IF EntryOn > 3 THEN EntryOn = 1 'same as above
26.         CLS
27.         FOR i = 1 TO 3: c(i) = " ": NEXT 'clear all cursors
28.         c(EntryOn) = CHR$(219)
29.         PRINT "Customer Name: "; n(1); c(1)
30.         PRINT "Customer Age : "; n(2); c(2)
31.         PRINT "Customer Sex : "; n(3); c(3)
32.         PRINT
33.         PRINT "<CTRL-ENTER> to finish."
34.  
35.         k = _KEYHIT
36.         SELECT CASE k
37.             CASE 18432 'up arrow
38.                 EntryOn = EntryOn - 1
39.             CASE 20480, 9 'down arrow, TAB
40.                 EntryOn = EntryOn + 1
41.             CASE 8 'backspace
42.                 n(EntryOn) = LEFT$(n(EntryOn), LEN(n(EntryOn)) - 1)
43.             CASE 65 TO 90, 97 TO 122, 32, 48 TO 57 'A to Z, a TO z, SPACE, 0 to 9
44.                 n(EntryOn) = n(EntryOn) + CHR$(k)
45.             CASE 13
46.                 IF _KEYDOWN(100306) OR _KEYDOWN(100305) THEN 'CTRL is down when we hit enter
47.                     EXIT SUB
48.                 ELSE 'CTRL isn't down.  It's just an ENTER by itself.  Move to the next line
49.                     EntryOn = EntryOn + 1
50.                 END IF
51.         END SELECT
52.         _LIMIT 30
53.     LOOP
54. END SUB
55.  

One short SUB, which is completely self contained in this case, does all the work for us, and it makes it quite easy to navigate and work with our fields.  I'm thinking this is the style input routine which bplus was talking about above, for use.  :)

Title: Re: memory leak and question
Post by: bplus on September 29, 2020, 05:30:22 pm

Yeah I just finished my 50 liner, I turned it into a FUNCTION in case user wants to cancel or quit an edit so it would return 0, otherwise an accepted edit returns -1

Code: QB64: [Select]

1. TYPE customer
2.     id AS LONG
3.     first AS STRING * 25
4.     last AS STRING * 25
5.     address AS STRING * 30
6.     city AS STRING * 25
7.     state AS STRING * 2
8.     zip AS STRING * 5
9.     phone AS STRING * 10
10. END TYPE
11.  
12. DIM SHARED nRecs ' for when you get a file going
13.  
14. DIM myRec AS customer 'edit this record over and over for testing
15. DO
16.     edit = EditCustomer(myRec, 1) ' assign to first record 1 if not Cancelled
17.     CLS
18.     IF edit THEN
19.         PRINT "Record #:"; myRec.id
20.         PRINT "   First:"; myRec.first
21.         PRINT "    Last:"; myRec.last
22.         PRINT " Address:"; myRec.address
23.         PRINT "    City:"; myRec.city
24.         PRINT "   State:"; myRec.state
25.         PRINT "   Phone:"; myRec.phone
26.     ELSE
27.         PRINT "user cancelled edit"
28.     END IF
29.     PRINT "(SLEEPing) press any to continue..."
30.     SLEEP
31.     CLS
32. LOOP
33. 'if edit then fileRec myRec, 1
34.  
35. 'return 0 if user cancelled, -1 if record edit was accepted
36. FUNCTION EditCustomer% (customerRec AS customer, recNumber AS LONG) ' use for new Customer or edit Customer
37.     DIM rec(1 TO 7, 0 TO 1) AS STRING
38.     rec(1, 0) = "First Name"
39.     rec(2, 0) = "Last Name"
40.     rec(3, 0) = "Address"
41.     rec(4, 0) = "City"
42.     rec(5, 0) = "State (abbrev:2)"
43.     rec(6, 0) = "Zip (5)"
44.     rec(7, 0) = "Phone" ' might split to Home and Mobile
45.     IF customerRec.first <> "" THEN rec(1, 1) = customerRec.first
46.     IF customerRec.last <> "" THEN rec(2, 1) = customerRec.last
47.     IF customerRec.address <> "" THEN rec(3, 1) = customerRec.address
48.     IF customerRec.city <> "" THEN rec(4, 1) = customerRec.city
49.     IF customerRec.state <> "" THEN rec(5, 1) = customerRec.state
50.     IF customerRec.zip <> "" THEN rec(6, 1) = customerRec.zip
51.     IF customerRec.phone <> "" THEN rec(7, 1) = customerRec.phone
52.     doAgain:
53.     CLS
54.     FOR i = 1 TO 7 'show what we have
55.         PRINT i, rec(i, 0); " = "; rec(i, 1)
56.     NEXT
57.     PRINT: PRINT "Press a to Accept, n for New, a digit to edit field, or escape to Cancel."
58.     choice$ = getChar$("aAnN1234567" + CHR$(27))
59.     IF ASC(choice$) = 27 THEN ' maybe this should be a function
60.         EditCustomer% = 0: EXIT FUNCTION 'cancelled  EDIT to 0
61.     ELSEIF UCASE$(choice$) = "A" THEN
62.         customerRec.id = recNumber 'assign the record
63.         customerRec.first = rec(1, 1)
64.         customerRec.last = rec(2, 1)
65.         customerRec.address = rec(3, 1)
66.         customerRec.city = rec(4, 1)
67.         customerRec.state = rec(5, 1)
68.         customerRec.zip = rec(6, 1)
69.         customerRec.phone = rec(7, 1)
70.         EditCustomer% = -1: EXIT FUNCTION 'done
71.     ELSEIF UCASE$(choice$) = "N" THEN
72.         CLS
73.         FOR i = 1 TO 7
74.             PRINT rec(i, 0); " > ";
75.             INPUT ""; rec(i, 1)
76.         NEXT
77.         GOTO doAgain
78.     ELSEIF INSTR("1234567", choice$) THEN
79.         CLS
80.         PRINT rec(VAL(choice$), 0); " > ";
81.         INPUT ""; rec(VAL(choice$), 1)
82.         GOTO doAgain
83.     END IF
84. END SUB
85.  
86. FUNCTION getChar$ (fromStr$) ' get a char$ usually for a menu
87.     DIM OK AS INTEGER, k$
88.     WHILE OK = 0
89.         k$ = INKEY$
90.         IF LEN(k$) THEN
91.             IF INSTR(fromStr$, k$) <> 0 THEN OK = -1
92.         END IF
93.         _LIMIT 200
94.     WEND
95.     _KEYCLEAR
96.     getChar$ = k$
97. END SUB
98.  
99.  

EDIT: a last minute change set the cancel to -1, supposed to be 0, fixed.
Updated the record description returned to main code.
Edit2: Got first and last name switched when showing record returned from Function, fixed.

Typically blundering my way to better code ;-))

Title: Re: memory leak and question
Post by: TempodiBasic on September 30, 2020, 05:52:09 am

so we can say from a large main with so much GOSUB/RETURN (in the place of GOTO labels) we get a shrink SUB of Steve!

just to let be more readable for my eyes that code I have toggled few things

Code: QB64: [Select]

1. CONST cName = 1, cAge = 2, cSex = 3
2. OPTION BASE 1
3. DIM SHARED n(3) AS STRING
4.  
5.  
6. CLS
7. GetRecord
8. CLS
9. PRINT "This is the record you entered:"
10. PRINT "Customer Name: "; n(cName)
11. PRINT "Customer Age :"; n(cAge)
12. PRINT "Customer Sex :"; n(cSex)
13.  
14.  
15.  
16.  
17.  
18. SUB GetRecord
19.     'A simple three field record:  name, age, sex
20.     'I could use a TYPE with these, but there's not much point in that.  At least not for just a simple demo
21.     'Instead, I'm just going to use a simple 3 element array, which I dimmed and shared in the main module
22.     DIM c(3) AS STRING * 1 ' And this is just a simple array to hold a cursor so we know where we're entering data at
23.     EntryOn = 1 'Start with the first field by default
24.  
25.     DO
26.         IF EntryOn < cName THEN EntryOn = cSex 'same basic error checking to loop around our fields
27.         IF EntryOn > cSex THEN EntryOn = cName 'same as above
28.         CLS
29.         FOR i = 1 TO 3: c(i) = " ": NEXT 'clear all cursors
30.         c(EntryOn) = CHR$(219)
31.         PRINT "Customer Name: "; n(cName); c(cName)
32.         PRINT "Customer Age : "; n(cAge); c(cAge)
33.         PRINT "Customer Sex : "; n(cSex); c(cSex)
34.         PRINT
35.         PRINT "<CTRL-ENTER> to finish."
36.  
37.         k = _KEYHIT
38.         SELECT CASE k
39.             CASE 18432 'up arrow
40.                 EntryOn = EntryOn - 1
41.             CASE 20480, 9 'down arrow, TAB
42.                 EntryOn = EntryOn + 1
43.             CASE 8 'backspace
44.                 n(EntryOn) = LEFT$(n(EntryOn), LEN(n(EntryOn)) - 1)
45.             CASE 65 TO 90, 97 TO 122, 32, 48 TO 57 'A to Z, a TO z, SPACE, 0 to 9
46.                 n(EntryOn) = n(EntryOn) + CHR$(k)
47.             CASE 13
48.                 IF _KEYDOWN(100306) OR _KEYDOWN(100305) THEN 'CTRL is down when we hit enter
49.                     EXIT SUB
50.                 ELSE 'CTRL isn't down.  It's just an ENTER by itself.  Move to the next line
51.                     EntryOn = EntryOn + 1
52.                 END IF
53.         END SELECT
54.         _LIMIT 30
55.     LOOP
56. END SUB
57.  
58.  
59.  

Title: Re: memory leak and question
Post by: TempodiBasic on September 30, 2020, 05:53:34 am

So why I must waste only Steve's work, it is also your turn:
in a gray office program it is beautiful to see more colors...
TA-DA!

Code: QB64: [Select]

1. TYPE customer
2.     id AS LONG
3.     first AS STRING * 25
4.     last AS STRING * 25
5.     address AS STRING * 30
6.     city AS STRING * 25
7.     state AS STRING * 2
8.     zip AS STRING * 5
9.     phone AS STRING * 10
10. END TYPE
11.  
12. DIM SHARED nRecs ' for when you get a file going
13.  
14. DIM myRec AS customer 'edit this record over and over for testing
15. DO
16.     edit = EditCustomer(myRec, 1) ' assign to first record 1 if not Cancelled
17.     CLS
18.     IF edit THEN
19.         PRINT "Record #:"; myRec.id
20.         PRINT "   First:"; myRec.first
21.         PRINT "    Last:"; myRec.last
22.         PRINT " Address:"; myRec.address
23.         PRINT "    City:"; myRec.city
24.         PRINT "   State:"; myRec.state
25.         PRINT "   Phone:"; myRec.phone
26.     ELSE
27.         PRINT "user cancelled edit"
28.     END IF
29.     PRINT "(SLEEPing) press any to continue..."
30.     SLEEP
31.     CLS
32. LOOP
33. 'if edit then fileRec myRec, 1
34.  
35. 'return 0 if user cancelled, -1 if record edit was accepted
36. FUNCTION EditCustomer% (customerRec AS customer, recNumber AS LONG) ' use for new Customer or edit Customer
37.     DIM rec(1 TO 7, 0 TO 1) AS STRING
38.     rec(1, 0) = "First Name"
39.     rec(2, 0) = "Last Name"
40.     rec(3, 0) = "Address"
41.     rec(4, 0) = "City"
42.     rec(5, 0) = "State (abbrev:2)"
43.     rec(6, 0) = "Zip (5)"
44.     rec(7, 0) = "Phone" ' might split to Home and Mobile
45.     IF customerRec.first <> "" THEN rec(1, 1) = customerRec.first
46.     IF customerRec.last <> "" THEN rec(2, 1) = customerRec.last
47.     IF customerRec.address <> "" THEN rec(3, 1) = customerRec.address
48.     IF customerRec.city <> "" THEN rec(4, 1) = customerRec.city
49.     IF customerRec.state <> "" THEN rec(5, 1) = customerRec.state
50.     IF customerRec.zip <> "" THEN rec(6, 1) = customerRec.zip
51.     IF customerRec.phone <> "" THEN rec(7, 1) = customerRec.phone
52.     doAgain:
53.     CLS
54.     FOR i = 1 TO 7 'show what we have
55.         COLOR i: PRINT i, rec(i, 0); " = "; rec(i, 1)
56.     NEXT
57.  
58.     PRINT: PRINT "Press ";: COLOR 2: PRINT "a";: COLOR 7: PRINT " to Accept, ";
59.     COLOR 3: PRINT "n";: COLOR 7: PRINT " for New, a ";
60.     COLOR 4: PRINT "digit";: COLOR 7: PRINT " to edit field, or ";
61.     COLOR 5: PRINT "escape";: COLOR 7: PRINT " to Cancel."
62.     choice$ = getChar$("aAnN1234567" + CHR$(27))
63.     IF ASC(choice$) = 27 THEN ' maybe this should be a function
64.         EditCustomer% = 0: EXIT FUNCTION 'cancelled  EDIT to 0
65.     ELSEIF UCASE$(choice$) = "A" THEN
66.         customerRec.id = recNumber 'assign the record
67.         customerRec.first = rec(1, 1)
68.         customerRec.last = rec(2, 1)
69.         customerRec.address = rec(3, 1)
70.         customerRec.city = rec(4, 1)
71.         customerRec.state = rec(5, 1)
72.         customerRec.zip = rec(6, 1)
73.         customerRec.phone = rec(7, 1)
74.         EditCustomer% = -1: EXIT FUNCTION 'done
75.     ELSEIF UCASE$(choice$) = "N" THEN
76.         CLS
77.         FOR i = 1 TO 7
78.             PRINT rec(i, 0); " > ";
79.             INPUT ""; rec(i, 1)
80.         NEXT
81.         GOTO doAgain
82.     ELSEIF INSTR("1234567", choice$) THEN
83.         CLS
84.         PRINT rec(VAL(choice$), 0); " > ";
85.         INPUT ""; rec(VAL(choice$), 1)
86.         GOTO doAgain
87.     END IF
88. END SUB
89.  
90. FUNCTION getChar$ (fromStr$) ' get a char$ usually for a menu
91.     DIM OK AS INTEGER, k$
92.     WHILE OK = 0
93.         k$ = INKEY$
94.         IF LEN(k$) THEN
95.             IF INSTR(fromStr$, k$) <> 0 THEN OK = -1
96.         END IF
97.         _LIMIT 200
98.     WEND
99.     _KEYCLEAR
100.     getChar$ = k$
101. END SUB
102.  
103.  
104.  

Title: Re: memory leak and question
Post by: TempodiBasic on September 30, 2020, 06:04:51 am

just to follow my friend enemy of GOTO
here an alternative way of GOTO into FUNCTION

Code: QB64: [Select]

1. TYPE customer
2.     id AS LONG
3.     first AS STRING * 25
4.     last AS STRING * 25
5.     address AS STRING * 30
6.     city AS STRING * 25
7.     state AS STRING * 2
8.     zip AS STRING * 5
9.     phone AS STRING * 10
10. END TYPE
11.  
12. DIM SHARED nRecs ' for when you get a file going
13.  
14. DIM myRec AS customer 'edit this record over and over for testing
15. DO
16.     edit = EditCustomer(myRec, 1) ' assign to first record 1 if not Cancelled
17.     CLS
18.     IF edit THEN
19.         PRINT "Record #:"; myRec.id
20.         PRINT "   First:"; myRec.first
21.         PRINT "    Last:"; myRec.last
22.         PRINT " Address:"; myRec.address
23.         PRINT "    City:"; myRec.city
24.         PRINT "   State:"; myRec.state
25.         PRINT "   Phone:"; myRec.phone
26.     ELSE
27.         PRINT "user cancelled edit"
28.     END IF
29.     PRINT "(SLEEPing) press any to continue..."
30.     SLEEP
31.     CLS
32. LOOP
33. 'if edit then fileRec myRec, 1
34.  
35. 'return 0 if user cancelled, -1 if record edit was accepted
36. FUNCTION EditCustomer% (customerRec AS customer, recNumber AS LONG) ' use for new Customer or edit Customer
37.     DIM rec(1 TO 7, 0 TO 1) AS STRING
38.     rec(1, 0) = "First Name"
39.     rec(2, 0) = "Last Name"
40.     rec(3, 0) = "Address"
41.     rec(4, 0) = "City"
42.     rec(5, 0) = "State (abbrev:2)"
43.     rec(6, 0) = "Zip (5)"
44.     rec(7, 0) = "Phone" ' might split to Home and Mobile
45.     IF customerRec.first <> "" THEN rec(1, 1) = customerRec.first
46.     IF customerRec.last <> "" THEN rec(2, 1) = customerRec.last
47.     IF customerRec.address <> "" THEN rec(3, 1) = customerRec.address
48.     IF customerRec.city <> "" THEN rec(4, 1) = customerRec.city
49.     IF customerRec.state <> "" THEN rec(5, 1) = customerRec.state
50.     IF customerRec.zip <> "" THEN rec(6, 1) = customerRec.zip
51.     IF customerRec.phone <> "" THEN rec(7, 1) = customerRec.phone
52.     doAgain = -1
53.     DO WHILE doAgain
54.         CLS
55.         FOR i = 1 TO 7 'show what we have
56.             COLOR i: PRINT i, rec(i, 0); " = "; rec(i, 1)
57.         NEXT
58.  
59.         PRINT: PRINT "Press ";: COLOR 2: PRINT "a";: COLOR 7: PRINT " to Accept, ";
60.         COLOR 3: PRINT "n";: COLOR 7: PRINT " for New, a ";
61.         COLOR 4: PRINT "digit";: COLOR 7: PRINT " to edit field, or ";
62.         COLOR 5: PRINT "escape";: COLOR 7: PRINT " to Cancel."
63.         choice$ = getChar$("aAnN1234567" + CHR$(27))
64.         IF ASC(choice$) = 27 THEN ' maybe this should be a function
65.             EditCustomer% = 0: EXIT FUNCTION 'cancelled  EDIT to 0
66.         ELSEIF UCASE$(choice$) = "A" THEN
67.             customerRec.id = recNumber 'assign the record
68.             customerRec.first = rec(1, 1)
69.             customerRec.last = rec(2, 1)
70.             customerRec.address = rec(3, 1)
71.             customerRec.city = rec(4, 1)
72.             customerRec.state = rec(5, 1)
73.             customerRec.zip = rec(6, 1)
74.             customerRec.phone = rec(7, 1)
75.             doAgain = 0
76.             EditCustomer% = -1: EXIT FUNCTION 'done
77.         ELSEIF UCASE$(choice$) = "N" THEN
78.             CLS
79.             FOR i = 1 TO 7
80.                 PRINT rec(i, 0); " > ";
81.                 INPUT ""; rec(i, 1)
82.             NEXT
83.             doAgain = -1
84.         ELSEIF INSTR("1234567", choice$) THEN
85.             CLS
86.             PRINT rec(VAL(choice$), 0); " > ";
87.             INPUT ""; rec(VAL(choice$), 1)
88.             doAgain = -1
89.         END IF
90.     LOOP
91. END SUB
92.  
93. FUNCTION getChar$ (fromStr$) ' get a char$ usually for a menu
94.     DIM OK AS INTEGER, k$
95.     WHILE OK = 0
96.         k$ = INKEY$
97.         IF LEN(k$) THEN
98.             IF INSTR(fromStr$, k$) <> 0 THEN OK = -1
99.         END IF
100.         _LIMIT 200
101.     WEND
102.     _KEYCLEAR
103.     getChar$ = k$
104. END SUB
105.  

Text Only | Text with Attachments