Thread Rating:
  • 1 Vote(s) - 5 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Use of Functions
#31
(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.  Smile
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, Western Australia.) Big Grin
Please visit my Website at: http://oldendayskids.blogspot.com/
Reply
#32
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 Big Grin
Reply
#33
You never run dry, do you?? 
Tongue
Reply
#34
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:
Reply
#35
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
Reply
#36
I hope the translation is understandable. I didn't find any errors in the calculation.  Rolleyes

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

[Image: Funktion-In-Funktion-Sub2025-05-27.jpg]
Reply
#37
So what is the func end preis of a rabbat in Germany? Around here they sell for about $9 dollars a pound.

Pete +1
Reply
#38
(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.) Big Grin
Please visit my Website at: http://oldendayskids.blogspot.com/
Reply
#39
@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 + ...
Reply
#40
(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. Smile
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, Western Australia.) Big Grin
Please visit my Website at: http://oldendayskids.blogspot.com/
Reply




Users browsing this thread: 7 Guest(s)