Code: (Select All)
Option _Explicit
Screen _NewImage(800, 600, 32)
Print "&HFFFF~% unsigned integer:"; String.HBO.ToDecimal("&HFFFF~%"), Val("&HFFFF~%"), &HFFFF~%
Print "&HFFFF% integer: "; String.HBO.ToDecimal("&HFFFF%"), Val("&HFFFF%"), &HFFFF%
Print "&HFFFF~%% unsigned byte: "; String.HBO.ToDecimal("&HFFFF~%%"), Val("&HFFFF~%%"), &HFFFF~%%
Print "&HFFFF%% byte: "; String.HBO.ToDecimal("&HFFFF%%"), Val("&HFFFF%%"), "overflow" '&HFFFF%%
Print "&HFFFF no suffix: "; String.HBO.ToDecimal("&HFFFF"), Val("&HFFFF"), &HFFFF
Print
Print "&HFFFF%% &HAA -&B0101&"
Print String.HBO.ToDecimal("&HFFFF%% &HAA -&B0101&")
Function String.HBO.ToDecimal$ (in As String) 'Convert Hex, Binary, Oct
Dim As String temp, vc, m, t
Dim As Long finished, Cpos, EndPos
Dim ub As _Unsigned _Bit, b As _Bit
Dim ubyte As _Unsigned _Byte, byte As _Byte
Dim ui As _Unsigned Integer, i As Integer
Dim ul As _Unsigned Long, l As Long
Dim ui64 As _Unsigned _Integer64, i64 As _Integer64
temp = _Trim$(UCase$(in))
Do
finished = -1
Cpos = String.Find(temp, "&H", 1)
If Cpos Then '&H located
EndPos = 2: finished = 0
vc = "01234567889ABCDEF": GoSub endposition 'get the hex characters
GoSub typesymbol
temp = Left$(temp, Cpos - 1) + " " + m + Mid$(temp, Cpos + EndPos)
End If
Cpos = String.Find(temp, "&B", 1)
If Cpos Then '&B located
EndPos = 2: finished = 0
vc = "01": GoSub endposition 'get the binary characters
GoSub typesymbol
temp = Left$(temp, Cpos - 1) + " " + m + Mid$(temp, Cpos + EndPos)
End If
Cpos = String.Find(temp, "&O", 1)
If Cpos Then '&O located
EndPos = 2: finished = 0
vc = "01234567": GoSub endposition 'get the octal characters
GoSub typesymbol
temp = Left$(temp, Cpos - 1) + " " + m + Mid$(temp, Cpos + EndPos)
End If
Loop Until finished
String.HBO.ToDecimal = temp
Exit Function
endposition:
Do
m = Mid$(temp, Cpos + EndPos, 1)
If m = "" Then Exit Do
If InStr(vc, m) Then EndPos = EndPos + 1 Else Exit Do
Loop
Return
typesymbol:
Dim datatype As Long
t = Left$(Mid$(temp, Cpos + EndPos, 3) + " ", 3)
m = Mid$(temp, Cpos, EndPos)
If Left$(t, 1) = "~" Then 'unsigned
t = Mid$(t, 2) 'unsigned + 2 characters to the right for identification
Select Case Left$(t, 1)
Case "`": ub = Val(m): m = _ToStr$(ub): EndPos = EndPos + 2 'bit
Case "%" 'integer or byte
Select Case Right$(t, 1)
Case "%": ubyte = Val(m): m = _ToStr$(ubyte): EndPos = EndPos + 3 'byte
Case Else: ui = Val(m): m = _ToStr$(ui): EndPos = EndPos + 2 'integer
End Select
Case "&" 'long or integer64
Select Case Right$(t, 1)
Case "&": ui64 = Val(m): m = _ToStr$(ui64): EndPos = EndPos + 3 'integer64
Case Else: ul = Val(m): m = _ToStr$(ul): EndPos = EndPos + 2 'long
End Select
End Select
Else
t = Left$(t, 2)
Select Case Left$(t, 1)
Case "`": b = Val(m): m = _ToStr$(b): EndPos = EndPos + 1 'bit
Case "%" 'integer or byte
Select Case Right$(t, 1)
Case "%": byte = Val(m): m = _ToStr$(byte): EndPos = EndPos + 2 'integer
Case Else: i = Val(m): m = _ToStr$(i): EndPos = EndPos + 1 'byte
End Select
Case "&" 'long or integer64
Select Case Right$(t, 1)
Case "&": i64 = Val(m): m = _ToStr$(i64): EndPos = EndPos + 2 'integer64
Case Else: l = Val(m): m = _ToStr$(l): EndPos = EndPos + 1 'long
End Select
Case Else
Select Case Len(m)
Case Is <= 6: i = Val(m): m = _ToStr$(i)
Case Is <= 10: l = Val(m): m = _ToStr$(l)
Case Else: i64 = Val(m): m = _ToStr$(i64)
End Select
End Select
End If
Return
End Function
Function String.Find& (Content As String, Search As String, CountTo As Long)
'If CountTo is 0, this routine will count the number of instances of the search term inside the content string
'If CountTo is >0, this routine will find the position of that instance, if it exists, inside the search string.
'For example, CountTo = 2, it'll find the location of the 2nd instance of the search term, skipping the first.
If CountTo < 0 _OrElse Search$ = "" Then Exit Function 'Can't find a negative position.
Dim As Long p, l, count
p = InStr(Content$, Search$)
l = Len(Search$)
Do While p& > 0
count = count + 1
If CountTo = count Then String.Find = p: Exit Function
p = InStr(p + l, Content$, Search$)
Loop
If CountTo = 0 Then String.Find = count
End Function
Function String.Replace$ (content$, from$, to$)
'Inspired by the forum post here: https://qb64phoenix.com/forum/showthread...9#pid33559
'Original credit goes to mdijkens as I just tweaked it a little to make it a bit more library friendly
$Checking:Off
If from$ = "" _OrElse content$ = "" Then Exit Function 'can't replace nothing
Dim As Long mp, pp, found, flen, tlen, p
Dim m As _MEM, content2 As String
found = String.Find(content$, from$, 0)
flen = Len(from$): tlen = Len(to$)
m = _MemNew(Len(content$) + (tlen& - flen&) * found): mp = 0: pp = 1
p = InStr(content$, from$)
Do While p > 0
_MemPut m, m.OFFSET + mp, Mid$(content$, pp, p - pp): mp = mp + p - pp
_MemPut m, m.OFFSET + mp, to$: mp = mp + tlen: pp = p + flen
p = InStr(p + flen, content$, from$)
Loop
_MemPut m, m.OFFSET + mp, Mid$(content$, pp): mp = mp + Len(Mid$(content$, pp))
content2 = Space$(mp): _MemGet m, m.OFFSET, content2: _MemFree m
String.Replace$ = content2
$Checking:On
End Function
If you guys weren't aware, VAL has some issues with &H, &B, &O.
The values are always unsigned, whereas QB45 and QB64 defaults to signed values unless specified.
And the above leads to a second issue as VAL ignores any type symbols, and *only* returns unsigned values.
So I've plugged around and made my own little HBO string conversion routine. This *should* return the same values for us as if we typed them into the IDE directly.
&HFFFF = -1.... not 65535. (If you want 65535, then add the unsigned suffix or designate it as a long/int64.)
I'm not certain who else might need something like this, but for parsing strings and trying to make results match, this is an essential tool.
&HFFFF - 1 <--- This should equal -2.
Code: (Select All)
Print &HFFFF - 1
Print Val("&HFFFF") - 1
If you run the little snippet above, you'll see that it prints -2... but VAL prints 65534. If you're trying to process a string, your math is going to be wrong using VAL. It *shouldn't* be with this routine. This should return the same value you'd get if you typed the result into the IDE directly.
I don't swear it works 100% in all cases until I can test it more, but it seems to hold up and do as it should with the minor testing I've tried so far.
VAL and &H, &B, &O has just about murdered me this last few days. I'm glad to get this replacement sorted out for my own use, even if nobody else in the world ever makes use of it.
