Posts: 4,138
Threads: 190
Joined: Apr 2022
Reputation:
261
04-18-2025, 12:47 PM
(This post was last modified: 04-18-2025, 12:50 PM by bplus.)
Well my mr functions require a $ as in mr$( ) and they use variable length strings not fixed.
hmmm... where are those ", 1" coming from? Looks like 4th arguement to Mr$
See the bottom error line that the exe is looking at.
Attempt to get red-line removed in Dragoncat code:
Code: (Select All)
' test Dragon by removal of fixed string in calls to Mr$
Dim dinpt, oput As String * 40
Dim dbase As String * 800
Dim dinput As String * 80
Dim dnum As String * 80
Dim whprt As String * 800
Dim fprt As String * 800
Dim gttl As String
Dim qmlt As String
Dim mlt As String
Dim zee As String
Dim sen As Long
Dim sign As Long
Dim ctr As Long
Dim flg As Long
Dim flg2 As Long
Dim lsplt As Long
Dim rsplt As Long
Dim pres As Long
Randomize Timer
Rem $Dynamic
dinput = "000000000000"
Print "enter number to convert from incl.base use 4 digits for each digit include 0 in each of the 4 places thaat contains no value so 0 is 0000 and 1 is 0001 "
Print "first enter a base of at least 2 (0002) enter - for a negative number . for decimal point"
Input ": "; dinput
Print " in a similiar manner enter the base to convert too "
Input ": "; oput
sen = Len(dinput)
dbase = Left$(dinput, 4)
sen = sen - 4
dnum = Right$(dinput, sen)
sign = 1
sen = Len(dnum)
If Left$(dnum, 1) = "-" Then
sign = -1
sen = sen - 1
dnum = Right$(dnum, sen)
End If
ctr = 1
flg = 0
flg2 = 0
While flg = 0 And ctr <= sen
If Mid$(dnum, ctr, 1) = "." Then
lsplt = ctr - 1
rsplt = sen - ctr
flg = 1
If ctr = 1 Then flg2 = 1
End If
ctr = ctr + 1
Wend
If flg = 1 And flg2 = 0 Then
whprt = Left$(dnum, lsplt)
fprt = Right$(dnum, rsplt)
End If
If flg = 1 And flg2 = 1 Then
whprt = "0000"
fprt = Right$(dnum, rsplt)
lsplt = 4
End If
gttl = "0"
qmlt = "1"
mlt = dbase
If flg = 0 Then whprt = dnum
While lsplt > 0
zee = Right$(whprt, 4)
gttl = Mr$(gttl, "+", Mr$(zee,"*", qmlt))
qmlt = mr$(qmlt, "*", mlt)
lsplt = lsplt - 4
whprt = Left$(whprt, lsplt)
Wend
pres = Int((Log(Val(dbase)) * Int(rsplt / 4)) / Log(Val(oput)))
qmlt = "1"
Rem wqs&& = 1 to pres&&
qmlt = mr(qmlt, "/", dbase)
While rsplt >= 4
zee = Left$(fprt, 4)
gttl = mr(gttl, "+", mr(zee, "*", qmlt))
qmlt = mr(qmlt, "/", dbase)
rsplt = rsplt - 4
fprt = Right$(fprt, rsplt)
Wend
Print "base ten value: "; gttl
$include: 'StringMath.bm'
b = b + ...
Posts: 949
Threads: 51
Joined: May 2022
Reputation:
31
There is an example in the wiki for converting a decimal number to binary. I have adapted it for myself to better understand it. However, I don't know up to what size the program works.
Code: (Select All)
'Dezimalzahl in Binaerformat umwandeln - 18. April 2025
'Wiki: https://qb64phoenix.com/qb64wiki/index.php/Binary
Option _Explicit
Declare Sub DezimalNachBinaer(eingabe As Long)
Dim As Long dezimalZahl
Do
Locate 3, 3
Input "Eingabe einer Dezimalzahl (0 fuer Beenden): ", dezimalZahl
Locate 6, 3
DezimalNachBinaer (dezimalZahl)
Sleep 5: Cls
Loop Until dezimalZahl = 0
End
Sub DezimalNachBinaer (eingabe As Long)
Dim As Integer absolutWert
Dim As String binaerZahl, binaerZK
If eingabe = 0 Then Exit Sub
Do
absolutWert = Abs(eingabe Mod 2) 'Rest wird verwendet, um Binaerzahlen zu erstellen
eingabe = eingabe \ 2 ' Bei der Ganzzahldivision wird der Exponent von 2 um einen Faktor erhoeht.
binaerZahl = LTrim$(Str$(absolutWert)) 'make remainder a string number
binaerZK = binaerZahl + binaerZK ' add remainder to binary number
Loop Until eingabe = 0
Print "Binaerzahl: = " + binaerZK
End Sub
Posts: 4,138
Threads: 190
Joined: Apr 2022
Reputation:
261
Yeah my String Math routines can do Bin2Dec$ and back again, any size including decimal points. My Binary are 0's and 1's and a decimal, no bit/byte 0's considered, they are handled just as a decimal number in string form.
b = b + ...
Posts: 4,138
Threads: 190
Joined: Apr 2022
Reputation:
261
04-19-2025, 05:08 PM
(This post was last modified: 04-19-2025, 05:08 PM by bplus.)
So no one knows what is causing the exe error line to show extra ", 1," in arguments list shown in error line of red-lined code?
b = b + ...
Posts: 3,016
Threads: 357
Joined: Apr 2022
Reputation:
282
04-19-2025, 06:30 PM
(This post was last modified: 04-19-2025, 06:30 PM by SMcNeill.)
This works, after piecing together the various routines into one file.
What you posted above lists a BM file (perhaps a BI file as well), so I don't know what the differences are. I just checked previous versions of this post and copied/pasted in missing routines until it compiled and ran without an error.
Code: (Select All)
Option _Explicit
_Title "String Math Powers 2022-09-22" ' b+ try to do powers with string math
' directly from "String Math 2021-06-14" ' b+ from SM2 (2021 June) a bunch of experiments to fix and improve speeds.
' June 2021 fix some old String Math procedures, better nInverse with new LT function, remove experimental procedures.
' Now with decent sqrRoot it works independent of Mr$() = Math Regulator that handles signs and decimals and calls to
' add$(), subtr$, mult$, divide$ (100 significant digits), add$(), subtr$, mult$ are exact!
' If you need higher precsion divide, I recommend use nInverse on denominator (integer)
' then add sign and decimal and mult$() that number with numerator to get divsion answer in higher precision than 100.
' (See how Mr$() handles division and just call nInverse$ with what precision you need.)
' The final function showDP$() is for displaying these number to a set amount of Decimal Places.
' The main code is sampler of tests performed with these functions.
' 2022-09-22 a little fix to MR$ for Function change versions QB64 v2.0+
' Attempt to do Powers with SQRs of 2 Multipliers
' needs to be able to convert a number into a binary String
' might also need a Table setup for nested SQR's of 2
' needs a decent BigSQR$ string function for SQR
' 2022-09-25 this is one frustration after another LT does not work for strings??? but < does?
' try some more with BigSQR concentrate on Integer part first, just get that right
' 2022-09-26 Bin2Dec$ Function seems OK
$Console:Only
Dim dinpt, oput As String * 40
Dim dbase As String * 800
Dim dinput As String * 80
Dim dnum As String * 80
Dim whprt As String * 800
Dim fprt As String * 800
Dim gttl As String * 800
Dim qmlt As String * 80
Dim mlt As String * 80
Dim zee As String * 800
Dim sen As Long
Dim sign As Long
Dim ctr As Long
Dim flg As Long
Dim flg2 As Long
Dim lsplt As Long
Dim rsplt As Long
Dim pres As Long
Randomize Timer
Rem $Dynamic
' test Dragon by removal of fixed string in calls to Mr$
dinput = "000000000000"
Print "enter number to convert from incl.base use 4 digits for each digit include 0 in each of the 4 places thaat contains no value so 0 is 0000 and 1 is 0001 "
Print "first enter a base of at least 2 (0002) enter - for a negative number . for decimal point"
Input ": "; dinput
Print " in a similiar manner enter the base to convert too "
Input ": "; oput
sen = Len(dinput)
dbase = Left$(dinput, 4)
sen = sen - 4
dnum = Right$(dinput, sen)
sign = 1
sen = Len(dnum)
If Left$(dnum, 1) = "-" Then
sign = -1
sen = sen - 1
dnum = Right$(dnum, sen)
End If
ctr = 1
flg = 0
flg2 = 0
While flg = 0 And ctr <= sen
If Mid$(dnum, ctr, 1) = "." Then
lsplt = ctr - 1
rsplt = sen - ctr
flg = 1
If ctr = 1 Then flg2 = 1
End If
ctr = ctr + 1
Wend
If flg = 1 And flg2 = 0 Then
whprt = Left$(dnum, lsplt)
fprt = Right$(dnum, rsplt)
End If
If flg = 1 And flg2 = 1 Then
whprt = "0000"
fprt = Right$(dnum, rsplt)
lsplt = 4
End If
gttl = "0"
qmlt = "1"
mlt = dbase
If flg = 0 Then whprt = dnum
While lsplt > 0
zee = Right$(whprt, 4)
gttl = mr$(gttl, "+", mr("", "*", ""))
qmlt = mr$(qmlt, "*", mlt)
lsplt = lsplt - 4
whprt = Left$(whprt, lsplt)
Wend
pres = Int((Log(Val(dbase)) * Int(rsplt / 4)) / Log(Val(oput)))
qmlt = "1"
Rem wqs&& = 1 to pres&&
qmlt = mr(qmlt, "/", dbase)
While rsplt >= 4
zee = Left$(fprt, 4)
gttl = mr(gttl, "+", mr(zee, "*", qmlt))
qmlt = mr(qmlt, "/", dbase)
rsplt = rsplt - 4
fprt = Right$(fprt, rsplt)
Wend
Print "base ten value: "; gttl
' 2022-09-25 Use BigSQR$ it's way faster, no estimating!
' == String Math 2021-06-14 Procedure start here (aprox 412 LOC for copy/paste into your app) ==
Function sqrRoot$ (nmbr$)
Dim n$, guess$, lastGuess$, other$, sum$, imaginary$, loopcnt
If Left$(nmbr$, 1) = "-" Then 'handle neg numbers
imaginary$ = "*i": n$ = Mid$(nmbr$, 2)
Else
imaginary$ = "": n$ = nmbr$
End If
guess$ = mr$(n$, "/", "2")
other$ = n$
Do
loopcnt = loopcnt + 1
If (Mid$(guess$, 1, 105) = Mid$(lastGuess$, 1, 105)) Then
' go past 100 matching digits for 100 digit precision
sqrRoot$ = Mid$(other$, 1, 101) + imaginary$
' try other factor for guess$ sometimes it nails answer without all digits
Exit Function
Else
lastGuess$ = guess$
sum$ = mr$(guess$, "+", other$)
guess$ = mr$(sum$, "/", "2")
other$ = mr$(n$, "/", guess$)
End If
Loop
End Function
Function add$ (a$, b$) 'add 2 positive integers assume a and b are just numbers no - signs
'set a and b numbers to same length and multiple of 18 so can take 18 digits at a time
Dim As Long la, lb, m, g
Dim sa As _Unsigned _Integer64, sb As _Unsigned _Integer64, co As _Unsigned _Integer64
Dim fa$, fb$, t$, new$, result$
la = Len(a$): lb = Len(b$)
If la > lb Then m = Int(la / 18) + 1 Else m = Int(lb / 18) + 1
fa$ = Right$(String$(m * 18, "0") + a$, m * 18)
fb$ = Right$(String$(m * 18, "0") + b$, m * 18)
'now taking 18 digits at a time Thanks Steve McNeill
For g = 1 To m
sa = Val(Mid$(fa$, (m - g) * 18 + 1, 18))
sb = Val(Mid$(fb$, (m - g) * 18 + 1, 18))
t$ = Right$(String$(36, "0") + _Trim$(Str$(sa + sb + co)), 36)
co = Val(Mid$(t$, 1, 18))
new$ = Mid$(t$, 19)
result$ = new$ + result$
Next
If co Then result$ = Str$(co) + result$
add$ = result$
End Function
' This is used in nInverse$ not by Mr$ because there it saves time!
Function subtr1$ (a$, b$)
Dim As Long la, lb, lResult, i, ca, cb, w
Dim result$, fa$, fb$
la = Len(a$): lb = Len(b$)
If la > lb Then lResult = la Else lResult = lb
result$ = Space$(lResult)
fa$ = result$: fb$ = result$
Mid$(fa$, lResult - la + 1) = a$
Mid$(fb$, lResult - lb + 1) = b$
For i = lResult To 1 Step -1
ca = Val(Mid$(fa$, i, 1))
cb = Val(Mid$(fb$, i, 1))
If cb > ca Then ' borrow 10
Mid$(result$, i, 1) = Right$(Str$(10 + ca - cb), 1)
w = i - 1
While w > 0 And Mid$(fa$, w, 1) = "0"
Mid$(fa$, w, 1) = "9"
w = w - 1
Wend
Mid$(fa$, w, 1) = Right$(Str$(Val(Mid$(fa$, w, 1)) - 1), 1)
Else
Mid$(result$, i, 1) = Right$(Str$(ca - cb), 1)
End If
Next
subtr1$ = result$
End Function
' 2021-06-08 fix up with new mr call that decides the sign and puts the greater number first
Function subtr$ (sum$, minus$) ' assume both numbers are positive all digits
Dim As Long m, g, p
Dim VB As _Unsigned _Integer64, vs As _Unsigned _Integer64, tenE18 As _Unsigned _Integer64
Dim ts$, tm$, sign$, LG$, sm$, t$, result$
ts$ = _Trim$(sum$): tm$ = _Trim$(minus$) ' fixed subtr$ 2021-06-05
If trim0(ts$) = trim0$(tm$) Then subtr$ = "0": Exit Function 'proceed knowing not equal
tenE18 = 1000000000000000000 'yes!!! no dang E's
sign$ = ""
m = Int(Len(ts$) / 18) + 1
LG$ = Right$(String$(m * 18, "0") + ts$, m * 18)
sm$ = Right$(String$(m * 18, "0") + tm$, m * 18)
'now taking 18 digits at a time From Steve I learned we can do more than 1 digit at a time
For g = 1 To m
VB = Val(Mid$(LG$, m * 18 - g * 18 + 1, 18))
vs = Val(Mid$(sm$, m * 18 - g * 18 + 1, 18))
If vs > VB Then
t$ = Right$(String$(18, "0") + _Trim$(Str$(tenE18 - vs + VB)), 18)
p = (m - g) * 18
While p > 0 And Mid$(LG$, p, 1) = "0"
Mid$(LG$, p, 1) = "9"
p = p - 1
Wend
If p > 0 Then Mid$(LG$, p, 1) = _Trim$(Str$(Val(Mid$(LG$, p, 1)) - 1))
Else
t$ = Right$(String$(18, "0") + _Trim$(Str$(VB - vs)), 18)
End If
result$ = t$ + result$
Next
subtr$ = result$
End Function
Function TrimLead0$ (s$) 'for treating strings as number (pos integers)
Dim copys$
Dim As Long i, find
copys$ = _Trim$(s$) 'might as well remove spaces too
i = 1: find = 0
While i < Len(copys$) And Mid$(copys$, i, 1) = "0"
i = i + 1: find = 1
Wend
If find = 1 Then copys$ = Mid$(copys$, i)
If copys$ = "" Then TrimLead0$ = "0" Else TrimLead0$ = copys$
End Function
' catchy? mr$ for math regulator cop$ = " + - * / " 1 of 4 basic arithmetics
' Fixed so that add and subtract have signs calc'd in Mr and correct call to add or subtract made
' with bigger minus smaller in subtr$() call
Function mr$ (a$, cop$, b$)
Dim op$, ca$, cb$, aSgn$, bSgn$, postOp$, sgn$, rtn$
Rem Dim aLTb As String * 800
Dim As Long adp, bdp, dp, lpop, aLTb
op$ = _Trim$(cop$) 'save fixing each time
ca$ = _Trim$(a$): cb$ = _Trim$(b$) 'make copies in case we change
'strip signs and decimals
If Left$(ca$, 1) = "-" Then
aSgn$ = "-": ca$ = Mid$(ca$, 2)
Else
aSgn$ = ""
End If
dp = InStr(ca$, ".")
If dp > 0 Then
adp = Len(ca$) - dp
ca$ = Mid$(ca$, 1, dp - 1) + Mid$(ca$, dp + 1)
Else
adp = 0
End If
If Left$(cb$, 1) = "-" Then
bSgn$ = "-": cb$ = Mid$(cb$, 2)
Else
bSgn$ = ""
End If
dp = InStr(cb$, ".")
If dp > 0 Then
bdp = Len(cb$) - dp
cb$ = Mid$(cb$, 1, dp - 1) + Mid$(cb$, dp + 1)
Else
bdp = 0
End If
If op$ = "+" Or op$ = "-" Or op$ = "/" Then 'add or subtr even up strings on right of decimal
'even up the right sides of decimals if any
If adp > bdp Then dp = adp Else dp = bdp
If adp < dp Then ca$ = ca$ + String$(dp - adp, "0")
If bdp < dp Then cb$ = cb$ + String$(dp - bdp, "0")
ElseIf op$ = "*" Then
dp = adp + bdp
End If
If op$ = "*" Or op$ = "/" Then
If aSgn$ = bSgn$ Then sgn$ = "" Else sgn$ = "-"
End If
'now according to signs and op$ call add$ or subtr$
If op$ = "-" Then ' make it adding according to signs because that is done for + next!
If bSgn$ = "-" Then bSgn$ = "" Else bSgn$ = "-" ' flip bSgn$ with op$
op$ = "+" ' turn this over to + op already done! below
End If
If op$ = "+" Then
If aSgn$ = bSgn$ Then 'really add
postOp$ = add$(ca$, cb$)
sgn$ = aSgn$
ElseIf aSgn$ <> bSgn$ Then 'have a case of subtraction
'but which is first and which is 2nd and should final sign be pos or neg
If TrimLead0$(ca$) = TrimLead0(cb$) Then 'remove case a = b
mr$ = "0": Exit Function
Else
aLTb = LTE(ca$, cb$)
If aSgn$ = "-" Then
If aLTb Then ' b - a = pos
postOp$ = subtr$(cb$, ca$)
sgn$ = ""
Else ' a > b so a - sgn wins - (a - b)
postOp$ = subtr$(ca$, cb$)
sgn$ = "-"
End If
Else ' b has the - sgn
If aLTb Then ' result is -
postOp$ = subtr$(cb$, ca$)
sgn$ = "-"
Else ' result is pos
postOp$ = subtr$(ca$, cb$)
sgn$ = ""
End If
End If
End If
End If
ElseIf op$ = "*" Then
postOp$ = mult$(ca$, cb$)
ElseIf op$ = "/" Then
postOp$ = divide$(ca$, cb$)
End If ' which op
If op$ <> "/" Then 'put dp back
lpop = Len(postOp$) ' put decimal back if there is non zero stuff following it
If Len(Mid$(postOp$, lpop - dp + 1)) Then ' fix 1 extra dot appearing in 10000! ?!
If TrimLead0$(Mid$(postOp$, lpop - dp + 1)) <> "0" Then ' .0 or .00 or .000 ??
postOp$ = Mid$(postOp$, 1, lpop - dp) + "." + Mid$(postOp$, lpop - dp + 1)
End If
End If
End If
rtn$ = trim0$(postOp$) 'trim lead 0's then tack on sign
If rtn$ <> "0" Then mr$ = sgn$ + rtn$ Else mr$ = rtn$
End Function
Function divide$ (n$, d$) ' goal here is 100 digits precision not 100 digits past decimal
Dim di$, ndi$
Dim As Long nD
If n$ = "0" Then divide$ = "0": Exit Function
If d$ = "0" Then divide$ = "div 0": Exit Function
If d$ = "1" Then divide$ = n$: Exit Function
' aha! found a bug when d$ gets really huge 100 is no where near enough!!!!
' 2021-06-03 fix by adding 100 to len(d$), plus have to go a little past 100 like 200
di$ = Mid$(nInverse$(d$, Len(d$) + 200), 2) 'chop off decimal point after
nD = Len(di$)
ndi$ = mult$(n$, di$)
ndi$ = Mid$(ndi$, 1, Len(ndi$) - nD) + "." + Right$(String$(nD, "0") + Right$(ndi$, nD), nD)
divide$ = ndi$
End Function
' This uses Subtr1$ is Positive Integer only!
' DP = Decimal places = says when to quit if don't find perfect divisor before
Function nInverse$ (n$, DP As Long) 'assume decimal at very start of the string of digits returned
Dim m$(1 To 9), si$, r$, outstr$, d$
Dim i As Long
For i = 1 To 9
si$ = _Trim$(Str$(i))
m$(i) = mult$(si$, n$)
Next
outstr$ = ""
If n$ = "0" Then nInverse$ = "Div 0": Exit Function
If n$ = "1" Then nInverse$ = "1": Exit Function
outstr$ = "." 'everything else n > 1 is decimal 8/17
r$ = "10"
Do
While LT(r$, n$) ' 2021-06-08 this should be strictly Less Than
outstr$ = outstr$ + "0" ' add 0 to the output string
If Len(outstr$) = DP + 1 Then nInverse$ = outstr$: Exit Function 'DP length?
r$ = r$ + "0"
Wend
For i = 9 To 1 Step -1
If LTE(m$(i), r$) Then d$ = _Trim$(Str$(i)): Exit For
Next
outstr$ = outstr$ + d$
If Len(outstr$) = DP + 1 Then nInverse$ = outstr$: Exit Function
r$ = subtr1$(r$, mult$(d$, n$)) 'r = r -d*n ' 2021-06-08 subtr1 works faster
If TrimLead0$(r$) = "0" Then nInverse$ = outstr$: Exit Function ' add trimlead0$ 6/08
r$ = r$ + "0" 'add another place
Loop
End Function
Function mult$ (a$, b$) 'assume both positive integers prechecked as all digits strings
Dim As Long la, lb, m, g, dp
Dim As _Unsigned _Integer64 v18, sd, co
Dim f18$, f1$, t$, build$, accum$
If a$ = "0" Then mult$ = "0": Exit Function
If b$ = "0" Then mult$ = "0": Exit Function
If a$ = "1" Then mult$ = b$: Exit Function
If b$ = "1" Then mult$ = a$: Exit Function
'find the longer number and make it a mult of 18 to take 18 digits at a time from it
la = Len(a$): lb = Len(b$)
If la > lb Then
m = Int(la / 18) + 1
f18$ = Right$(String$(m * 18, "0") + a$, m * 18)
f1$ = b$
Else
m = Int(lb / 18) + 1
f18$ = Right$(String$(m * 18, "0") + b$, m * 18)
f1$ = a$
End If
For dp = Len(f1$) To 1 Step -1 'dp = digit position of the f1$
build$ = "" 'line builder
co = 0
'now taking 18 digits at a time Thanks Steve McNeill
For g = 1 To m
v18 = Val(Mid$(f18$, (m - g) * 18 + 1, 18))
sd = Val(Mid$(f1$, dp, 1))
t$ = Right$(String$(19, "0") + _Trim$(Str$(v18 * sd + co)), 19)
co = Val(Mid$(t$, 1, 1))
build$ = Mid$(t$, 2) + build$
Next g
If co Then build$ = _Trim$(Str$(co)) + build$
If dp = Len(f1$) Then
accum$ = build$
Else
accum$ = add$(accum$, build$ + String$(Len(f1$) - dp, "0"))
End If
Next dp
mult$ = accum$
End Function
Function TrimTail0$ (s$)
Dim copys$
Dim As Long dp, i, find
copys$ = _Trim$(s$) 'might as well remove spaces too
TrimTail0$ = copys$
dp = InStr(copys$, ".")
If dp > 0 Then
i = Len(copys$): find = 0
While i > dp And Mid$(copys$, i, 1) = "0"
i = i - 1: find = 1
Wend
If find = 1 Then
If i = dp Then
TrimTail0$ = Mid$(copys$, 1, dp - 1)
Else
TrimTail0$ = Mid$(copys$, 1, i)
End If
End If
End If
End Function
Function trim0$ (s$)
Dim cs$, si$
cs$ = s$
si$ = Left$(cs$, 1)
If si$ = "-" Then cs$ = Mid$(cs$, 2)
cs$ = TrimLead0$(cs$)
cs$ = TrimTail0$(cs$)
If Right$(cs$, 1) = "." Then cs$ = Mid$(cs$, 1, Len(cs$) - 1)
If si$ = "-" Then trim0$ = si$ + cs$ Else trim0$ = cs$
End Function
' for displaying truncated numbers say to 60 digits
Function showDP$ (dnum, nDP As Long)
Dim Cnum$, num$
Dim As Long dp, d, i
Cnum$ = num$ 'since num$ could get changed
showDP$ = num$
dp = InStr(num$, ".")
If dp > 0 Then
If Len(Mid$(Cnum$, dp + 1)) > nDP Then
d = Val(Mid$(Cnum$, dp + nDP + 1, 1))
If d > 4 Then
Cnum$ = "0" + Cnum$ ' tack on another 0 just in case 9's all the way to left
dp = dp + 1
i = dp + nDP
While Mid$(Cnum$, i, 1) = "9" Or Mid$(Cnum$, i, 1) = "."
If Mid$(Cnum$, i, 1) = "9" Then
Mid$(Cnum$, i, 1) = "0"
End If
i = i - 1
Wend
Mid$(Cnum$, i, 1) = _Trim$(Str$(Val(Mid$(Cnum$, i, 1)) + 1)) 'last non 9 digit
Cnum$ = Mid$(Cnum$, 1, dp + nDP) 'chop it
showDP$ = trim0$(Cnum$)
Else
showDP$ = Mid$(Cnum$, 1, dp + nDP)
End If
End If
End If
End Function
'this function needs TrimLead0$(s$) ' dang I can't remember if a$ and b$ can have decimals or not
Function LTE (a$, b$) ' a$ Less Than or Equal b$ comparison of 2 strings
Dim ca$, cb$
Dim As Long la, lb, i
ca$ = TrimLead0$(a$): cb$ = TrimLead0(b$)
la = Len(ca$): lb = Len(cb$)
If ca$ = cb$ Then
LTE = -1
ElseIf la < lb Then ' a is smaller
LTE = -1
ElseIf la > lb Then ' a is bigger
LTE = 0
ElseIf la = lb Then ' equal lengths
For i = 1 To Len(ca$)
If Val(Mid$(ca$, i, 1)) > Val(Mid$(cb$, i, 1)) Then
LTE = 0: Exit Function
ElseIf Val(Mid$(ca$, i, 1)) < Val(Mid$(cb$, i, 1)) Then
LTE = -1: Exit Function
End If
Next
End If
End Function
'need this for ninverse faster than subtr$ for sign
Function LT (a$, b$) ' a$ Less Than or Equal b$ comparison of 2 strings
Dim ca$, cb$
Dim As Long la, lb, i
ca$ = TrimLead0$(a$): cb$ = TrimLead0(b$)
la = Len(ca$): lb = Len(cb$)
If la < lb Then ' a is smaller
LT = -1
ElseIf la > lb Then ' a is bigger
LT = 0
ElseIf la = lb Then ' equal lengths
For i = 1 To Len(ca$)
If Val(Mid$(ca$, i, 1)) > Val(Mid$(cb$, i, 1)) Then
LT = 0: Exit Function
ElseIf Val(Mid$(ca$, i, 1)) < Val(Mid$(cb$, i, 1)) Then
LT = -1: Exit Function
End If
Next
End If
End Function
Posts: 3,016
Threads: 357
Joined: Apr 2022
Reputation:
282
Problem found and fixed:
Code: (Select All)
' test Dragon by removal of fixed string in calls to Mr$
Dim dinpt, oput As String * 40
Dim dbase As String * 800
Dim dinput As String * 80
Dim dnum As String * 80
Dim whprt As String * 800
Dim fprt As String * 800
Dim gttl As String
Dim qmlt As String
Dim mlt As String
Dim zee As String
Dim sen As Long
Dim sign As Long
Dim ctr As Long
Dim flg As Long
Dim flg2 As Long
Dim lsplt As Long
Dim rsplt As Long
Dim pres As Long
Randomize Timer
Rem $Dynamic
dinput = "000000000000"
Print "enter number to convert from incl.base use 4 digits for each digit include 0 in each of the 4 places thaat contains no value so 0 is 0000 and 1 is 0001 "
Print "first enter a base of at least 2 (0002) enter - for a negative number . for decimal point"
Input ": "; dinput
Print " in a similiar manner enter the base to convert too "
Input ": "; oput
sen = Len(dinput)
dbase = Left$(dinput, 4)
sen = sen - 4
dnum = Right$(dinput, sen)
sign = 1
sen = Len(dnum)
If Left$(dnum, 1) = "-" Then
sign = -1
sen = sen - 1
dnum = Right$(dnum, sen)
End If
ctr = 1
flg = 0
flg2 = 0
While flg = 0 And ctr <= sen
If Mid$(dnum, ctr, 1) = "." Then
lsplt = ctr - 1
rsplt = sen - ctr
flg = 1
If ctr = 1 Then flg2 = 1
End If
ctr = ctr + 1
Wend
If flg = 1 And flg2 = 0 Then
whprt = Left$(dnum, lsplt)
fprt = Right$(dnum, rsplt)
End If
If flg = 1 And flg2 = 1 Then
whprt = "0000"
fprt = Right$(dnum, rsplt)
lsplt = 4
End If
gttl = "0"
qmlt = "1"
mlt = dbase
If flg = 0 Then whprt = dnum
While lsplt > 0
zee = Right$(whprt, 4)
gttl = mr$(gttl, "+", mr$(zee, "*", qmlt))
qmlt = mr$(qmlt, "*", mlt)
lsplt = lsplt - 4
whprt = Left$(whprt, lsplt)
Wend
pres = Int((Log(Val(dbase)) * Int(rsplt / 4)) / Log(Val(oput)))
qmlt = "1"
Rem wqs&& = 1 to pres&&
qmlt = mr(qmlt, "/", dbase)
While rsplt >= 4
zee = Left$(fprt, 4)
gttl = mr(gttl, "+", mr(zee, "*", qmlt))
qmlt = mr(qmlt, "/", dbase)
rsplt = rsplt - 4
fprt = Right$(fprt, rsplt)
Wend
Print "base ten value: "; gttl
'$Include: 'z:\StringMath.bm'
The issue? You're not including the library into the program so there's no Function MR$.
Look at your last line in the code where the Include is. It's not formatted properly.
As for that not-so-mysterious ",1", that's what you see when trying to parse a string as a number.
Without the Function Mr$, the code thinks Mr$(foo, flop, flip) is an ARRAY and it expects foo, flop, and flip to be indexes to that array. Instead, you're passing it a string through foo and that errors out.
Just like this:
Code: (Select All)
foo = "a"
The error reads:.... casued by foo = "a", 1
That comma 1 is the length of that string.
So that error line of yours... GTTL = Mr$(GTTL, "+", 1,....
That , 1 refers to the size of the string in quotes. { "+", 1 } <-- those two items go together when being parsed internally, so we track the absolute size of a quote, unlike C which would have it CHR$(0)/null terminated.
Posts: 3,016
Threads: 357
Joined: Apr 2022
Reputation:
282
One more thing of note... Take a look at the screenshot you provided above.
Notice how there's spaces between each entry and the commas? That helps show that each of those are separate arguments...
... with a couple exceptions:
"+",1
"*",1
No spaces in there, so those are viewed and processed as single statements. 
Just a little trick/tip which I thought you might find interesting for future observations in those type error messages. 
Posts: 4,138
Threads: 190
Joined: Apr 2022
Reputation:
261
Oh so it wasn't reading the include line because missing ' at start, sheez!
Thanks, yeah runs Dragoncat's code from my library StringMath.BM.
b = b + ...
Posts: 3,016
Threads: 357
Joined: Apr 2022
Reputation:
282
Option Explicit would've caught this for you, easily.
Posts: 4,138
Threads: 190
Joined: Apr 2022
Reputation:
261
Sorry a bit distracted these days since my mother passed. Have to find new place to live and sell where I'm at meantime I'm dealing with chronic UTI's from rare fistula, literally a PITA!
b = b + ...
|
