|
Option Explicit
'Erweiterte Format-Funktion
Private Function HFormat(ByRef Expression As String, _
ByRef Format As String) As String
If Len(Expression) > Len(Format) Then
HFormat = Expression
Else
HFormat = Left(Format, Len(Format) - Len(Expression)) & _
Expression
End If
End Function
' Bereinigt eine Zahl (entfernt vorangestellte Nullen,
' Pluszeichen und nichtnumerische Zeichen)
Public Function HPurgeNum(ByVal Num As String) As String
Dim n As Long
Dim Char As String
HPurgeNum = ""
For n = 1 To Len(Num)
Char = Mid(Num, n, 1)
If IsNumeric(Char) Then
If Char <> "0" Or (Len(HPurgeNum) > 0 And _
HPurgeNum <> "-") Then HPurgeNum = HPurgeNum & Char
Else
If Len(HPurgeNum) = 0 And Char = "-" Then _
HPurgeNum = HPurgeNum & Char
End If
Next
If HPurgeNum = "" Or HPurgeNum = "-" Then HPurgeNum = "0"
End Function
'Gibt den absoluten Wert einer Zahl zurück
Public Function HAbs(ByVal Num As String) As String
If Left(Num, 1) = "-" Then
HAbs = Right(Num, Len(Num) - 1)
Else
HAbs = Num
End If
End Function
'Gibt das Vorzeichen einer Zahl zurück (-1 oder 1)
Public Function HSgn(ByVal Num As String) As Integer
If Left(Num, 1) = "-" Then
HSgn = -1
Else
HSgn = 1
End If
End Function
' Vergleicht die Größe zweier Zahlen
' 0 = gleich groß
' 1 = Zahl eins ist größer
' 2 = Zahl zwei ist größer
Public Function HCmp(ByVal Num1 As String, _
ByVal Num2 As String) As Integer
If Num1 = Num2 Then
HCmp = 0
ElseIf HSgn(Num1) > HSgn(Num2) Then
HCmp = 1
ElseIf HSgn(Num1) < HSgn(Num2) Then
HCmp = 2
ElseIf Len(Num1) > Len(Num2) Then
If HSgn(Num1) = 1 Then
HCmp = 1
Else
HCmp = 2
End If
ElseIf Len(Num1) < Len(Num2) Then
If HSgn(Num1) = 1 Then
HCmp = 2
Else
HCmp = 1
End If
Else
Dim n As Long
Dim dSign As Integer
dSign = HSgn(Num1)
Num1 = HAbs(Num1)
Num2 = HAbs(Num2)
For n = 1 To Len(Num1)
If CInt(Mid(Num1, n, 1)) > CInt(Mid(Num2, n, 1)) Then
If dSign = 1 Then
HCmp = 1
Else
HCmp = 2
End If
Exit Function
ElseIf CInt(Mid(Num1, n, 1)) < CInt(Mid(Num2, n, 1)) Then
If dSign = 1 Then
HCmp = 2
Else
HCmp = 1
End If
Exit Function
End If
Next
End If
End Function
'Addition
Public Function HAdd(ByVal Num1 As String, _
ByVal Num2 As String) As String
Dim n As Long
Dim Sgn1 As Integer
Dim Sgn2 As Integer
Dim SgnRes As Integer
Dim Cipher As Integer
Dim Expand As Integer
Sgn1 = HSgn(Num1)
Sgn2 = HSgn(Num2)
Num1 = HAbs(Num1)
Num2 = HAbs(Num2)
If HCmp(Num1, Num2) = 1 Then
SgnRes = Sgn1
Else
SgnRes = Sgn2
End If
If Len(Num1) > Len(Num2) Then
Num2 = HFormat(Num2, String(Len(Num1), "0"))
HAdd = String(Len(Num1) + 1, "0")
Else
Num1 = HFormat(Num1, String(Len(Num2), "0"))
HAdd = String(Len(Num2) + 1, "0")
End If
Expand = 0
If Sgn1 = Sgn2 Then
For n = Len(Num1) To 1 Step -1
Cipher = _
CInt(Mid(Num1, n, 1)) + CInt(Mid(Num2, n, 1)) + Expand
If Cipher > 9 Then
Cipher = Cipher - 10
Expand = 1
Else
Expand = 0
End If
Mid(HAdd, Len(HAdd) - (Len(Num1) - n), 1) = CStr(Cipher)
Next
Mid(HAdd, Len(HAdd) - (Len(Num1) - n), 1) = CStr(Expand)
Else
If Num1 > Num2 Then
For n = Len(Num1) To 1 Step -1
Cipher = _
CInt(Mid(Num1, n, 1)) - CInt(Mid(Num2, n, 1)) - Expand
If Cipher < 0 Then
Cipher = Cipher + 10
Expand = 1
Else
Expand = 0
End If
Mid(HAdd, Len(HAdd) - (Len(Num1) - n), 1) = CStr(Cipher)
Next
Else
For n = Len(Num1) To 1 Step -1
Cipher = _
CInt(Mid(Num2, n, 1)) - CInt(Mid(Num1, n, 1)) - Expand
If Cipher < 0 Then
Cipher = Cipher + 10
Expand = 1
Else
Expand = 0
End If
Mid(HAdd, Len(HAdd) - (Len(Num1) - n), 1) = CStr(Cipher)
Next
End If
End If
If SgnRes = -1 Then HAdd = "-" & HAdd
HAdd = HPurgeNum(HAdd)
End Function
'Subtraktion
Public Function HSubtract(ByVal Num1 As String, _
ByVal Num2 As String) As String
If HSgn(Num2) = -1 Then
HSubtract = HAdd(Num1, HAbs(Num2))
Else
HSubtract = HAdd(Num1, "-" & Num2)
End If
End Function
'Multiplikation
Public Function HMultiply(ByVal Num1 As String, _
ByVal Num2 As String) As String
Dim SgnRes As String
Dim Cipher1 As Long
Dim Cipher2 As Long
Dim n As Long
Dim m As Long
HMultiply = "0"
SgnRes = ""
If HSgn(Num1) * HSgn(Num2) = -1 Then SgnRes = "-"
Num1 = HAbs(Num1)
Num2 = HAbs(Num2)
For n = Len(Num1) To 1 Step -1
Cipher1 = CLng(Mid(Num1, n, 1))
For m = Len(Num2) To 1 Step -1
Cipher2 = CLng(Mid(Num2, m, 1))
HMultiply = HAdd(HMultiply, CStr(Cipher1 * Cipher2) & _
String(Len(Num1) - n + Len(Num2) - m, "0"))
Next
Next
HMultiply = SgnRes & HMultiply
End Function
|
|