[RESOLVED] Can VB6 simulate high-precision math calculations like a 64-bit app?
I know that a 64-bit app can perform high-precision mathematical calculations. As a 32-bit app, does VB6 have special methods to simulate high-precision mathematical calculations?
Code:
Const PI = 3.14159265358979323846264338327950288419716939937510582097494459
Re: Can VB6 simulate high-precision math calculations like a 64-bit app?
I asked Microsoft CoPilot your question.
Quick Answer
Yes — VB6 can do higher precision math, but not magically because it’s 32 bit.
You must either use the Variant/Decimal or Currency types for more precision,
or call external code (DLLs/COM/.NET) or implement arbitrary precision routines yourself.
Each approach has trade offs in precision, speed, and ease of use.
Re: Can VB6 simulate high-precision math calculations like a 64-bit app?
Being 64bit doesn't inherently mean more precision. Look at VBA-- you can do whole number stuff with an 8-byte int but you don't automatically get something like a 16 byte floating point, just that and the same Decimal-in-Variant vb6 has.
tB has Decimal as a full datatype no Variant required, but using it in 32bit is no less precise than 64.
Either of those should do the trick, as they both implement the IEEE 754 (128 bit) floats, and have versions that run on 32-bit Windows. However, you'll probably need to pass a string or a UDT to them to get/receive the 128 bit numbers. And printing them is yet another problem, but those libraries may have a function for creating ASCII formatted strings out of them as well.
Not sure how much precision you're looking for, but computers are ALWAYS limited in precisions based on how much memory you allow for your numbers. And the bitness of the OS really has very little to do with it. That's just a measure of the hardware memory-to-CPU bus size. If the CPU is moving more memory than the bus size, it just takes several 'swipes'.
Last edited by Elroy; Feb 15th, 2026 at 09:54 AM.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Re: Can VB6 simulate high-precision math calculations like a 64-bit app?
Originally Posted by Joe Caverly
I asked Microsoft CoPilot your question.
Quick Answer
Yes — VB6 can do higher precision math, but not magically because it’s 32 bit.
You must either use the Variant/Decimal or Currency types for more precision,
or call external code (DLLs/COM/.NET) or implement arbitrary precision routines yourself.
Each approach has trade offs in precision, speed, and ease of use.
Re: Can VB6 simulate high-precision math calculations like a 64-bit app?
Originally Posted by fafalone
Being 64bit doesn't inherently mean more precision. Look at VBA-- you can do whole number stuff with an 8-byte int but you don't automatically get something like a 16 byte floating point, just that and the same Decimal-in-Variant vb6 has.
tB has Decimal as a full datatype no Variant required, but using it in 32bit is no less precise than 64.
Thank you, fafalone. I just tested PI with 62 decimal places in tB:
In MyModule.bas, you can define PI with 62 decimal places, but in actual calculations, the precision provided by tB is only 14 decimal places.
Either of those should do the trick, as they both implement the IEEE 754 (128 bit) floats, and have versions that run on 32-bit Windows. However, you'll probably need to pass a string or a UDT to them to get/receive the 128 bit numbers. And printing them is yet another problem, but those libraries may have a function for creating ASCII formatted strings out of them as well.
Not sure how much precision you're looking for, but computers are ALWAYS limited in precisions based on how much memory you allow for your numbers. And the bitness of the OS really has very little to do with it. That's just a measure of the hardware memory-to-CPU bus size. If the CPU is moving more memory than the bus size, it just takes several 'swipes'.
Thank you for the information, Elroy.
I need to calculate numbers with 62 decimal places.
Code:
Const PI = 3.14159265358979323846264338327950288419716939937510582097494459
Re: Can VB6 simulate high-precision math calculations like a 64-bit app?
when dealing with arbitrary-precision numbers I would create a class and work with arrays.
the input/output from the class is of course strings.
so a bit of work, as I need to implement all the math functions
the class will have a UDT for the digits (the byte array), a decimal-position variable (so we know the position) and if its negative
Re: Can VB6 simulate high-precision math calculations like a 64-bit app?
Originally Posted by baka
when dealing with arbitrary-precision numbers I would create a class and work with arrays.
the input/output from the class is of course strings.
so a bit of work, as I need to implement all the math functions
the class will have a UDT for the digits (the byte array), a decimal-position variable (so we know the position) and if its negative
Re: Can VB6 simulate high-precision math calculations like a 64-bit app?
Originally Posted by SearchingDataOnly
Thank you for the information, Elroy.
I need to calculate numbers with 62 decimal places.
Code:
Const PI = 3.14159265358979323846264338327950288419716939937510582097494459
You need to search for a library that will handle IEEE binary256. That will give you approximately 71 decimal digits of precision. And there are some libraries out there with software implementations of this. But I'll let you find them, as you should be doing these searches yourself anyway.
I'm quite confident you'll find a library that can be executed on a Windows 32 bit machine. And VB6 can be configured to make just about any kind of API call you run into.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Re: Can VB6 simulate high-precision math calculations like a 64-bit app?
Originally Posted by Elroy
You need to search for a library that will handle IEEE binary256. That will give you approximately 71 decimal digits of precision. And there are some libraries out there with software implementations of this. But I'll let you find them, as you should be doing these searches yourself anyway.
I'm quite confident you'll find a library that can be executed on a Windows 32 bit machine. And VB6 can be configured to make just about any kind of API call you run into.
Since Google was banned in China in 2009, it has become somewhat difficult to search for information online.
Re: Can VB6 simulate high-precision math calculations like a 64-bit app?
Created by Claude.ai
I just asked it to make a library with a Float of 256 bits
Code:
' ============================================================
' Float256.bas - 256-bit floating point engine for VB6
' Significand : 28 bytes (224 bits), binary, Sig(0)=MSB
' Header Long : bit31=Sign, bit30=NaN, bit29=ExpSign, bit0..28=Exponent
' Exponent in units of bytes (base-256)
' ============================================================
Option Explicit
' --- Header bit masks ---
Private Const SIGN_BIT As Long = &H80000000
Private Const NAN_BIT As Long = &H40000000
Private Const EXPSIGN_BIT As Long = &H20000000
Private Const EXP_MASK As Long = &H1FFFFFFF
Private Const SIG_LEN As Integer = 28
Type Float256
lHeader As Long
baSig(0 To 27) As Byte
End Type
' ==============================================================
' ADD
' ==============================================================
Public Sub F256_Add(Result As Float256, A As Float256, B As Float256)
If IsNaN(A) Or IsNaN(B) Then
F256_SetNaN Result
Exit Sub
End If
Dim lExpA As Long
Dim lExpB As Long
Dim blNegA As Boolean
Dim blNegB As Boolean
Dim iCmp As Integer
lExpA = GetExp(A)
lExpB = GetExp(B)
blNegA = IsNeg(A)
blNegB = IsNeg(B)
If blNegA = blNegB Then
' Same sign: add
If lExpA >= lExpB Then
SigAdd Result, A, B, lExpA, lExpB
Else
SigAdd Result, B, A, lExpB, lExpA
End If
If blNegA Then
Result.lHeader = Result.lHeader Or SIGN_BIT
End If
Else
' Different sign: subtract, determine larger absolute value
Dim blABigger As Boolean
If lExpA > lExpB Then
blABigger = True
ElseIf lExpA < lExpB Then
blABigger = False
Else
' Same exponent: compare significand byte by byte
Dim iSigIdx As Integer
blABigger = True ' default
For iSigIdx = 0 To SIG_LEN - 1
If A.baSig(iSigIdx) > B.baSig(iSigIdx) Then
blABigger = True
Exit For
ElseIf A.baSig(iSigIdx) < B.baSig(iSigIdx) Then
blABigger = False
Exit For
End If
Next iSigIdx
End If
If blABigger Then
SigSub Result, A, B, lExpA, lExpB
If blNegA Then Result.lHeader = Result.lHeader Or SIGN_BIT
Else
SigSub Result, B, A, lExpB, lExpA
If blNegB Then Result.lHeader = Result.lHeader Or SIGN_BIT
End If
End If
End Sub
' ==============================================================
' SUBTRACT
' ==============================================================
Public Sub F256_Subtract(Result As Float256, A As Float256, B As Float256)
If IsNaN(A) Or IsNaN(B) Then
F256_SetNaN Result
Exit Sub
End If
' Flip the sign of B and add
Dim Bx As Float256
F256_Assign Bx, B
If (Bx.lHeader And SIGN_BIT) <> 0 Then
Bx.lHeader = Bx.lHeader And Not SIGN_BIT
Else
Bx.lHeader = Bx.lHeader Or SIGN_BIT
End If
F256_Add Result, A, Bx
End Sub
' ==============================================================
' MULTIPLY
' Core: 28x28 byte multiplication -> 56 byte product
' Use Double as accumulator to avoid VB6 Long overflow
' (each cell max 28 * 255 * 255 = 1,812,450 - fits in Long,
' but cumulative after carry propagation is too large -> Double is safer)
' ==============================================================
Public Sub F256_Multiply(Result As Float256, A As Float256, B As Float256)
If IsNaN(A) Or IsNaN(B) Then
F256_SetNaN Result
Exit Sub
End If
If IsZero(A) Or IsZero(B) Then
F256_Clear Result
Exit Sub
End If
Dim blNegResult As Boolean
blNegResult = (IsNeg(A) Xor IsNeg(B))
Dim lNewExp As Long
lNewExp = GetExp(A) + GetExp(B)
' Product array: 56 cells, Double to prevent overflow
Dim daProd(0 To 55) As Double
Dim iI As Integer
Dim iJ As Integer
For iI = 0 To SIG_LEN - 1
For iJ = 0 To SIG_LEN - 1
daProd(iI + iJ + 1) = daProd(iI + iJ + 1) + _
CDbl(A.baSig(iI)) * CDbl(B.baSig(iJ))
Next iJ
Next iI
' Propagate carry from right to left
Dim dCarry As Double
Dim iK As Integer
dCarry = 0
For iK = 55 To 0 Step -1
daProd(iK) = daProd(iK) + dCarry
dCarry = Int(daProd(iK) / 256)
daProd(iK) = daProd(iK) - dCarry * 256
Next iK
' Find first non-zero position
Dim iStart As Integer
iStart = 0
Do While iStart < 56 And daProd(iStart) = 0
iStart = iStart + 1
Loop
' Copy the top SIG_LEN bytes into Result
F256_Clear Result
Dim iDst As Integer
For iDst = 0 To SIG_LEN - 1
If iStart + iDst < 56 Then
Result.baSig(iDst) = CByte(daProd(iStart + iDst))
End If
Next iDst
' Exponent correction:
' The 56-byte product has its MSB at position iStart
' Our Result holds bytes iStart through iStart+27
' The dropped bytes on the right = 56 - SIG_LEN - iStart
Dim lExpCorr As Long
lExpCorr = 56 - SIG_LEN - iStart
SetExp Result, lNewExp + lExpCorr
If blNegResult Then
Result.lHeader = Result.lHeader Or SIGN_BIT
End If
Normalize Result
End Sub
' ==============================================================
' DIVIDE
' Long division at the byte level: 28 quotient bytes
' Keep remainder in lRest array (Long, 29 elements)
' ==============================================================
Public Sub F256_Divide(Result As Float256, A As Float256, B As Float256)
If IsNaN(A) Or IsNaN(B) Or IsZero(B) Then
F256_SetNaN Result
Exit Sub
End If
If IsZero(A) Then
F256_Clear Result
Exit Sub
End If
Dim blNegResult As Boolean
blNegResult = (IsNeg(A) Xor IsNeg(B))
Dim lNewExp As Long
lNewExp = GetExp(A) - GetExp(B)
' Work with Double arrays to avoid overflow
' Dividend: 56 bytes (A left-aligned, zeros padded to the right)
Dim daRest(0 To 55) As Double ' running remainder, 1 extra for overflow
Dim daDivisor(0 To SIG_LEN - 1) As Double
Dim daQuot(0 To SIG_LEN - 1) As Double
Dim iIdx As Integer
For iIdx = 0 To SIG_LEN - 1
daRest(iIdx) = CDbl(A.baSig(iIdx))
daDivisor(iIdx) = CDbl(B.baSig(iIdx))
Next iIdx
daRest(SIG_LEN) = 0
' Trial-subtraction long division
Dim iQ As Integer
Dim dQ As Double
Dim dR0 As Double
Dim dR1 As Double
Dim dD0 As Double
Dim iIter As Integer
Dim iK As Integer
Dim dBorrow As Double
Dim dVal As Double
Dim dTest As Double
For iQ = 0 To SIG_LEN - 1
' Estimate quotient digit
dR0 = daRest(iQ)
dR1 = daRest(iQ + 1)
dD0 = daDivisor(0)
If dD0 = 0 Then
dQ = 255
Else
dQ = Int((dR0 * 256 + dR1) / dD0)
If dQ > 255 Then dQ = 255
End If
' Refine q: at most 2 corrections
For iIter = 1 To 2
' Compute remainder - q * daDivisor
dBorrow = 0
For iK = SIG_LEN - 1 To 0 Step -1
dVal = daRest(iQ + 1 + iK) - dQ * daDivisor(iK) - dBorrow
If dVal < 0 Then
dBorrow = Int((-dVal - 1) / 256) + 1
dVal = dVal + dBorrow * 256
Else
dBorrow = 0
End If
Next iK
dTest = daRest(iQ) - dBorrow
If dTest < 0 Then
dQ = dQ - 1
Else
Exit For
End If
Next iIter
daQuot(iQ) = dQ
' Subtract q * daDivisor from daRest
dBorrow = 0
For iK = SIG_LEN - 1 To 0 Step -1
dVal = daRest(iQ + 1 + iK) - dQ * daDivisor(iK) - dBorrow
If dVal < 0 Then
dBorrow = Int((-dVal - 1) / 256) + 1
dVal = dVal + dBorrow * 256
Else
dBorrow = 0
End If
daRest(iQ + 1 + iK) = dVal
Next iK
daRest(iQ) = daRest(iQ) - dBorrow
Next iQ
' Copy quotient
F256_Clear Result
For iIdx = 0 To SIG_LEN - 1
Result.baSig(iIdx) = CByte(daQuot(iIdx))
Next iIdx
SetExp Result, lNewExp
If blNegResult Then
Result.lHeader = Result.lHeader Or SIGN_BIT
End If
Normalize Result
End Sub
' ==============================================================
' FROMSTRING
' Build significand directly via byte array *10 + digit
' No Float256 objects in the inner loop
' ==============================================================
Public Sub F256_FromString(Result As Float256, sInput As String)
F256_Clear Result
Dim sTrimmed As String
sTrimmed = Trim(sInput)
If Len(sTrimmed) = 0 Then
F256_SetNaN Result
Exit Sub
End If
' Sign
Dim blNeg As Boolean
blNeg = False
If Left(sTrimmed, 1) = "-" Then
blNeg = True
sTrimmed = Mid(sTrimmed, 2)
ElseIf Left(sTrimmed, 1) = "+" Then
sTrimmed = Mid(sTrimmed, 2)
End If
' Split scientific notation (e)
Dim lDecExp As Long
lDecExp = 0
Dim iEpos As Integer
iEpos = InStr(LCase(sTrimmed), "e")
If iEpos > 0 Then
lDecExp = CLng(Mid(sTrimmed, iEpos + 1))
sTrimmed = Left(sTrimmed, iEpos - 1)
End If
' Decimal point
Dim iDotPos As Integer
iDotPos = InStr(sTrimmed, ".")
If iDotPos > 0 Then
lDecExp = lDecExp - CLng(Len(sTrimmed) - iDotPos)
sTrimmed = Left(sTrimmed, iDotPos - 1) & Mid(sTrimmed, iDotPos + 1)
End If
' Build significand: Result = Result * 10 + digit
' Fully at byte-array level, no Float256 objects
Dim iCharIdx As Integer
Dim iDigit As Integer
Dim iByteIdx As Integer
Dim lCarry As Long
Dim lProd As Long
For iCharIdx = 1 To Len(sTrimmed)
iDigit = Asc(Mid(sTrimmed, iCharIdx, 1)) - 48
If iDigit < 0 Or iDigit > 9 Then
F256_SetNaN Result
Exit Sub
End If
' Result.baSig = Result.baSig * 10
lCarry = 0
For iByteIdx = SIG_LEN - 1 To 0 Step -1
lProd = CLng(Result.baSig(iByteIdx)) * 10 + lCarry
Result.baSig(iByteIdx) = CByte(lProd And 255)
lCarry = lProd \ 256
Next iByteIdx
' Ignore lCarry overflow (loss of lowest precision)
' Result.baSig = Result.baSig + iDigit
lCarry = iDigit
For iByteIdx = SIG_LEN - 1 To 0 Step -1
lProd = CLng(Result.baSig(iByteIdx)) + lCarry
Result.baSig(iByteIdx) = CByte(lProd And 255)
lCarry = lProd \ 256
Next iByteIdx
Next iCharIdx
' Exponent is now 0, normalize
SetExp Result, 0
Normalize Result
' Apply lDecExp via direct byte-array *10 or /10
' That would require Multiply/Divide – which is NOW fast because
' the significand is already built and we are only scaling
Dim lNewExp As Long
lNewExp = GetExp(Result)
If lDecExp > 0 Then
' Multiply by 10^lDecExp via repeated *10 on the byte array
Dim lIdx As Long
For lIdx = 1 To lDecExp
lCarry = 0
For iByteIdx = SIG_LEN - 1 To 0 Step -1
lProd = CLng(Result.baSig(iByteIdx)) * 10 + lCarry
Result.baSig(iByteIdx) = CByte(lProd And 255)
lCarry = lProd \ 256
Next iByteIdx
If lCarry > 0 Then
' Overflow: shift right, increase exp
For iByteIdx = SIG_LEN - 1 To 1 Step -1
Result.baSig(iByteIdx) = Result.baSig(iByteIdx - 1)
Next iByteIdx
Result.baSig(0) = CByte(lCarry)
lNewExp = lNewExp + 1
SetExp Result, lNewExp
End If
Next lIdx
ElseIf lDecExp < 0 Then
' Divide by 10^|lDecExp| via repeated /10 on the byte array (long division)
Dim lLDecExpAbs As Long
lLDecExpAbs = -lDecExp
Dim lRest2 As Long
Dim lVal As Long
For lIdx = 1 To lLDecExpAbs
lRest2 = 0
For iByteIdx = 0 To SIG_LEN - 1
lVal = lRest2 * 256 + CLng(Result.baSig(iByteIdx))
Result.baSig(iByteIdx) = CByte(lVal \ 10)
lRest2 = lVal Mod 10
Next iByteIdx
Normalize Result
lNewExp = GetExp(Result)
Next lIdx
End If
If blNeg Then
Result.lHeader = Result.lHeader Or SIGN_BIT
End If
End Sub
' ==============================================================
' TOSTRING
' Extract decimal digits via repeated *10 on the byte array
' No Float256 objects in the inner loop
' ==============================================================
Public Function F256_ToString(F As Float256) As String
If IsNaN(F) Then
F256_ToString = "NaN"
Exit Function
End If
If IsZero(F) Then
F256_ToString = "0"
Exit Function
End If
Const DIGITS As Integer = 67 ' 224 bits * log10(2) ~ 67.4
Dim sPrefix As String
Dim baWork(0 To SIG_LEN - 1) As Byte
Dim iIdx As Integer
Dim iDig As Integer
Dim lCarry As Long
Dim lVal As Long
Dim lWorkExp As Long
Dim sDigits As String
Dim sResult As String
Dim lDecExp As Long
sPrefix = ""
If IsNeg(F) Then sPrefix = "-"
' Copy significand to work array
For iIdx = 0 To SIG_LEN - 1
baWork(iIdx) = F.baSig(iIdx)
Next iIdx
lWorkExp = GetExp(F)
' Estimate decimal exponent: lWorkExp * log10(256)
' log10(256) = 8 * log10(2) = 8 * 0.30103 = 2.40824
lDecExp = CLng(Int(CDbl(lWorkExp) * 2.40824))
' Scale to [1, 10): adjust lDecExp via *10 or /10 on baWork
' First coarse scaling using the exponent estimate
' Then fine-tune
' Bring the value to order 1 by neutralizing the exponent:
' We work with lWorkExp=0 and compensate in lDecExp
' Each left byte-shift = *256 = exponent -1 but lDecExp +log10(256)
' Simpler: extract directly via repeated *10
' Step 1: normalize work array so that baWork(0) >= 128
' (= value lies in [0.5, 1) * 256^(lWorkExp+1))
' Step 2: extract DIGITS digits via *10, take baWork(0)
' Ensure work array is normalized (leading byte non-zero)
Do While baWork(0) = 0
For iIdx = 0 To SIG_LEN - 2
baWork(iIdx) = baWork(iIdx + 1)
Next iIdx
baWork(SIG_LEN - 1) = 0
lWorkExp = lWorkExp - 1
Loop
' Now value = baWork[0..27] * 256^(lWorkExp - SIG_LEN + 1)
' We want to extract DIGITS decimal digits
' lDecExp = floor(lWorkExp * log10(256)) gives the order
' Recompute more accurately:
lDecExp = CLng(Int((CDbl(lWorkExp) + 1 - SIG_LEN) * 2.40824 + _
CDbl(SIG_LEN - 1) * 2.40824))
' Fine-tune: scale to [1,10) by looking at baWork(0)
' baWork(0) is in [1,255]; log10(baWork(0)) + lWorkExp*log10(256)
Dim dFineAdj As Double
dFineAdj = Int(Log(CDbl(baWork(0)) + 0.5) / Log(10) + _
CDbl(lWorkExp + 1 - SIG_LEN) * 2.40824 + _
CDbl(SIG_LEN - 1) * 2.40824)
lDecExp = CLng(dFineAdj)
' Scale baWork so the number lies in [1, 10)
' = multiply or divide until baWork(0) is in [0, 9] and rest non-zero
' Rescale: divide by 10 if baWork(0) >= 10, multiply by 10 if baWork(0) = 0
Dim iScale As Integer
iScale = 0
Dim lRest As Long
' Divide by 10^positive adjustment
Do While baWork(0) >= 10
lRest = 0
For iIdx = 0 To SIG_LEN - 1
lVal = lRest * 256 + CLng(baWork(iIdx))
baWork(iIdx) = CByte(lVal \ 10)
lRest = lVal Mod 10
Next iIdx
iScale = iScale + 1
Loop
' Multiply by 10 if it is too small
Do While baWork(0) = 0
lCarry = 0
For iIdx = SIG_LEN - 1 To 0 Step -1
lVal = CLng(baWork(iIdx)) * 10 + lCarry
baWork(iIdx) = CByte(lVal And 255)
lCarry = lVal \ 256
Next iIdx
iScale = iScale - 1
Loop
lDecExp = lDecExp + iScale
' Extract DIGITS digits
sDigits = ""
For iDig = 1 To DIGITS
' First byte is the digit
sDigits = sDigits & CStr(CInt(baWork(0)))
baWork(0) = 0
' Multiply by 10 for the next digit
lCarry = 0
For iIdx = SIG_LEN - 1 To 0 Step -1
lVal = CLng(baWork(iIdx)) * 10 + lCarry
baWork(iIdx) = CByte(lVal And 255)
lCarry = lVal \ 256
Next iIdx
' lCarry is the next digit (overflow to the left)
If iDig < DIGITS Then
' Shift lCarry in as new baWork(0)
If lCarry > 0 Then
For iIdx = SIG_LEN - 1 To 1 Step -1
baWork(iIdx) = baWork(iIdx - 1)
Next iIdx
baWork(0) = CByte(lCarry)
End If
End If
Next iDig
' Remove trailing zeros
Do While Len(sDigits) > 1 And Right(sDigits, 1) = "0"
sDigits = Left(sDigits, Len(sDigits) - 1)
Loop
' Format: 1.234567e+nn
If Len(sDigits) > 1 Then
sResult = Left(sDigits, 1) & "." & Mid(sDigits, 2)
Else
sResult = sDigits
End If
If lDecExp <> 0 Then
sResult = sResult & "e" & CStr(lDecExp)
End If
F256_ToString = sPrefix & sResult
End Function
' ==============================================================
' COMPARE -1 = A<B, 0 = A=B, 1 = A>B
' ==============================================================
Public Function F256_Compare(A As Float256, B As Float256) As Integer
If IsNaN(A) Or IsNaN(B) Then
F256_Compare = 0
Exit Function
End If
Dim blNegA As Boolean
Dim blNegB As Boolean
blNegA = IsNeg(A)
blNegB = IsNeg(B)
If blNegA And Not blNegB Then
F256_Compare = -1
Exit Function
End If
If Not blNegA And blNegB Then
F256_Compare = 1
Exit Function
End If
Dim lExpA As Long
Dim lExpB As Long
Dim iCmp As Integer
Dim iSig As Integer
lExpA = GetExp(A)
lExpB = GetExp(B)
If lExpA > lExpB Then
iCmp = 1
ElseIf lExpA < lExpB Then
iCmp = -1
Else
iCmp = 0
For iSig = 0 To SIG_LEN - 1
If A.baSig(iSig) > B.baSig(iSig) Then
iCmp = 1
Exit For
ElseIf A.baSig(iSig) < B.baSig(iSig) Then
iCmp = -1
Exit For
End If
Next iSig
End If
If blNegA Then iCmp = -iCmp
F256_Compare = iCmp
End Function
' ==============================================================
' ASSIGN / CLEAR / SETN??
' ==============================================================
Public Sub F256_Clear(F As Float256)
Dim iIdx As Integer
F.lHeader = 0
For iIdx = 0 To SIG_LEN - 1
F.baSig(iIdx) = 0
Next iIdx
End Sub
Public Sub F256_Assign(Dst As Float256, Src As Float256)
Dim iIdx As Integer
Dst.lHeader = Src.lHeader
For iIdx = 0 To SIG_LEN - 1
Dst.baSig(iIdx) = Src.baSig(iIdx)
Next iIdx
End Sub
Public Sub F256_SetNaN(F As Float256)
F256_Clear F
F.lHeader = NAN_BIT
End Sub
' ==============================================================
' HEADER HELPER FUNCTIONS
' ==============================================================
Private Function GetExp(F As Float256) As Long
Dim lMag As Long
lMag = F.lHeader And EXP_MASK
If (F.lHeader And EXPSIGN_BIT) <> 0 Then
GetExp = -lMag
Else
GetExp = lMag
End If
End Function
Private Sub SetExp(F As Float256, lE As Long)
Dim lKeep As Long
lKeep = F.lHeader And (SIGN_BIT Or NAN_BIT)
If lE < 0 Then
F.lHeader = lKeep Or EXPSIGN_BIT Or ((-lE) And EXP_MASK)
Else
F.lHeader = lKeep Or (lE And EXP_MASK)
End If
End Sub
Private Function IsNaN(F As Float256) As Boolean
IsNaN = (F.lHeader And NAN_BIT) <> 0
End Function
Private Function IsNeg(F As Float256) As Boolean
IsNeg = (F.lHeader And SIGN_BIT) <> 0
End Function
Private Function IsZero(F As Float256) As Boolean
Dim iIdx As Integer
For iIdx = 0 To SIG_LEN - 1
If F.baSig(iIdx) <> 0 Then Exit Function
Next iIdx
IsZero = True
End Function
' ==============================================================
' NORMALIZE
' ==============================================================
Private Sub Normalize(F As Float256)
If (F.lHeader And NAN_BIT) <> 0 Then Exit Sub
Dim iShift As Integer
iShift = 0
Do While iShift < SIG_LEN - 1
If F.baSig(iShift) <> 0 Then Exit Do
iShift = iShift + 1
Loop
If F.baSig(iShift) = 0 Then
' Number is zero
F.lHeader = 0
Exit Sub
End If
If iShift = 0 Then Exit Sub
Dim iDst As Integer
For iDst = 0 To SIG_LEN - 1 - iShift
F.baSig(iDst) = F.baSig(iDst + iShift)
Next iDst
For iDst = SIG_LEN - iShift To SIG_LEN - 1
F.baSig(iDst) = 0
Next iDst
Dim lE As Long
lE = GetExp(F) - iShift
SetExp F, lE
End Sub
' ==============================================================
' INTERNAL SIGADD (requires expA >= expB)
' ==============================================================
Private Sub SigAdd(Result As Float256, A As Float256, B As Float256, _
lExpA As Long, lExpB As Long)
Dim lDiff As Long
Dim iIdx As Integer
Dim iBIdx As Integer
Dim lSum As Long
Dim lCarry As Long
lDiff = lExpA - lExpB
If lDiff >= SIG_LEN Then
F256_Assign Result, A
Exit Sub
End If
F256_Clear Result
lCarry = 0
For iIdx = SIG_LEN - 1 To 0 Step -1
iBIdx = iIdx - CInt(lDiff)
If iBIdx >= 0 Then
lSum = CLng(A.baSig(iIdx)) + CLng(B.baSig(iBIdx)) + lCarry
Else
lSum = CLng(A.baSig(iIdx)) + lCarry
End If
If lSum >= 256 Then
Result.baSig(iIdx) = CByte(lSum - 256)
lCarry = 1
Else
Result.baSig(iIdx) = CByte(lSum)
lCarry = 0
End If
Next iIdx
SetExp Result, lExpA
If lCarry > 0 Then
For iIdx = SIG_LEN - 1 To 1 Step -1
Result.baSig(iIdx) = Result.baSig(iIdx - 1)
Next iIdx
Result.baSig(0) = 1
SetExp Result, lExpA + 1
End If
End Sub
' ==============================================================
' INTERNAL SIGSUB (requires |A| >= |B|, expA >= expB)
' ==============================================================
Private Sub SigSub(Result As Float256, A As Float256, B As Float256, _
lExpA As Long, lExpB As Long)
Dim lDiff As Long
Dim iIdx As Integer
Dim iBIdx As Integer
Dim lBVal As Long
Dim lSub As Long
Dim lBorrow As Long
lDiff = lExpA - lExpB
If lDiff >= SIG_LEN Then
F256_Assign Result, A
Exit Sub
End If
F256_Clear Result
lBorrow = 0
For iIdx = SIG_LEN - 1 To 0 Step -1
iBIdx = iIdx - CInt(lDiff)
If iBIdx >= 0 Then
lBVal = CLng(B.baSig(iBIdx))
Else
lBVal = 0
End If
lSub = CLng(A.baSig(iIdx)) - lBVal - lBorrow
If lSub < 0 Then
Result.baSig(iIdx) = CByte(lSub + 256)
lBorrow = 1
Else
Result.baSig(iIdx) = CByte(lSub)
lBorrow = 0
End If
Next iIdx
SetExp Result, lExpA
Normalize Result
End Sub
Re: Can VB6 simulate high-precision math calculations like a 64-bit app?
Tester:
Code:
Sub TestFloat256()
Dim A As Float256, B As Float256, C As Float256
F256_FromString A, "1.23456789012345678901234567890123456789012345678901234567890123e50"
F256_FromString B, "9.87654321098765432109876543210987654321098765432109876543210987e49"
F256_Add C, A, B
Me.Print "A + B = " & F256_ToString(C)
F256_Multiply C, A, B
Me.Print "A * B = " & F256_ToString(C)
F256_Divide C, A, B
Me.Print "A / B = " & F256_ToString(C)
F256_Subtract C, A, B
Me.Print "A - B = " & F256_ToString(C)
End Sub
Re: Can VB6 simulate high-precision math calculations like a 64-bit app?
I try this simple code:
Code:
Dim x As Float256
Dim y As Float256
Dim r As Float256
F256_FromString x, "3.14159265358979323846264338327950288419716939937510582097494459"
F256_FromString y, "2"
F256_Multiply r, x, y
Debug.Print F256_ToString(r)
And the result was: 6.283185307179586476925286766559005768394338798750211641949889176931e-65
The mantissa is ok, but the exponent must be 0, I think
Re: Can VB6 simulate high-precision math calculations like a 64-bit app?
Fixed by Copilot
A problem in ToString and the Divide method Part 1
Code:
' ============================================================
' Float256.bas - 256-bit floating point engine for VB6
' Significand : 28 bytes (224 bits), binary, Sig(0)=MSB
' Header Long : bit31=Sign, bit30=NaN, bit29=ExpSign, bit0..28=Exponent
' Exponent in units of bytes (base-256)
' ============================================================
Option Explicit
' --- Header bit masks ---
Private Const SIGN_BIT As Long = &H80000000
Private Const NAN_BIT As Long = &H40000000
Private Const EXPSIGN_BIT As Long = &H20000000
Private Const EXP_MASK As Long = &H1FFFFFFF
Private Const SIG_LEN As Integer = 28
Type Float256
lHeader As Long
baSig(0 To 27) As Byte
End Type
' ==============================================================
' ADD
' ==============================================================
Public Sub F256_Add(Result As Float256, A As Float256, B As Float256)
If IsNaN(A) Or IsNaN(B) Then
F256_SetNaN Result
Exit Sub
End If
Dim lExpA As Long
Dim lExpB As Long
Dim blNegA As Boolean
Dim blNegB As Boolean
lExpA = GetExp(A)
lExpB = GetExp(B)
blNegA = IsNeg(A)
blNegB = IsNeg(B)
If blNegA = blNegB Then
' Same sign: add
If lExpA >= lExpB Then
SigAdd Result, A, B, lExpA, lExpB
Else
SigAdd Result, B, A, lExpB, lExpA
End If
If blNegA Then
Result.lHeader = Result.lHeader Or SIGN_BIT
End If
Else
' Different sign: subtract, determine larger absolute value
Dim blABigger As Boolean
If lExpA > lExpB Then
blABigger = True
ElseIf lExpA < lExpB Then
blABigger = False
Else
' Same exponent: compare significand byte by byte
Dim iSigIdx As Integer
blABigger = True ' default
For iSigIdx = 0 To SIG_LEN - 1
If A.baSig(iSigIdx) > B.baSig(iSigIdx) Then
blABigger = True
Exit For
ElseIf A.baSig(iSigIdx) < B.baSig(iSigIdx) Then
blABigger = False
Exit For
End If
Next iSigIdx
End If
If blABigger Then
SigSub Result, A, B, lExpA, lExpB
If blNegA Then Result.lHeader = Result.lHeader Or SIGN_BIT
Else
SigSub Result, B, A, lExpB, lExpA
If blNegB Then Result.lHeader = Result.lHeader Or SIGN_BIT
End If
End If
End Sub
' ==============================================================
' SUBTRACT
' ==============================================================
Public Sub F256_Subtract(Result As Float256, A As Float256, B As Float256)
If IsNaN(A) Or IsNaN(B) Then
F256_SetNaN Result
Exit Sub
End If
' Flip the sign of B and add
Dim Bx As Float256
F256_Assign Bx, B
If (Bx.lHeader And SIGN_BIT) <> 0 Then
Bx.lHeader = Bx.lHeader And Not SIGN_BIT
Else
Bx.lHeader = Bx.lHeader Or SIGN_BIT
End If
F256_Add Result, A, Bx
End Sub
' ==============================================================
' MULTIPLY
' Core: 28x28 byte multiplication -> 56 byte product
' Use Double as accumulator to avoid VB6 Long overflow
' (each cell max 28 * 255 * 255 = 1,812,450 - fits in Long,
' but cumulative after carry propagation is too large -> Double is safer)
' ==============================================================
Public Sub F256_Multiply(Result As Float256, A As Float256, B As Float256)
If IsNaN(A) Or IsNaN(B) Then
F256_SetNaN Result
Exit Sub
End If
If IsZero(A) Or IsZero(B) Then
F256_Clear Result
Exit Sub
End If
Dim blNegResult As Boolean
blNegResult = (IsNeg(A) Xor IsNeg(B))
Dim lNewExp As Long
lNewExp = GetExp(A) + GetExp(B)
' Product array: 56 cells, Double to prevent overflow
Dim daProd(0 To 55) As Double
Dim iI As Integer
Dim iJ As Integer
For iI = 0 To SIG_LEN - 1
For iJ = 0 To SIG_LEN - 1
daProd(iI + iJ + 1) = daProd(iI + iJ + 1) + _
CDbl(A.baSig(iI)) * CDbl(B.baSig(iJ))
Next iJ
Next iI
' Propagate carry from right to left
Dim dCarry As Double
Dim iK As Integer
dCarry = 0
For iK = 55 To 0 Step -1
daProd(iK) = daProd(iK) + dCarry
dCarry = Int(daProd(iK) / 256)
daProd(iK) = daProd(iK) - dCarry * 256
Next iK
' Find first non-zero position
Dim iStart As Integer
iStart = 0
Do While iStart < 56 And daProd(iStart) = 0
iStart = iStart + 1
Loop
' Copy the top SIG_LEN bytes into Result
F256_Clear Result
Dim iDst As Integer
For iDst = 0 To SIG_LEN - 1
If iStart + iDst < 56 Then
Result.baSig(iDst) = CByte(daProd(iStart + iDst))
End If
Next iDst
' Exponent correction:
' The 56-byte product has its MSB at position iStart
' Our Result holds bytes iStart through iStart+27
' The dropped bytes on the right = 56 - SIG_LEN - iStart
Dim lExpCorr As Long
lExpCorr = 56 - SIG_LEN - iStart
SetExp Result, lNewExp + lExpCorr
If blNegResult Then
Result.lHeader = Result.lHeader Or SIGN_BIT
End If
Normalize Result
End Sub
' ==============================================================
' DIVIDE
' Long division at the byte level: 28 quotient bytes
' Keep remainder in lRest array (Long, 29 elements)
Public Sub F256_Divide(Result As Float256, A As Float256, B As Float256)
' Robuuste 28-cijferige (base-256) lange deling met binaire zoek per quotiëntbyte.
' Belangrijke punten:
' - Exponentcorrectie: we delen effectief (M_A * 256^28) / M_B => exponent moet -28
' - Binaire zoek op q ? [0..255]: garandeert q * D = R op elk stapje
' - Zelfde borrow-logica als je Multiply/Divide tot nu toe
If IsNaN(A) Or IsNaN(B) Or IsZero(B) Then
F256_SetNaN Result
Exit Sub
End If
If IsZero(A) Then
F256_Clear Result
Exit Sub
End If
Dim blNegResult As Boolean
blNegResult = (IsNeg(A) Xor IsNeg(B))
' *** Cruciale exponentfix: -SIG_LEN (28) ***
Dim lNewExp As Long
lNewExp = GetExp(A) - GetExp(B) - SIG_LEN
' Resterende bytes: 56 cellen voor remainder-venster
Dim daRest(0 To 55) As Double
Dim daDivisor(0 To SIG_LEN - 1) As Double
Dim daQuot(0 To SIG_LEN - 1) As Double
Dim iIdx As Integer
' Remainder start met A.baSig links-uitgelijnd en daarachter nullen
For iIdx = 0 To SIG_LEN - 1
daRest(iIdx) = CDbl(A.baSig(iIdx))
daDivisor(iIdx) = CDbl(B.baSig(iIdx))
Next iIdx
For iIdx = SIG_LEN To 55
daRest(iIdx) = 0
Next iIdx
Dim iQ As Integer
Dim lo As Integer, hi As Integer, mid As Integer, bestQ As Integer
Dim dBorrow As Double, dVal As Double
' 28 quotiëntbytes bepalen
For iQ = 0 To SIG_LEN - 1
' Binaire zoek naar maximale q waarvoor q * divisor <= remainder-venster
lo = 0: hi = 255: bestQ = 0
Do While lo <= hi
mid = (lo + hi) \ 2
If DivTryQ(daRest, daDivisor, iQ, mid) Then
bestQ = mid
lo = mid + 1
Else
hi = mid - 1
End If
Loop
daQuot(iQ) = bestQ
' Werkelijke subtractie: remainder -= bestQ * divisor (met borrow over base-256)
dBorrow = 0
For iIdx = SIG_LEN - 1 To 0 Step -1
dVal = daRest(iQ + 1 + iIdx) - CDbl(bestQ) * daDivisor(iIdx) - dBorrow
If dVal < 0 Then
dBorrow = Int((-dVal - 1) / 256) + 1 ' ceil((-dVal)/256)
dVal = dVal + dBorrow * 256
Else
dBorrow = 0
End If
daRest(iQ + 1 + iIdx) = dVal
Next iIdx
daRest(iQ) = daRest(iQ) - dBorrow
Next iQ
' Quotiënt naar Result kopiëren
F256_Clear Result
For iIdx = 0 To SIG_LEN - 1
Result.baSig(iIdx) = CByte(daQuot(iIdx))
Next iIdx
SetExp Result, lNewExp
If blNegResult Then
Result.lHeader = Result.lHeader Or SIGN_BIT
End If
Normalize Result
End Sub
' Helper: test of q * daDivisor <= daRest-venster op positie iQ (zonder daRest te wijzigen)
Private Function DivTryQ(ByRef daRest() As Double, _
ByRef daDivisor() As Double, _
ByVal iQ As Integer, _
ByVal q As Integer) As Boolean
Dim dBorrow As Double, dVal As Double
Dim iIdx As Integer
dBorrow = 0
For iIdx = SIG_LEN - 1 To 0 Step -1
dVal = daRest(iQ + 1 + iIdx) - CDbl(q) * daDivisor(iIdx) - dBorrow
If dVal < 0 Then
dBorrow = Int((-dVal - 1) / 256) + 1 ' ceil((-dVal)/256)
Else
dBorrow = 0
End If
Next iIdx
DivTryQ = (daRest(iQ) - dBorrow >= 0)
End Function
' ==============================================================
' FROMSTRING
' Build significand directly via byte array *10 + digit
' No Float256 objects in the inner loop
' ==============================================================
Public Sub F256_FromString(Result As Float256, sInput As String)
F256_Clear Result
Dim sTrimmed As String
sTrimmed = Trim(sInput)
If Len(sTrimmed) = 0 Then
F256_SetNaN Result
Exit Sub
End If
' Sign
Dim blNeg As Boolean
blNeg = False
If Left(sTrimmed, 1) = "-" Then
blNeg = True
sTrimmed = mid(sTrimmed, 2)
ElseIf Left(sTrimmed, 1) = "+" Then
sTrimmed = mid(sTrimmed, 2)
End If
' Split scientific notation (e)
Dim lDecExp As Long
lDecExp = 0
Dim iEpos As Integer
iEpos = InStr(LCase(sTrimmed), "e")
If iEpos > 0 Then
lDecExp = CLng(mid(sTrimmed, iEpos + 1))
sTrimmed = Left(sTrimmed, iEpos - 1)
End If
' Decimal point
Dim iDotPos As Integer
iDotPos = InStr(sTrimmed, ".")
If iDotPos > 0 Then
lDecExp = lDecExp - CLng(Len(sTrimmed) - iDotPos)
sTrimmed = Left(sTrimmed, iDotPos - 1) & mid(sTrimmed, iDotPos + 1)
End If
' Build significand: Result = Result * 10 + digit
' Fully at byte-array level, no Float256 objects
Dim iCharIdx As Integer
Dim iDigit As Integer
Dim iByteIdx As Integer
Dim lCarry As Long
Dim lProd As Long
For iCharIdx = 1 To Len(sTrimmed)
iDigit = Asc(mid(sTrimmed, iCharIdx, 1)) - 48
If iDigit < 0 Or iDigit > 9 Then
F256_SetNaN Result
Exit Sub
End If
' Result.baSig = Result.baSig * 10
lCarry = 0
For iByteIdx = SIG_LEN - 1 To 0 Step -1
lProd = CLng(Result.baSig(iByteIdx)) * 10 + lCarry
Result.baSig(iByteIdx) = CByte(lProd And 255)
lCarry = lProd \ 256
Next iByteIdx
' Ignore lCarry overflow (loss of lowest precision)
' Result.baSig = Result.baSig + iDigit
lCarry = iDigit
For iByteIdx = SIG_LEN - 1 To 0 Step -1
lProd = CLng(Result.baSig(iByteIdx)) + lCarry
Result.baSig(iByteIdx) = CByte(lProd And 255)
lCarry = lProd \ 256
Next iByteIdx
Next iCharIdx
' Exponent is now 0, normalize
SetExp Result, 0
Normalize Result
' Apply lDecExp via direct byte-array *10 or /10
' That would require Multiply/Divide – which is NOW fast because
' the significand is already built and we are only scaling
Dim lNewExp As Long
lNewExp = GetExp(Result)
If lDecExp > 0 Then
' Multiply by 10^lDecExp via repeated *10 on the byte array
Dim lIdx As Long
For lIdx = 1 To lDecExp
lCarry = 0
For iByteIdx = SIG_LEN - 1 To 0 Step -1
lProd = CLng(Result.baSig(iByteIdx)) * 10 + lCarry
Result.baSig(iByteIdx) = CByte(lProd And 255)
lCarry = lProd \ 256
Next iByteIdx
If lCarry > 0 Then
' Overflow: shift right, increase exp
For iByteIdx = SIG_LEN - 1 To 1 Step -1
Result.baSig(iByteIdx) = Result.baSig(iByteIdx - 1)
Next iByteIdx
Result.baSig(0) = CByte(lCarry)
lNewExp = lNewExp + 1
SetExp Result, lNewExp
End If
Next lIdx
ElseIf lDecExp < 0 Then
' Divide by 10^|lDecExp| via repeated /10 on the byte array (long division)
Dim lLDecExpAbs As Long
lLDecExpAbs = -lDecExp
Dim lRest2 As Long
Dim lVal As Long
For lIdx = 1 To lLDecExpAbs
lRest2 = 0
For iByteIdx = 0 To SIG_LEN - 1
lVal = lRest2 * 256 + CLng(Result.baSig(iByteIdx))
Result.baSig(iByteIdx) = CByte(lVal \ 10)
lRest2 = lVal Mod 10
Next iByteIdx
Normalize Result
lNewExp = GetExp(Result)
Next lIdx
End If
If blNeg Then
Result.lHeader = Result.lHeader Or SIGN_BIT
End If
End Sub
Last edited by Arnoutdv; Feb 17th, 2026 at 09:03 AM.
Re: Can VB6 simulate high-precision math calculations like a 64-bit app?
Part 2
Code:
' ==============================================================
' COMPARE -1 = A<B, 0 = A=B, 1 = A>B
' ==============================================================
Public Function F256_Compare(A As Float256, B As Float256) As Integer
If IsNaN(A) Or IsNaN(B) Then
F256_Compare = 0
Exit Function
End If
Dim blNegA As Boolean
Dim blNegB As Boolean
blNegA = IsNeg(A)
blNegB = IsNeg(B)
If blNegA And Not blNegB Then
F256_Compare = -1
Exit Function
End If
If Not blNegA And blNegB Then
F256_Compare = 1
Exit Function
End If
Dim lExpA As Long
Dim lExpB As Long
Dim iCmp As Integer
Dim iSig As Integer
lExpA = GetExp(A)
lExpB = GetExp(B)
If lExpA > lExpB Then
iCmp = 1
ElseIf lExpA < lExpB Then
iCmp = -1
Else
iCmp = 0
For iSig = 0 To SIG_LEN - 1
If A.baSig(iSig) > B.baSig(iSig) Then
iCmp = 1
Exit For
ElseIf A.baSig(iSig) < B.baSig(iSig) Then
iCmp = -1
Exit For
End If
Next iSig
End If
If blNegA Then iCmp = -iCmp
F256_Compare = iCmp
End Function
' ==============================================================
' ASSIGN / CLEAR / SETN??
' ==============================================================
Public Sub F256_Clear(F As Float256)
Dim iIdx As Integer
F.lHeader = 0
For iIdx = 0 To SIG_LEN - 1
F.baSig(iIdx) = 0
Next iIdx
End Sub
Public Sub F256_Assign(Dst As Float256, Src As Float256)
Dim iIdx As Integer
Dst.lHeader = Src.lHeader
For iIdx = 0 To SIG_LEN - 1
Dst.baSig(iIdx) = Src.baSig(iIdx)
Next iIdx
End Sub
Public Sub F256_SetNaN(F As Float256)
F256_Clear F
F.lHeader = NAN_BIT
End Sub
' ==============================================================
' HEADER HELPER FUNCTIONS
' ==============================================================
Private Function GetExp(F As Float256) As Long
Dim lMag As Long
lMag = F.lHeader And EXP_MASK
If (F.lHeader And EXPSIGN_BIT) <> 0 Then
GetExp = -lMag
Else
GetExp = lMag
End If
End Function
Private Sub SetExp(F As Float256, lE As Long)
Dim lKeep As Long
lKeep = F.lHeader And (SIGN_BIT Or NAN_BIT)
If lE < 0 Then
F.lHeader = lKeep Or EXPSIGN_BIT Or ((-lE) And EXP_MASK)
Else
F.lHeader = lKeep Or (lE And EXP_MASK)
End If
End Sub
Private Function IsNaN(F As Float256) As Boolean
IsNaN = (F.lHeader And NAN_BIT) <> 0
End Function
Private Function IsNeg(F As Float256) As Boolean
IsNeg = (F.lHeader And SIGN_BIT) <> 0
End Function
Private Function IsZero(F As Float256) As Boolean
Dim iIdx As Integer
For iIdx = 0 To SIG_LEN - 1
If F.baSig(iIdx) <> 0 Then Exit Function
Next iIdx
IsZero = True
End Function
' ==============================================================
' NORMALIZE
' ==============================================================
Private Sub Normalize(F As Float256)
If (F.lHeader And NAN_BIT) <> 0 Then Exit Sub
Dim iShift As Integer
iShift = 0
Do While iShift < SIG_LEN - 1
If F.baSig(iShift) <> 0 Then Exit Do
iShift = iShift + 1
Loop
If F.baSig(iShift) = 0 Then
' Number is zero
F.lHeader = 0
Exit Sub
End If
If iShift = 0 Then Exit Sub
Dim iDst As Integer
For iDst = 0 To SIG_LEN - 1 - iShift
F.baSig(iDst) = F.baSig(iDst + iShift)
Next iDst
For iDst = SIG_LEN - iShift To SIG_LEN - 1
F.baSig(iDst) = 0
Next iDst
Dim lE As Long
lE = GetExp(F) - iShift
SetExp F, lE
End Sub
' ==============================================================
' INTERNAL SIGADD (requires expA >= expB)
' ==============================================================
Private Sub SigAdd(Result As Float256, A As Float256, B As Float256, _
lExpA As Long, lExpB As Long)
Dim lDiff As Long
Dim iIdx As Integer
Dim iBIdx As Integer
Dim lSum As Long
Dim lCarry As Long
lDiff = lExpA - lExpB
If lDiff >= SIG_LEN Then
F256_Assign Result, A
Exit Sub
End If
F256_Clear Result
lCarry = 0
For iIdx = SIG_LEN - 1 To 0 Step -1
iBIdx = iIdx - CInt(lDiff)
If iBIdx >= 0 Then
lSum = CLng(A.baSig(iIdx)) + CLng(B.baSig(iBIdx)) + lCarry
Else
lSum = CLng(A.baSig(iIdx)) + lCarry
End If
If lSum >= 256 Then
Result.baSig(iIdx) = CByte(lSum - 256)
lCarry = 1
Else
Result.baSig(iIdx) = CByte(lSum)
lCarry = 0
End If
Next iIdx
SetExp Result, lExpA
If lCarry > 0 Then
For iIdx = SIG_LEN - 1 To 1 Step -1
Result.baSig(iIdx) = Result.baSig(iIdx - 1)
Next iIdx
Result.baSig(0) = 1
SetExp Result, lExpA + 1
End If
End Sub
' ==============================================================
' INTERNAL SIGSUB (requires |A| >= |B|, expA >= expB)
' ==============================================================
Private Sub SigSub(Result As Float256, A As Float256, B As Float256, _
lExpA As Long, lExpB As Long)
Dim lDiff As Long
Dim iIdx As Integer
Dim iBIdx As Integer
Dim lBVal As Long
Dim lSub As Long
Dim lBorrow As Long
lDiff = lExpA - lExpB
If lDiff >= SIG_LEN Then
F256_Assign Result, A
Exit Sub
End If
F256_Clear Result
lBorrow = 0
For iIdx = SIG_LEN - 1 To 0 Step -1
iBIdx = iIdx - CInt(lDiff)
If iBIdx >= 0 Then
lBVal = CLng(B.baSig(iBIdx))
Else
lBVal = 0
End If
lSub = CLng(A.baSig(iIdx)) - lBVal - lBorrow
If lSub < 0 Then
Result.baSig(iIdx) = CByte(lSub + 256)
lBorrow = 1
Else
Result.baSig(iIdx) = CByte(lSub)
lBorrow = 0
End If
Next iIdx
SetExp Result, lExpA
Normalize Result
End Sub
Public Function F256_ToString(F As Float256) As String
If IsNaN(F) Then
F256_ToString = "NaN"
Exit Function
End If
If IsZero(F) Then
F256_ToString = "0"
Exit Function
End If
Const PREC As Integer = 67 ' max significante cijfers gewenst
Dim signPrefix As String
signPrefix = IIf(IsNeg(F), "-", "")
' 1) M (28 bytes) -> decimale big-int DEC()
Dim DEC() As Integer
BigDec_Init DEC ' DEC = 0
Dim i As Integer
For i = 0 To SIG_LEN - 1
BigDec_MulSmall DEC, 256
BigDec_AddSmall DEC, F.baSig(i)
Next i
' 2) exponent verwerken
Dim E As Long
E = GetExp(F)
Dim e10 As Long
e10 = 0
If E > 0 Then
' N = M * (256^E) = M * (2^(8E)) -> doe *256 E keer (sneller dan *2 8E keer)
Dim j As Long
For j = 1 To E
BigDec_MulSmall DEC, 256
Next j
ElseIf E < 0 Then
' N = M * 5^(8k); e10 = -8k
Dim k As Long
k = -E
Dim t As Long
For t = 1 To 8 * k
BigDec_MulSmall DEC, 5
Next t
e10 = e10 - 8 * k
End If
' Nu vertegenwoordigt DEC de integer N en hebben we een decimale exponent e10 (kan negatief zijn)
' 3) DEC -> string (zonder leidende nullen)
Dim sDec As String
sDec = BigDec_ToString(DEC)
If sDec = "" Or sDec = "0" Then
F256_ToString = signPrefix & "0"
Exit Function
End If
' 4) Wetenschappelijke exponent q = (len-1) + e10
Dim L As Long
L = Len(sDec)
Dim q As Long
q = (L - 1) + e10
' 5) Mantisse opbouwen met PREC significante cijfers (geen afronding)
Dim mant As String
If L >= PREC Then
mant = Left$(sDec, PREC)
Else
mant = sDec & String$(PREC - L, "0")
End If
Dim sOut As String
If Len(mant) > 1 Then
sOut = Left$(mant, 1) & "." & mid$(mant, 2)
Else
sOut = mant
End If
If q <> 0 Then
sOut = sOut & "e" & CStr(q)
End If
F256_ToString = signPrefix & sOut
End Function
' BigDec: array of decimal digits, LSB at index 0 (reversed).
' Every entry 0..9
Private Sub BigDec_Init(ByRef A() As Integer)
ReDim A(0)
A(0) = 0
End Sub
Private Sub BigDec_TrimMSZ(ByRef A() As Integer)
Dim i As Long
For i = UBound(A) To 1 Step -1
If A(i) <> 0 Then Exit For
ReDim Preserve A(i - 1)
Next i
End Sub
Private Sub BigDec_MulSmall(ByRef A() As Integer, ByVal m As Integer)
If m = 0 Then
ReDim A(0)
A(0) = 0
Exit Sub
End If
Dim carry As Long
carry = 0
Dim i As Long, prod As Long
For i = 0 To UBound(A)
prod = CLng(A(i)) * m + carry
A(i) = prod Mod 10
carry = prod \ 10
Next i
Do While carry > 0
ReDim Preserve A(UBound(A) + 1)
A(UBound(A)) = carry Mod 10
carry = carry \ 10
Loop
End Sub
Private Sub BigDec_AddSmall(ByRef A() As Integer, ByVal addVal As Integer)
Dim carry As Long
carry = addVal
Dim i As Long, s As Long
i = 0
Do While carry > 0
If i > UBound(A) Then
ReDim Preserve A(i)
A(i) = 0
End If
s = A(i) + (carry Mod 10)
A(i) = s Mod 10
carry = (carry \ 10) + (s \ 10)
i = i + 1
Loop
End Sub
Private Function BigDec_ToString(ByRef A() As Integer) As String
BigDec_TrimMSZ A
Dim i As Long
Dim sb As String
For i = UBound(A) To 0 Step -1
sb = sb & CStr(A(i))
Next i
If sb = "" Then sb = "0"
BigDec_ToString = sb
End Function
Re: Can VB6 simulate high-precision math calculations like a 64-bit app?
I looked at the code, and it is extremely useful to me. Although I haven't tested whether the calculation results are correct, the structure of the code has already been very helpful. Many thanks to Arnoutdv.
I'm concerned not only with the accuracy of the calculations but also with their performance. I wrote a simple test code:
Code:
Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
Const TEST_COUNT = 100000
Private Sub Form_Click()
Me.AutoRedraw = True
Me.FontName = "Verdana"
Me.FontSize = 12
TestFloat256_Time
End Sub
Sub TestFloat256_Time()
Dim A As Float256, B As Float256, C As Float256
Dim nStartTime As Long, nEndTime As Long, i As Long
F256_FromString A, "1.23456789012345678901234567890123456789012345678901234567890123e50"
F256_FromString B, "9.87654321098765432109876543210987654321098765432109876543210987e49"
nStartTime = GetTickCount()
For i = 1 To TEST_COUNT
F256_Add C, A, B
Next i
nEndTime = GetTickCount(): Me.Print "A + B: " & (nEndTime - nStartTime) & " ms"
nStartTime = GetTickCount()
For i = 1 To TEST_COUNT
F256_Multiply C, A, B
Next i
nEndTime = GetTickCount(): Me.Print "A * B: " & (nEndTime - nStartTime) & " ms"
nStartTime = GetTickCount()
For i = 1 To TEST_COUNT
F256_Divide C, A, B
Next i
nEndTime = GetTickCount(): Me.Print "A / B: " & (nEndTime - nStartTime) & " ms"
nStartTime = GetTickCount()
For i = 1 To TEST_COUNT
F256_Subtract C, A, B
Next i
nEndTime = GetTickCount(): Me.Print "A - B: " & (nEndTime - nStartTime) & " ms"
End Sub
I wonder if anyone could provide a performance comparison of floating-point calculations between C++ and VB6? Thanks.
Re: Can VB6 simulate high-precision math calculations like a 64-bit app?
Originally Posted by Arnoutdv
The accuracy; it's code generated by Claude AI and I had it modify some routines based on the feedback by gilman.
About the speed, that's very easy to explain, all instructions are done by software not by hardware (CPU).
@Arnoutdv
If EXPSIGN_BIT is set, does it mean the exponent is negative, and therefore the "value" is a fraction of 1, right?
Re: [RESOLVED] Can VB6 simulate high-precision math calculations like a 64-bit app?
The code wasn’t written by me, it was written by Claude AI.
I assume the EXPSIGN bit is for the exponent and behaves the same as the SIGN bit.
Negative exponent meaning a number less than 1
Re: [RESOLVED] Can VB6 simulate high-precision math calculations like a 64-bit app?
Don't get me wrong, I think this code is awesome and it "kind of" works. Could you add a function that returns whether the sign bit is set? I made a function it looks like this
Code:
Public Function IsExpNeg(F As Float256) As Boolean
IsExpNeg = (F.lHeader And EXPSIGN_BIT) = EXPSIGN_BIT
End Function
Re: [RESOLVED] Can VB6 simulate high-precision math calculations like a 64-bit app?
I added your function and shows the correct result, for this example
Code:
Sub TestFloat256()
Dim A As Float256, B As Float256, C As Float256
' F256_FromString A, "1.23456789012345678901234567890123456789012345678901234567890123e50"
' F256_FromString B, "9.87654321098765432109876543210987654321098765432109876543210987e49"
F256_FromString A, "1.23456789012345678901234567890123456789012345678901234567890123"
F256_FromString B, "9.87654321098765432109876543210987654321098765432109876543210987"
Debug.Print F256_ToString(A)
Debug.Print F256_ToString(B)
F256_Add C, A, B
Debug.Print "A + B = " & F256_ToString(C)
'
F256_Multiply C, A, B
Debug.Print "A * B = " & F256_ToString(C)
'
F256_Divide C, A, B
Debug.Print "A / B = " & F256_ToString(C), "IsExpNeg: " & IsExpNeg(C)
'
F256_Subtract C, A, B
Debug.Print "A - B = " & F256_ToString(C)
End Sub
1.234567890123456789012345678901234567890123456789012345678901229435
9.876543210987654321098765432109876543210987654321098765432109865762
A + B = 1.111111110111111111011111111101111111110111111111011111111101109519e1
A * B = 1.219326311370217952261850327338667885945115073915636335923676110045e1
A / B = 1.249999988609375000142382812498220214843772247314452846908569335581e-1 IsExpNeg: True
A - B = -8.641975320864197532086419753208641975320864197532086419753208636327
Re: [RESOLVED] Can VB6 simulate high-precision math calculations like a 64-bit app?
good day Arnoutdv
if we set A and B as follows in your example code
F256_FromString A, "9.99999999999999999999999999999999999999999999999999999999999999"
F256_FromString B, "7.77777777777777777777777777777777777777777777777777777777777777"
the output is
9.999999999999999999999999999999999999999999999999999999999999984921
7.777777777777777777777777777777777777777777777777777777777777766480
A + B = 1.777777777777777777777777777777777777777777777777777777777777775140e1
A * B = 7.777777777777777777777777777777777777777777777777777777777777754751e1
A / B = 9.999999999999999999999999999999999999999999999999999999999999999999e-1 IsExpNeg: True
A - B = 2.222222222222222222222222222222222222222222222222222222222222218440
A + B OK
A * B OK
A / B wrong
A - B OK
if we swap the values of A and B then all seem to be OK
A / B = 7.777777777777777777777777777777777777777777777777777777777777778208e-1 IsExpNeg: True
Re: [RESOLVED] Can VB6 simulate high-precision math calculations like a 64-bit app?
Like stated before this was a single test to create a starting point for the topic starter.
The code was created by Claude and I did some modifications with Copilot
[RESOLVED] Can VB6 simulate high-precision math calculations like a 64-bit app?
Reply With Quote
Originally Posted by Joe Caverly
