Posts: 719
Threads: 110
Joined: Apr 2022
Reputation:
28
(05-23-2025, 11:22 AM)bplus Wrote: Here is 34 very handy Functions in less than 300 LOC
Code: (Select All) ' ======================================================================= IFFs of a Type 2023-11-03
Function IfS$ (Bool&, tru$, fals$) ' IF Boolean Return True$ else False$
If Bool& Then IfS$ = tru$ Else IfS$ = fals$
End Function
Function IfL& (Bool&, tru&, fals&) ' IF Boolean Return True& else False&
If Bool& Then IfL& = tru& Else IfL& = fals&
End Function
Function IfD# (Bool&, tru#, fals#) ' IF Boolean Return True# else False#
If Bool& Then IfD# = tru# Else IfD# = fals#
End Function
Function IfUL~& (Bool&, tru~&, fals~&) ' IF Boolean Return True~& else False~&
If Bool& Then IfUL~& = tru~& Else IfUL~& = fals~&
End Function
' ===================================================================================== Random stuff
Function rndI& (n1 As Long, n2 As Long) 'return an integer between 2 numbers
Dim As Long l, h
If n1 > n2 Then l = n2: h = n1 Else l = n1: h = n2
rndI& = Int(Rnd * (h - l + 1)) + l
End Function
Function rndR (n1, n2) 'return real number (_single, double, _float depending on default / define setup)
rndR = (n2 - n1) * Rnd + n1
End Function
Function rndCWI (center, range) 'center +/-range weights to center
Dim As Long halfRange, c
halfRange = Int(range) + 1 'for INT(Rnd) round range in case not integer
c = Int(center + .5)
rndCWI = c + Int(Rnd * (halfRange)) - Int(Rnd * (halfRange))
End Function
' 2023-01-20 tested
Function rndCW (C As Single, range As Single) 'center +/-range weights to center
rndCW = C + Rnd * range - Rnd * range
End Function
Function rdir% ()
If Rnd < .5 Then rdir% = -1 Else rdir% = 1
End Function
'===================================================================================== Handy numbers
Function dist# (x1%, y1%, x2%, y2%) ' hypot might be better
dist# = ((x1% - x2%) ^ 2 + (y1% - y2%) ^ 2) ^ .5
End Function
Function min (a, b)
min = -a * (a < b) - b * (b <= a)
End Function
Function max (a, b)
max = -a * (a > b) - b * (b >= a)
End Function
Function map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
End Function
'======================================================================================= Color stuff
Function qb~& (n As Long)
Select Case n
Case 0: qb~& = &HFF000000
Case 1: qb~& = &HFF000088
Case 2: qb~& = &HFF008800
Case 3: qb~& = &HFF008888
Case 4: qb~& = &HFF880000
Case 5: qb~& = &HFF880088
Case 6: qb~& = &HFF888800
Case 7: qb~& = &HFFCCCCCC
Case 8: qb~& = &HFF888888
Case 9: qb~& = &HFF0000FF
Case 10: qb~& = &HFF00FF00
Case 11: qb~& = &HFF00FFFF
Case 12: qb~& = &HFFFF0000
Case 13: qb~& = &HFFFF00FF
Case 14: qb~& = &HFFFFFF00
Case 15: qb~& = &HFFFFFFFF
End Select
End Function
Function rclr~& ()
rclr~& = _RGB32(rndI(64, 255), rndI(64, 255), rndI(64, 255), rndI(0, 255))
End Function
Function Plasma~& ()
cN = cN + 1 ''Dim Shared cN, pR, pG, pB
Plasma~& = _RGB32(127 + 127 * Sin(pR * cN), 127 + 127 * Sin(pG * cN), 127 + 127 * Sin(pB * cN))
End Function
Function midInk~& (r1%, g1%, b1%, r2%, g2%, b2%, fr##)
midInk~& = _RGB32(r1% + (r2% - r1%) * fr##, g1% + (g2% - g1%) * fr##, b1% + (b2% - b1%) * fr##)
End Function
' ===================================================================================== String Stuff
Function LeftOf$ (source$, of$)
If InStr(source$, of$) > 0 Then
LeftOf$ = Mid$(source$, 1, InStr(source$, of$) - 1)
Else
LeftOf$ = source$
End If
End Function
' update these 2 in case of$ is not found! 2021-02-13
Function RightOf$ (source$, of$)
If InStr(source$, of$) > 0 Then
RightOf$ = Mid$(source$, InStr(source$, of$) + Len(of$))
Else
RightOf$ = ""
End If
End Function
Function strReplace$ (s$, replace$, new$) 'case sensitive 2020-07-28 version
Dim p As Long, sCopy$, LR As Long, lNew As Long
If Len(s$) = 0 Or Len(replace$) = 0 Then
strReplace$ = s$: Exit Function
Else
LR = Len(replace$): lNew = Len(new$)
End If
sCopy$ = s$ ' otherwise s$ would get changed
p = InStr(sCopy$, replace$)
While p
sCopy$ = Mid$(sCopy$, 1, p - 1) + new$ + Mid$(sCopy$, p + LR)
p = InStr(p + lNew, sCopy$, replace$)
Wend
strReplace$ = sCopy$
End Function
Function strEnclose$ (s$, str1or2$)
If Len(str1or2$) = 2 Then
strEnclose$ = Left$(str1or2$, 1) + s$ + Right$(str1or2$, 1)
ElseIf Len(str1or2$) = 1 Then
strEnclose$ = str1or2$ + s$ + str1or2$
Else
Beep
End If
End Function
Function StrCopies$ (NumberOfCopies&, S$) ' modified 2021-02-19 to match STRING$ args and for SUB AStringInsertAtNthPlace
Dim i&, b$
For i& = 1 To NumberOfCopies&
b$ = b$ + S$
Next
StrCopies$ = b$
End Function
'Description: Use Item$() Function to treat strings like arrays without having to use an array structure.
' This function does not throw a fit if you ask for an item number (index) it does not have, it just returns an empty string.
' In QB64, Functions can't return arrays through the function name, but they can return strings that the Item$() function can
' translate like an an array index. nItem numbers are the same as Counting numbers positive integers starting at 1.
' eg Item7$ = Item$(CommaDelimitedString$, 7, ",") 'get 7th Item in string
Function Item$ (s$, nItem As Long, delimiter$)
Dim c As Long, d As Long, lastd As Long
If Len(s$) = 0 Then Item$ = "": Exit Function
lastd = 1: d = InStr(lastd, s$, delimiter$)
While d > 0
c = c + 1
If c = nItem Then
Item$ = Mid$(s$, lastd, d - lastd): Exit Function
Else
lastd = d + 1: d = InStr(lastd, s$, delimiter$)
End If
Wend
c = c + 1
If c <> nItem Then Item$ = "" Else Item$ = Mid$(s$, lastd, Len(s$))
End Function
Function format$ (template As String, Source As String)
Dim d, s, n, i, t$
d = _Dest: s = _Source
n = _NewImage(80, 80, 0)
_Dest n: _Source n
Print Using template; Val(Source)
For i = 1 To 79
t$ = t$ + Chr$(Screen(1, i))
Next
If Left$(t$, 1) = "%" Then t$ = Mid$(t$, 2)
format$ = _Trim$(t$)
_Dest d: _Source s
_FreeImage n
End Function
Function xDP$ (x, DP)
Dim test$, p As Long
test$ = _Trim$(Str$(Int(x * 10 ^ DP) / 10 ^ DP))
p = InStr(test$, ".")
If p = 0 And DP <> 0 Then test$ = test$ + "." + String$(DP, "0")
If p And DP = 0 Then test$ = Left$(test$, Len(test$) - 1)
xDP$ = test$
End Function
Function commaD$ (n#, nDecPlaces%) 'only works right for double# type
Dim place As Long, s$, front$, back$, func$
func$ = _Trim$(Str$(n#))
If Left$(func$, 1) = "-" Then s$ = "-": func$ = Mid$(func$, 2) Else s$ = ""
place = InStr(func$, ".")
If place = 0 Then place = Len(func$) + 1
While place > 4
func$ = Mid$(func$, 1, place - 4) + "," + Mid$(func$, place - 3)
place = InStr(func$, ",")
Wend
'fix to nDecPlaces
place = InStr(func$, ".")
If nDecPlaces% Then
If place Then
front$ = Mid$(func$, 1, place)
back$ = Mid$(func$, place + 1)
If Len(back$) > nDecPlaces% Then func$ = front$ + Left$(back$, nDecPlaces%)
If Len(back$) < nDecPlaces% Then func$ = front$ + Left$(back$ + String$(nDecPlaces%, "0"), nDecPlaces%)
Else
func$ = func$ + "." + String$(nDecPlaces%, "0")
End If
Else
If place Then func$ = Mid$(func$, 1, place - 1)
End If
commaD$ = s$ + func$
End Function
'this might make a nice Money format
Function money$ (n#) 'only works right for double# type
Dim place As Long, s$, front$, back$, b$
b$ = _Trim$(Str$(n#))
If Left$(b$, 1) = "-" Then s$ = "-": b$ = Mid$(b$, 2) Else s$ = ""
place = InStr(b$, ".")
If place = 0 Then place = Len(b$) + 1
While place > 4
b$ = Mid$(b$, 1, place - 4) + "," + Mid$(b$, place - 3)
place = InStr(b$, ",")
Wend
'fix this for 2 places after decimal
place = InStr(b$, ".")
If place Then
front$ = Mid$(b$, 1, place)
back$ = Mid$(b$, place + 1)
If Len(back$) > 2 Then b$ = front$ + Left$(back$, 2)
If Len(back$) < 2 Then b$ = front$ + Left$(back$ + "00", 2)
Else
b$ = b$ + ".00"
End If
money$ = "$" + s$ + b$
End Function
Function DateTimeStamp$
DateTimeStamp$ = Mid$(Date$, 7) + "-" + Mid$(Date$, 1, 2) + "-" + Mid$(Date$, 4, 2) + "_" + Mid$(Time$, 1, 2)
End Function
Function xStr$ (x, strng$) ' make x copies of string
Dim i As Long, b$
For i = 1 To x
b$ = b$ + strng$
Next
xStr$ = b$
End Function
Function timeStr2Secs! (timeStr$)
Dim hh As Long, mm As Long, s!
hh = Val(Mid$(timeStr$, 1, 2))
mm = Val(Mid$(timeStr$, 4, 2))
s! = Val(Mid$(timeStr$, 7, 5))
timeStr2Secs! = hh * 60 * 60 + mm * 60 + s!
End Function
Function secs2TimeStr$ (secs!)
Dim hh As Long, mm As Long, s!, h$, m$, s$
hh = secs! \ 3600
mm = (secs! - hh * 3600) \ 60
s! = (secs! - hh * 3600 - mm * 60)
s! = Int(s! * 100) / 100
h$ = Right$("00" + LTrim$(Str$(hh)), 2)
m$ = Right$("00" + LTrim$(Str$(mm)), 2)
s$ = Right$("00000" + LTrim$(Str$(s!)), 5)
secs2TimeStr$ = h$ + ":" + m$ + ":" + s$
End Function
'load a file into a string from GUI Tools 1 TxtBoxes 2019-09-30
Function fileStr$ (txtFile$)
Dim b$
If _FileExists(txtFile$) Then
Open txtFile$ For Binary As #1
b$ = Space$(LOF(1))
Get #1, , b$
Close #1
fileStr$ = b$
End If
End Function
Function Join$ (arr() As String, delimiter$)
Dim i As Long, b$
For i = LBound(arr) To UBound(arr)
If i = LBound(arr) Then b$ = arr(LBound(arr)) Else b$ = b$ + delimiter$ + arr(i)
Next
Join$ = b$
End Function
Wow, thanks bplus!
I'll work my way through these (over a few days), to see what I can absorb, and which functions I may be able to adapt for my use.
But I'm still of the mind that I'll give prefrerence to Subs where I have a choice - they seem more intuitive, and I'm much more familiar with them.
Thanks for all your work and help.
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, Western Australia.) 
Please visit my Website at: http://oldendayskids.blogspot.com/
Posts: 2,577
Threads: 264
Joined: Apr 2022
Reputation:
140
The problem I see with functions is this... You can't get them on good Italian bread. That's why I always have subs!
Pete
Posts: 1,047
Threads: 141
Joined: Apr 2022
Reputation:
23
You never run dry, do you??
Posts: 299
Threads: 16
Joined: Apr 2022
Reputation:
38
Just chiming in with my $0.05, since I understand they are going to eliminate pennies...
Given that a FUNCTION will do everything a SUB will do "plus" return a value, I attach an example of a sub that I had occasion to convert to a function. The only difference being that the function "returns" the ratio as a SINGLE precision that the image is reduced (or expanded) by.
It would be somewhat awkward to pass a dummy variable to a SUB in order to get a ratio figure if it were needed, and one would need to declare a dummy variable to receive a returned value if it were not needed. You can go either way depending upon the project's requirements.
Code: (Select All) ' Description:
' This routine scales and justifies a target image to fit in a predefined area of another image.
' It maintains the height/width ratio and fits it to the area defined, the image can be justified
' up/down/center in the vertical and left/right/center in the horizontal .
' It incorporates _PUTIMAGE and so it is used in its place.
' Syntax: Image_Resize( up lt x, up lt y, low rt x, low rt y, src handle, dest handle, horiz just, vert just)
' horizontal justifications= "l" left, "c" center, "r" right
' vertical justifications= "u" up, "c" center, "d" down
' Author: OldMoses
SUB Image_Resize (xpos AS INTEGER, ypos AS INTEGER, xlim AS INTEGER, ylim AS INTEGER, i AS LONG, d AS LONG, xj AS STRING, yj AS STRING)
DIM AS INTEGER xs, ys, xp, yp, xl, yl ' ready for OPTION EXPLICIT programs
xp = xpos: yp = ypos: xl = xlim: yl = ylim ' isolate sent parameters from any changes
DIM AS SINGLE rt, xrt, yrt
xrt = (xl - xp) / _WIDTH(i) ' width of area divided by width of image
yrt = (yl - yp) / _HEIGHT(i) ' height of area divided by height of image
rt = -xrt * (xrt < yrt) - yrt * (yrt <= xrt) ' pick the smaller of the two ratios to fit area
xs = _WIDTH(i) * rt ' final image size ratio in x
ys = _HEIGHT(i) * rt ' final image size ratio in y
xp = -xp * (xj = "l") - (_SHR(xl - xp, 1) + xp - _SHR(xs, 1)) * (xj = "c") - (xl - xs) * (xj = "r")
xl = xp + xs
yp = -yp * (yj = "u") - (_SHR(yl - yp, 1) + yp - _SHR(ys, 1)) * (yj = "c") - (yl - ys) * (yj = "d")
yl = yp + ys
_PUTIMAGE (xp, yp)-(xl, yl), i, d
END SUB 'Image_Resize
'as above, but also return the resizing ratio as a single precision value
FUNCTION Image_Resize! (xpos AS INTEGER, ypos AS INTEGER, xlim AS INTEGER, ylim AS INTEGER, i AS LONG, d AS LONG, xj AS STRING, yj AS STRING)
DIM AS INTEGER xs, ys, xp, yp, xl, yl ' ready for OPTION EXPLICIT programs
xp = xpos: yp = ypos: xl = xlim: yl = ylim ' isolate sent parameters from any changes
DIM AS SINGLE rt, xrt, yrt
xrt = (xl - xp) / _WIDTH(i) ' width of area divided by width of image
yrt = (yl - yp) / _HEIGHT(i) ' height of area divided by height of image
rt = -xrt * (xrt < yrt) - yrt * (yrt <= xrt) ' pick the smaller of the two ratios to fit area
xs = _WIDTH(i) * rt ' final image size ratio in x
ys = _HEIGHT(i) * rt ' final image size ratio in y
xp = -xp * (xj = "l") - (_SHR(xl - xp, 1) + xp - _SHR(xs, 1)) * (xj = "c") - (xl - xs) * (xj = "r")
xl = xp + xs
yp = -yp * (yj = "u") - (_SHR(yl - yp, 1) + yp - _SHR(ys, 1)) * (yj = "c") - (yl - ys) * (yj = "d")
yl = yp + ys
_PUTIMAGE (xp, yp)-(xl, yl), i, d
Image_Resize! = rt
END FUNCTION 'Image_Resize!
DO: LOOP: DO: LOOP
sha_na_na_na_na_na_na_na_na_na:
Posts: 480
Threads: 92
Joined: Jul 2022
Reputation:
20
The neat thing about functions is they can be imbedded in each other which a subroutine cannot:
Code: (Select All) Print x(2), y(4), z(10)
Print x(y(z(10)))
End
Function x (a)
x = 1 + a
End Function
Function y (b)
y = 2 + b
End Function
Function z (c)
z = 3 + c
End Function
Posts: 946
Threads: 51
Joined: May 2022
Reputation:
32
05-26-2025, 11:47 PM
(This post was last modified: 05-27-2025, 11:59 AM by Kernelpanic.)
I hope the translation is understandable. I didn't find any errors in the calculation.
Here is a practical example of a function as an argument for a function as argument passed to a procedure/sub (two arguments). The final price including VAT is calculated once, followed by the final price including the discount.
Since a discount isn't always granted, it's calculated in a separate function.
PS: Small improvement in case there is no discount. - 27. Mai 2025
Code: (Select All)
'Beispiel fuer SUB und Funktionen - 23. Jan. 2024
'Eine Funktion kann auch als Argument an ein SUB uebergeben werden.
'Rabattberechnung hinzugefuegt fuer Beispiel - 26. Mai 2025
Option _Explicit
Declare Function funcEndpreis(kaufpreis, mehrwertSteuer As Double) As Double
Declare Function endpreisRabatt(endpreisOhneRabatt,rabatt As Doeble) As Double
Declare Sub subEndpreisMit(endpreisOhneRabatt, rabatt As Double)
Dim As Double kaufpreis, mehrwertSteuer, rabatt
Locate 2, 3
Input "Kaufpreis : ", kaufpreis
Locate 3, 3
Input "Mehrwertsteuer in Prozent % : ", mehrwertSteuer
Locate 4, 3
Input "Rabatt in Prozent % (Ohne = 0): ", rabatt
Locate 5, 3
Print "---------------------------------------"
Locate 7, 3
Print Using "Der Endpreis ohne Rabatt betraegt: ####,#.## Euro"; funcEndpreis(kaufpreis, mehrwertSteuer)
Locate 9, 3
'Function as an argument to a sub
Call subEndpreisMit(funcEndpreis(kaufpreis, mehrwertSteuer), endpreisRabatt(funcEndpreis(kaufpreis, mehrwertSteuer), rabatt))
End
Sub subEndpreisMit (endpreisOhneRabatt, rabatt As Double)
Dim As Double endpreisMitRabatt
If rabatt = 0 Then
Print "Kein Rabatt!"
Else
endpreisMitRabatt = endpreisOhneRabatt - rabatt
Print Using "Der Endpreis mit Rabatt betraegt : ####,#.## Euro"; endpreisMitRabatt
End If
End Sub
Function funcEndpreis (kaufpreis, mehrwertSteuer As Double)
Dim As Double gesamtpreis
gesamtpreis = kaufpreis + ((kaufpreis * mehrwertSteuer) / 100)
funcEndpreis = gesamtpreis
End Function
Function endpreisRabatt (endpreisOhneRabatt, rabatt As Double)
Dim As Double rabattBetrag
rabattBetrag = ((endpreisOhneRabatt * rabatt) / 100)
endpreisRabatt = rabattBetrag
End Function
Posts: 2,577
Threads: 264
Joined: Apr 2022
Reputation:
140
So what is the func end preis of a rabbat in Germany? Around here they sell for about $9 dollars a pound.
Pete +1
Posts: 719
Threads: 110
Joined: Apr 2022
Reputation:
28
05-28-2025, 03:32 AM
(This post was last modified: 05-28-2025, 03:35 AM by PhilOfPerth.)
(05-26-2025, 08:59 PM)eoredson Wrote: The neat thing about functions is they can be imbedded in each other which a subroutine cannot:
Code: (Select All) Print x(2), y(4), z(10)
Print x(y(z(10)))
End
Function x (a)
x = 1 + a
End Function
Function y (b)
y = 2 + b
End Function
Function z (c)
z = 3 + c
End Function
I'm a bit confused about how this limits anything. We can't EMBED subs, but can't we get the same effect by calls from subs to other subs?
Have a look at this:
Code: (Select All) DW = _DesktopWidth: DH = _DesktopHeight: sw = 1200 ' 1200 is 92.3 CPL, fits 21 images
Screen _NewImage(sw, 640, 32)
SetFont: F& = _LoadFont("C:\WINDOWS\fonts\courbd.ttf", 20, "monospace"): _Font F&
LHS = (DW - sw) / 2: Top = (DH - 800) / 2
_ScreenMove LHS, Top ' centres display on target screen
Common Shared Num1, Str1$, CPL, Ctr, LineNum
ShowSubs
Locate 1, 1
yellow: Print " Setting two Numeric and two string vars to:": white
Num1 = 10: Num2 = 100: Str1$ = "ABC": Str2$ = "DEF"
Print " Num1 ="; Num1; " Num2 ="; Num2; " Str1$ = "; Str1$; " Str2$ = "; Str2$
yellow: Print " Num1 and Str1$ are Common Shared, others are not"
Sleep 2
Print
Print " BEFORE calling Sub One,": white
Print " Num1 ="; Num1; " Num2 ="; Num2; " Str1$ = "; Str1$; " Str2$ = "; Str2$
One
Print
yellow: Print " AFTER calling Sub One,": white
Print " Num1 ="; Num1; " Num2 ="; Num2; " Str1$ = "; Str1$; " Str2$ = "; Str2$
yellow: Print " (Shared vars were treated, unshared were not)."
Print
Print " Press a key to reset all 4 vars and continue"
Sleep: Cls
ShowSubs
Num1 = 10: Num2 = 100: Str1$ = "ABC": Str2$ = "DEF"
Locate 1, 1
yellow: Print " BEFORE calling Two,": white
Print " Num1 ="; Num1; " Num2 ="; Num2; " Str1$ = "; Str1$; " Str2$ = "; Str2$
Sleep 2
yellow: Print " Calling Sub Two now": Sleep 2: Print
Two
Print " After Sub Two acts and calls Sub Three,": white
Print " Num1 ="; Num1; " Num2 ="; Num2; " Str1$ = "; Str1$; " Str2$ = "; Str2$
Sleep 1
Print " (Sub Two acted on vars, then passed to Sub Three, which acted on Sub Two results,"
Print " then reurned via Sub Two to the line after Sub Two call)."
Print: yellow: Print " After returning to Sub Two and then to Sub One,": white
Print " Num1 ="; Num1; " Num2 ="; Num2; " Str1$ = "; Str1$; " Str2$ = "; Str2$
Sub One
Num1 = Num1 * 2: num2 = num2 * 2: Str1$ = Str1$ + "abc": str2$ = str2$ + "def"
End Sub
Sub Two
Num1 = Num1 * 2: num2 = num2 * 2: Str1$ = Str1$ + "abc": str2$ = str2$ + "def"
Three
End Sub
Sub Three
Num1 = Num1 * 2: num2 = num2 * 2: Str1$ = Str1$ + "abc": str2$ = str2$ + "def"
End Sub
Sub ShowSubs
yellow: Locate 23, 1: Print " Sub One is:": white
Print " Num1 = Num1 * 2: Num2 = Num2 * 2";
Print ": Str1$ = Str1$ + "; Chr$(34); "abc"; Chr$(34);
Print " : Str2$ = Str2$ + "; Chr$(34); "def"; Chr$(34)
Print
yellow: Print " Sub Two is:": white
Print " Num1 = Num1 * 2: Num2 = Num2 * 2";
Print ": Str1$ = Str1$ + "; Chr$(34); "abc"; Chr$(34);
Print " : Str2$ = Str2$ + "; Chr$(34); "def"; Chr$(34)
Print " Three"
Print
yellow: Print " Sub Three is:": white
Print " Num1 = Num1 * 2: Num2 = Num2 * 2";
Print ": Str1$ = Str1$ + "; Chr$(34); "abc"; Chr$(34);
Print " : Str2$ = Str2$ + "; Chr$(34); "def"; Chr$(34)
Print " (same as Sub One)"
End Sub
Sub WIPE (LN$)
If Len(LN$) = 1 Then LN$ = "0" + LN$
For A = 1 To Len(LN$) - 1 Step 2
WL = Val(Mid$(LN$, A, 2))
Locate WL, 1: Print Space$(CPL - 1);
Next
End Sub
Sub yellow
Color _RGB(255, 255, 0)
End Sub
Sub white
Color _RGB(255, 255, 255)
End Sub
(sorry if it's a bit long-winded, but I have to cater to my short-term memory).
Doesn't this give the same results as having embedded subs?
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, Western Australia.) 
Please visit my Website at: http://oldendayskids.blogspot.com/
Posts: 4,156
Threads: 190
Joined: Apr 2022
Reputation:
263
05-28-2025, 06:17 AM
(This post was last modified: 05-28-2025, 08:00 AM by bplus.)
@PhilOfPerth the way you are using Subs in place of functions makes clear how functions are so much easier to use and understand. First of all you don't have to rely on special shared variables
Replace Sub One, Two and Three in your example with 2 Functions Twice&(Number&) and StrAdd$(s1$, s2$)
and do it for allot more variables without Shared variables!
For example do this with Subs:
Code: (Select All) Print "For numbers 1 to 10, show number and Twice it:"
For i = 1 To 10
Print i; "-"; Twice&(i); " ";
Next
Print: Print
Print "For letters a - z show the letter and 2 random letters with it"
For i = 1 To 26
Print Chr$(i + 96); "-"; StrAdd$(Chr$(i + 96), StrAdd$(RndLetter$, RndLetter$)); " ";
Next
Print
Function Twice& (Number&)
Twice& = Number& * 2
End Function
Function StrAdd$ (s1$, s2$)
StrAdd$ = s1$ + s2$
End Function
Function RndLetter$ ()
RndLetter$ = Chr$(Int(Rnd * 26) + 97)
End Function
b = b + ...
Posts: 719
Threads: 110
Joined: Apr 2022
Reputation:
28
(05-28-2025, 06:17 AM)bplus Wrote: @PhilOfPerth the way you are using Subs in place of functions makes clear how functions are so much easier to use and understand. First of all you don't have to rely on special shared variables
Replace Sub One, Two and Three in your example with 2 Functions Twice&(Number&) and StrAdd$(s1$, s2$)
and do it for allot more variables without Shared variables!
For example do this with Subs:
Code: (Select All) Print "For numbers 1 to 10, show number and Twice it:"
For i = 1 To 10
Print i; "-"; Twice&(i); " ";
Next
Print: Print
Print "For letters a - z show the letter and 2 random letters with it"
For i = 1 To 26
Print Chr$(i + 96); "-"; StrAdd$(Chr$(i + 96), StrAdd$(RndLetter$, RndLetter$)); " ";
Next
Print
Function Twice& (Number&)
Twice& = Number& * 2
End Function
Function StrAdd$ (s1$, s2$)
StrAdd$ = s1$ + s2$
End Function
Function RndLetter$ ()
RndLetter$ = Chr$(Int(Rnd * 26) + 97)
End Function
@bplus
Thank you, but I remain unconvinced, sorry.
Do you mean something like this?
Code: (Select All) Common Shared a
Print "For numbers 1 to 10, show number and Twice it:"
For a = 1 To 10
DublIt (a)
Next
Print "For letters a - z show the letter and 2 random letters with it"
For a = 1 To 26
AddRandom (a)
Next
Sub DublIt (a)
Print a; "-"; a * 2
End Sub
Sub AddRandom (a)
Print Chr$(a + 64);
For a = 1 To 2
Print Chr$(Rnd * 26 + 64);
Next
Print " ";
End Sub
Yes, it uses a shared variable (and probably more on larger progs), but I find these easier to manage.
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, Western Australia.) 
Please visit my Website at: http://oldendayskids.blogspot.com/
|