Option Explicit
Public Function Hex2DecStr(ByVal strHex As String) As String
Const cstDigits As String = "0123456789ABCDEF"
Dim intVar As Integer
Dim strRet As String, strPow As String
' Check Input
For intVar = 1 To 16
If InStr(1, cstDigits, Mid$(strHex, intVar, 1), vbTextCompare) = 0 Then Err.Raise 5
Next intVar
' Convert To Decimal
strPow = "1"
strRet = "0"
For intVar = Len(strHex) To 1 Step -1
strRet = IntAddition(strRet, IntMultiply(strPow, CStr(InStr(1, cstDigits, Mid$(strHex, intVar, 1), vbTextCompare) - 1)))
strPow = IntMultiply(strPow, "16")
Next intVar
Hex2DecStr = strRet
End Function
Public Function IntAddition(ByVal FirstNum As String, ByVal SecondNum As String) As String
Dim a As Long, DifLen As Long, TempStr As String, TempNum As Integer
Dim Num1 As String, Num2 As String, TempNum1 As Integer, TempNum2 As Integer
Dim CarryOver As Integer, LeftOvers As Long
'Setup the numbers so that they are easier to
handle.
'I originally had about 10 nested if statements that this block
'of code simplifies Dramatically.
If Len(FirstNum) >= Len(SecondNum) Then
Num1 = FirstNum
Num2 = SecondNum
Else
Num2 = FirstNum
Num1 = SecondNum
End If
'Just setup some of the variables that need an initial value
DifLen = Len(Num1) - Len(Num2)
CarryOver = 0
LeftOvers = DifLen
'Ok, now for the real math. Looping from the end of the numbers
'just like our preschool teachers taught us, we add numbers that
'line up in the 'places' (I.E. ones, tens, hundreds, thousands, etc)
For a = Len(Num2) To 1 Step -1
TempNum1 = Int(Mid(Num1, a + DifLen, 1))
TempNum2 = Int(Mid(Num2, a, 1))
TempNum = TempNum1 + TempNum2 + CarryOver
CarryOver = TempNum \ 10
TempStr = (TempNum - (CarryOver * 10)) & TempStr
Next a
'What do we do if there is a 1 or a 2 that carries over outside the
'numbers that line up in the places, well, we do the following block of
'code. The do loop is used incase we get a situation like this:
'
' 199999 When you add 1 to a set of nines it continues to
' _+___1 Carry over until it hits the first digit
' 200000
Do Until CarryOver = 0 Or LeftOvers = 0
TempNum = Int(Mid(Num1, LeftOvers, 1)) + CarryOver
CarryOver = TempNum \ 10
TempStr = (TempNum - (CarryOver * 10)) & TempStr
LeftOvers = LeftOvers - 1
Loop
'Since there are two possible ways of exiting the Loop above, we need
'to test and apply the other variable and its associated values in the following
'two if statements.
'
Handle a possible carryover that will drop off the front end creating a new place.
If CarryOver > 0 Then TempStr = CarryOver & TempStr
'add any of the numbers that are remaining on the left side of the longer string
If LeftOvers > 0 Then TempStr = Left(Num1, LeftOvers) & TempStr
'and return the value
IntAddition = TrimZeros(TempStr)
End Function
Public Function IntMultiply(ByVal FirstNum As String, ByVal SecondNum As String) As String
Dim ZeroStr As String
Dim a As Long, b As Long, Multiplier1 As Integer, Multiplier2 As Integer
Dim Num As Integer, CarryOver As Integer, TempStr As String, TallyStr As String
'THIS FUNCTION IS COMPLETE AND WORKS
'This function can
handle two extra longs. It cycles through
'the firstnum one digit at a time from secondnum.
'this function works on the distrubution Principle of Multiplication:
' 9999 * 222 = (9999 * 2) + (9999 * 20) + (9999 * 200)
'
'The zero's are concatinated on after the multiplication takes place.
'
'This function is dependent on the IntAddition function above.
For a = Len(FirstNum) To 1 Step -1
'setup variables for this loop of multiplication
TempStr = ""
CarryOver = 0
Multiplier1 = Mid(FirstNum, a, 1)
'Multiply one digit at a time from right to left
For b = Len(SecondNum) To 1 Step -1
Multiplier2 = Mid(SecondNum, b, 1)
Num = (Multiplier1 * Multiplier2) + CarryOver
CarryOver = Num \ 10
TempStr = (Num - (CarryOver * 10)) & TempStr
Next b
'Check to see if the multiplication added a new digit
If CarryOver > 0 Then TempStr = CarryOver & TempStr
'Add the zeros
TempStr = TempStr & ZeroStr
TallyStr = IntAddition(TempStr, TallyStr)
ZeroStr = ZeroStr & "0"
Next a
IntMultiply = TrimZeros(TallyStr)
End Function
Public Function TrimZeros(ByVal Num As String) As String
Dim a As Long, TempStr As String
For a = 1 To Len(Num)
If Mid(Num, a, 1) <> 0 Then GoTo YuckFu
Next a
TrimZeros = "0"
Exit Function
YuckFu:
TrimZeros = Mid(Num, a, Len(Num) - a + 1)
End Function
Private Sub CommandButton1_Click()
Label1.Caption = Hex2DecStr(TextBox1.Text)
End Sub
###########################################################################################################################
Function TrimZeros(Num: String) : String;
var a: Integer;
var TempStr: String;
begin
result:='0';
For a:= 1 To Length(Num) do
begin
If (copy(Num, a, 1) <> '0') Then
begin
result:= copy(Num, a, Length(Num) - a + 1);
exit;
end;
end;
End;
Function IntAddition(const FirstNum: String; SecondNum: String):String;
var a, DifLen : integer;
var TempStr: string;
var TempNum: Integer;
var Num1,Num2: string;
var TempNum1, TempNum2: Integer;
var CarryOver, LeftOvers: Integer;
//'Setup the numbers so that they are easier to
handle.
//'I originally had about 10 nested if statements that this block
//'of code simplifies Dramatically.
begin
If Length(FirstNum) >= Length(SecondNum) Then
begin
Num1 := FirstNum;
Num2 := SecondNum;
end Else
begin
Num2 := FirstNum;
Num1 := SecondNum;
End;
//'Just setup some of the variables that need an initial value
DifLen := Length(Num1) - Length(Num2);
CarryOver:= 0;
LeftOvers:= DifLen;
//'Ok, now for the real math. Looping from the end of the numbers
//'just like our preschool teachers taught us, we add numbers that
//'line up in the 'places' (I.E. ones, tens, hundreds, thousands, etc)
For a:= Length(Num2) downto 1 do
begin
TempNum1 := StrToint(copy(Num1, a + DifLen, 1));
TempNum2 := StrToint(copy(Num2, a, 1));
TempNum := TempNum1 + TempNum2 + CarryOver;
CarryOver:= TempNum div 10; // \
TempStr := Inttostr((TempNum - (CarryOver * 10))) + TempStr; //&
end;
//'What do we do if there is a 1 or a 2 that carries over outside the
//'numbers that line up in the places, well, we do the following block of
//'code. The do loop is used incase we get a situation like this:
//'
//' 199999 When you add 1 to a set of nines it continues to
//' _+___1 Carry over until it hits the first digit
//' 200000
repeat
TempNum := StrtoInt(copy(Num1, LeftOvers, 1)) + CarryOver;
CarryOver:= TempNum div 10;
TempStr := Inttostr((TempNum - (CarryOver * 10))) + TempStr;
LeftOvers:= LeftOvers - 1;
Until ((CarryOver = 0) Or (LeftOvers = 0));
//'Since there are two possible ways of exiting the Loop above, we need
//'to test and apply the other variable and its associated values in the following
//'two if statements.
//'
Handle a possible carryover that will drop off the front end creating a new place.
If (CarryOver > 0) Then TempStr := Inttostr(CarryOver) + TempStr;
//'add any of the numbers that are remaining on the left side of the longer string
If (LeftOvers > 0) Then TempStr := copy(Num1, 1, LeftOvers) + TempStr;
//'and return the value
result := TrimZeros(TempStr);
End;
Function IntMultiply(const FirstNum: String; const SecondNum: String): String;
var ZeroStr: String;
var a, b , Multiplier1, Multiplier2, Num , CarryOver : Integer;
var TempStr, TallyStr: String;
//'THIS FUNCTION IS COMPLETE AND WORKS
//'This function can
handle two extra longs. It cycles through
//'the firstnum one digit at a time from secondnum.
//'this function works on the distrubution Principle of Multiplication:
//' 9999 * 222 = (9999 * 2) + (9999 * 20) + (9999 * 200)
//'
//'The zero's are concatinated on after the multiplication takes place.
//'
//'This function is dependent on the IntAddition function above.
begin
For a:= Length(FirstNum) downto 1 do
begin
// 'setup variables for this loop of multiplication
TempStr := '';
CarryOver := 0;
Multiplier1 := strToint(copy(FirstNum, a, 1));
// 'Multiply one digit at a time from right to left
For b:= Length(SecondNum) downto 1 do
begin
Multiplier2 := StrToint(copy(SecondNum, b, 1));
Num := (Multiplier1 * Multiplier2) + CarryOver;
CarryOver:= Num div 10;
TempStr := InttoStr((Num - (CarryOver * 10))) + TempStr; //addieren?
end;//for b
// 'Check to see if the multiplication added a new digit
If (CarryOver > 0) Then TempStr := InttoStr(CarryOver) + TempStr;
// 'Add the zeros
TempStr := TempStr + ZeroStr;
TallyStr:= IntAddition(TempStr, TallyStr);
ZeroStr := ZeroStr + '0';
end;//for a
result := TrimZeros(TallyStr);
End;
Function Hex2DecStr(const strHex: String):string;
Const cstDigits = '0123456789ABCDEF';
var intVar: Integer;
var strRet: String;
var strPow: String;
var temp: string;
begin
temp:=UpperCase(strHex);
////' Check Input
// For intVar:= 1 To 16
// If pos(1, cstDigits, Mid$(temp, intVar, 1), vbTextCompare) = 0 Then exit;
// end;
//' Convert To Decimal
strPow := '1';
strRet := '0';
For intVar:= Length(temp) downto 1 do
begin
// muss noch übersetzt werden strRet := IntAddition(strRet, IntMultiply(strPow, CStr(InStr(1, cstDigits, Mid$(temp, intVar, 1), vbTextCompare) - 1)))
strPow := IntMultiply(strPow, '16');
end;
result:= strRet;
end;