by Federico Santandrea (1 Submission)
Category: Math/Dates
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Fri 9th January 2004
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
This module treats strings as numbers. So you can do MATH OPERATIONS with HUGE NUMBERS (up to 65535 digits). You can ADD, SUBTRACT, MULTIPLY,
API Declarations
'* CopyRight Federico Santandrea 2004
'* [email protected]
'* PLEASE CREDIT ME IF YOU USE THIS CODE!
VBcoders
'* [email protected]
'* PLEASE CREDIT ME IF YOU USE THIS CODE!
Public Type IntegerDivision
Result As String
Remainder As String
End Type
Public Function Add(FirstAddendum As String, SecondAddendum As String) As String
'Verifica numerico
If Not IsNumeric(FirstAddendum) Or Not IsNumeric(SecondAddendum) Then Err.Raise 1, , "Gli argomenti devono essere stringhe contenenti numeri interi."
'Verifica negativo/positivo
If Left$(FirstAddendum, 1) = "-" And Left$(SecondAddendum, 1) = "-" Then
FirstAddendum = Replace(FirstAddendum, "-", "")
SecondAddendum = Replace(SecondAddendum, "-", "")
MinusFlag = 1
GoTo 10
End If
If Left$(FirstAddendum, 1) = "-" Then Add = Subtract(SecondAddendum, CStr(Right$(FirstAddendum, Len(FirstAddendum) - 1))): Exit Function
If Left$(SecondAddendum, 1) = "-" Then Add = Subtract(FirstAddendum, CStr(Right$(SecondAddendum, Len(SecondAddendum) - 1))): Exit Function
'A1 sarà l' addendo con più cifre.
10 If Len(FirstAddendum) > Len(SecondAddendum) Then
A1 = FirstAddendum: A2 = SecondAddendum
Else
A1 = SecondAddendum: A2 = FirstAddendum
End If
'Aggiunge zeri in testa ad A2 perché devono essere della stessa lunghezza.
Do Until Len(A1) = Len(A2)
A2 = "0" + A2
Loop
'Contatore lungo, tanto il valore massimo del tipo Long supera di gran
'lunga la lunghezza massima di una stringa.
Dim I As Long
For I = Len(A1) To 1 Step -1
SubA1 = Mid$(A1, I, 1)
SubA2 = Mid$(A2, I, 1)
SubA1 = CInt(SubA1)
SubA2 = CInt(SubA2)
ResA = SubA1 + SubA2 + Carry
IntA = ResA Mod 10
Carry = (ResA - IntA) / 10
Add = CStr(IntA) + Add
Next I
If Carry <> 0 Then Add = CStr(Carry) + Add
If MinusFlag = 1 Then Add = "-" + Add
End Function
Public Function Subtract(Minuendo As String, Sottraendo As String) As String
'Verifica numerico
If Not IsNumeric(Minuendo) Or Not IsNumeric(Sottraendo) Then Err.Raise 1, , "Gli argomenti devono essere stringhe contenenti numeri interi."
A1 = Minuendo
A2 = Sottraendo
'Verifica negativo/positivo
If Left$(A1, 1) = "-" And Left$(A2, 1) <> "-" Then Subtract = Add(CStr(A1), "-" + CStr(A2)): Exit Function
If Left$(A1, 1) <> "-" And Left$(A2, 1) = "-" Then Subtract = Add(CStr(A1), CStr(Right$(A2, Len(A2) - 1))): Exit Function
If Left$(A1, 1) = "-" And Left$(A2, 1) = "-" Then Subtract = Subtract(Right$(A2, Len(A2) - 1), Right$(A1, Len(A1) - 1)): Exit Function
'È una sottrazione: non possiamo scambiare i numeri.
'Quindi è necessario ripetere due volte il procedimento di padding:
If Len(Minuendo) > Len(Sottraendo) Then
Do Until Len(Sottraendo) = Len(Minuendo)
Sottraendo = "0" + Sottraendo
Loop
End If
If Len(Sottraendo) > Len(Minuendo) Then
Do Until Len(Sottraendo) = Len(Minuendo)
Minuendo = "0" + Minuendo
Loop
End If
A1 = Minuendo
A2 = Sottraendo
'Se il secondo numero è maggiore del primo, swappa la sottrazione.
If GreaterThan(CStr(A2), CStr(A1)) Then Subtract = "-" + Subtract(CStr(A2), CStr(A1)): Exit Function
'Contatore lungo, tanto il valore massimo del tipo Long supera di gran
'lunga la lunghezza massima di una stringa.
Dim I As Long
For I = Len(A1) To 1 Step -1
SubS1 = Mid$(A1, I, 1)
SubS2 = Mid$(A2, I, 1)
SubS1 = CInt(SubS1)
SubS2 = CInt(SubS2)
ResS = SubS1 - SubS2 - Borrow
If ResS < 0 Then
Borrow = 1: ResS = 10 - Abs(ResS)
Else
Borrow = 0
End If
Subtract = CStr(ResS) + Subtract
Next I
'Toglie gli eventuali zeri di testa
Do Until Left$(Subtract, 1) <> "0"
Subtract = Right$(Subtract, Len(Subtract) - 1)
Loop
If Subtract = "" Then Subtract = "0"
End Function
Public Function Multiply(FirstFactor As String, SecondFactor As String) As String
'Verifica numerico
If Not IsNumeric(FirstFactor) Or Not IsNumeric(SecondFactor) Then Err.Raise 1, , "Gli argomenti devono essere stringhe contenenti numeri interi."
'Verifica positivo/negativo
If Left$(FirstFactor, 1) = "-" Xor Left$(SecondFactor, 1) = "-" Then Sign = "-"
FirstFactor = Replace(FirstFactor, "-", "")
SecondFactor = Replace(SecondFactor, "-", "")
'SecondFactor sarà il fattore con più cifre.
10 If Len(FirstFactor) > Len(SecondFactor) Then O = FirstFactor: FirstFactor = SecondFactor: SecondFactor = O
'Aggiunge zeri in testa a FirstFactor perché devono essere della stessa lunghezza.
Do Until Len(FirstFactor) = Len(SecondFactor)
FirstFactor = "0" + FirstFactor
Loop
Multiply = "0"
Dim I As Long
For I = Len(SecondFactor) To 1 Step -1
M2 = Mid$(SecondFactor, I, 1)
For J = 0 To Len(SecondFactor) - I - 1
SemiAdder = "0" + SemiAdder
Next J
For K = Len(FirstFactor) To 1 Step -1
M1 = Mid$(FirstFactor, K, 1)
ResM = M1 * M2 + Carry
IntM = ResM Mod 10
Carry = (ResM - IntM) / 10
SemiAdder = CStr(IntM) + SemiAdder
Next K
If Carry <> 0 Then SemiAdder = CStr(Carry) + SemiAdder
Multiply = Add(CStr(SemiAdder), CStr(Multiply))
SemiAdder = ""
Next I
'Toglie gli zeri di testa
Do Until Left$(Multiply, 1) <> "0"
Multiply = Right$(Multiply, Len(Multiply) - 1)
Loop
If Multiply = "" Then Multiply = "0"
Multiply = Sign + Multiply
End Function
Public Function Divide(Dividendo As String, Divider As String) As IntegerDivision
'Verifica numerico
If Not IsNumeric(Dividendo) Or Not IsNumeric(Divider) Then Err.Raise 1, , "Gli argomenti devono essere stringhe contenenti numeri interi."
'Verifica positivo/negativo
If Left$(FirstFactor, 1) = "-" Xor Left$(SecondFactor, 1) = "-" Then Sign = "-"
FirstFactor = Replace(FirstFactor, "-", "")
SecondFactor = Replace(SecondFactor, "-", "")
Shifter = Dividendo
Counter = "0"
Do Until LessThan(CStr(Shifter), Divider)
Shifter = Subtract(CStr(Shifter), CStr(Divider))
Counter = Add(CStr(Counter), "1")
Loop
Divide.Result = Sign + Counter
Divide.Remainder = Subtract(Dividendo, Multiply(CStr(Counter), CStr(Divider)))
End Function
Public Function Pow(Base As String, Exponent As String) As String
'Verifica numerico
If Not IsNumeric(Base) Or Not IsNumeric(Exponent) Then Err.Raise 1, , "Gli argomenti devono essere stringhe contenenti numeri interi."
Pow = Base
Do While Exponent <> "1"
Pow = Multiply(Base, Pow)
Exponent = Subtract(Exponent, "1")
Loop
End Function
Public Function GreaterThan(ThisNumber As String, IsGreaterThanThis As String) As Boolean
'Verifica numerico
If Not IsNumeric(ThisNumber) Or Not IsNumeric(IsGreaterThanThis) Then Err.Raise 1, , "Gli argomenti devono essere stringhe contenenti numeri interi."
'I numeri positivi sono sempre più grandi dei negativi.
If Left$(ThisNumber, 1) = "-" And Left$(IsGreaterThanThis, 1) <> "-" Then GreaterThan = False: Exit Function
If Left$(ThisNumber, 1) <> "-" And Left$(IsGreaterThanThis, 1) = "-" Then GreaterThan = True: Exit Function
If Left$(ThisNumber, 1) = "-" And Left$(IsGreaterThanThis, 1) = "-" Then GreaterThan = GreaterThan(Right$(IsGreaterThanThis, Len(IsGreaterThanThis) - 1), Right$(ThisNumber, Len(ThisNumber) - 1)): Exit Function
'Numeri più lunghi sono sempre più grandi di numeri più corti
'(solo parlando in termini di numeri positivi, ma qua ci arrivano solo
'numeri positivi!)
If Len(ThisNumber) > Len(IsGreaterThanThis) Then GreaterThan = True: Exit Function
If Len(ThisNumber) < Len(IsGreaterThanThis) Then GreaterThan = False: Exit Function
'E se la lunghezza è uguale, controlla il primo numero per vedere
'qual'è il più grande. Se sono uguali controlla quello dopo... eccetera.
Dim I As Long
For I = 1 To Len(ThisNumber)
G1 = CInt(Mid$(ThisNumber, I, 1))
G2 = CInt(Mid$(IsGreaterThanThis, I, 1))
If G1 > G2 Then GreaterThan = True: Exit Function
If G1 < G2 Then GreaterThan = False: Exit Function
Next I
'Se arriva qui, i due numeri sono uguali. Quindi, il primo non
'è maggiore dell' altro.
GreaterThan = False
End Function
Public Function LessThan(ThisNumber As String, IsLessThanThis As String) As Boolean
LessThan = Not GreaterThan(ThisNumber, IsLessThanThis)
End Function
No comments have been posted about This module treats strings as numbers. So you can do MATH OPERATIONS with HUGE NUMBERS (up to 65535. Why not be the first to post a comment about This module treats strings as numbers. So you can do MATH OPERATIONS with HUGE NUMBERS (up to 65535.