Is there any pure VBS /wsh way to get 4 bytes from a string that form an IEEE floating point number and return them into a single typed variant?
I have done it by building the IEEE number from its bytes but its painfully slow...
function bintofloat (str,i) 'string, position
dim n1,n2,exponent,mantissa,sign
'only normalized, does'nt detect infinity or NaN
const m_sign= &h8000, m_exp= &h7f80
const d_exp= &h800000& , m_mant=&h7fffff&
n1=asc(mid(str,i+3,1))* 256 + asc(mid(str,i+2,1))
exponent = ((n1 and m_exp)/&h80)
sign=1+ 2*((n1 and m_sign)<>0)
n2 = ( asc(mid(str,i+2,1))* 256 + asc(mid(str,i+1,1)))* 256 + asc(mid(str,i,1))
mantissa= (n2 and m_mant)
wscript.echo mantissa,exponent
if exponent=&hFF then 'nan o inf
if mantissa=0 then
'bintofloat=sign * 1e38
if sign then bintofloat="-Inf" else bintofloat="Inf"
else
bintofloat ="NAN "& mantissa
'bintofloat=sign *1e38
end if
elseif exponent =0 then
if mantissa=0 then
bintofloat=0
Else 'denormalizad
bintofloat=sign* mantissa * 2.^-149
end if
else
bintofloat = sign* (mantissa or d_exp) * 2.^(exponent -150)
end if
end function
Related
In VB6, I am trying to convert a number to binary but when the number has 10 digits i am always getting an Overflow error.
What is the data type where i can store a trillion number?
This is the code which is working when the number has less that 10 digits.
Public Function DecimalToBinary(DecimalNum As Double) As _
String
Dim tmp As String
Dim n As Double
n = DecimalNum
tmp = Trim(Str(n Mod 2))
n = n \ 2
Do While n <> 0
tmp = Trim(Str(n Mod 2)) & tmp
n = n \ 2
Loop
DecimalToBinary = tmp
End Function
One of the problems you will encounter is that the Mod operator will not work with values larger than a Long (2,147,483,647). You can rewrite a Mod function as described in this answer: VBA equivalent to Excel's mod function:
' Divide the number by 2.
' Get the integer quotient for the next iteration.
' Get the remainder for the binary digit.
' Repeat the steps until the quotient is equal to 0.
Public Function DecimalToBinary(DecimalNum As Double) As String
Dim tmp As String
Dim n As Double
n = DecimalNum
Do While n <> 0
tmp = Remainder(n, 2) & tmp
n = Int(n / 2)
Loop
DecimalToBinary = tmp
End Function
Function Remainder(Dividend As Variant, Divisor As Variant) As Variant
Remainder = Dividend - Divisor * Int(Dividend / Divisor)
End Function
You can also rewrite your function to avoid Mod altogether:
Public Function DecimalToBinary2(DecimalNum As Double) As String
Dim tmp As String
Dim n As Double
Dim iCounter As Integer
Dim iBits As Integer
Dim dblMaxSize As Double
n = DecimalNum
iBits = 1
dblMaxSize = 1
' Get number of bits
Do While dblMaxSize <= n
dblMaxSize = dblMaxSize * 2
iBits = iBits + 1
Loop
' Move back down one bit
dblMaxSize = dblMaxSize / 2
iBits = iBits - 1
' Work back down bit by bit
For iCounter = iBits To 1 Step -1
If n - dblMaxSize >= 0 Then
tmp = tmp & "1"
n = n - dblMaxSize
Else
' This bit is too large
tmp = tmp & "0"
End If
dblMaxSize = dblMaxSize / 2
Next
DecimalToBinary2 = tmp
End Function
This function finds the bit that is larger than your number and works back down, bit by bit, figuring out if the value for each bit can be subtracted from your number. It's a pretty basic approach but it does the job.
For both functions, if you want to have your binary string in groups of 8 bits, you can use a function like this to pad your string:
Public Function ConvertToBytes(p_sBits As String)
Dim iLength As Integer
Dim iBytes As Integer
iLength = Len(p_sBits)
If iLength Mod 8 > 0 Then
iBytes = Int(iLength / 8) + 1
Else
iBytes = Int(iLength / 8)
End If
ConvertToBytes = Right("00000000" & p_sBits, iBytes * 8)
End Function
Caesar's cypher is the simplest encryption algorithm. It adds a fixed value to the ASCII (unicode) value of each character of a text. In other words, it shifts the characters. Decrypting a text is simply shifting it back by the same amount, that is, it substract the same value from the characters.
My task is to write a function that:
accepts two arguments: the first is the character vector to be encrypted, and the second is the shift amount.
returns one output, which is the encrypted text.
needs to work with all the visible ASCII characters from space to ~ (ASCII codes of 32 through 126). If the shifted code goes outside of this range, it should wrap around. For example, if we shift ~ by 1, the result should be space. If we shift space by -1, the result should be ~.
This is my MATLAB code:
function [coded] = caesar(input_text, shift)
x = double(input_text); %converts char symbols to double format
for ii = 1:length(x) %go through each element
if (x(ii) + shift > 126) & (mod(x(ii) + shift, 127) < 32)
x(ii) = mod(x(ii) + shift, 127) + 32; %if the symbol + shift > 126, I make it 32
elseif (x(ii) + shift > 126) & (mod(x(ii) + shift, 127) >= 32)
x(ii) = mod(x(ii) + shift, 127);
elseif (x(ii) + shift < 32) & (126 + (x(ii) + shift - 32 + 1) >= 32)
x(ii) = 126 + (x(ii) + shift - 32 + 1);
elseif (x(ii) + shift < 32) & (126 + (x(ii) + shift - 32 + 1) < 32)
x(ii) = abs(x(ii) - 32 + shift - 32);
else x(ii) = x(ii) + shift;
end
end
coded = char(x); % converts double format back to char
end
I can't seem to make the wrapping conversions correctly (e.g. from 31 to 126, 30 to 125, 127 to 32, and so on). How should I change my code to do that?
Before you even start coding something like this, you should have a firm grasp of how to approach the problem.
The main obstacle you encountered is how to apply the modulus operation to your data, seeing how mod "wraps" inputs to the range of [0 modPeriod-1], while your own data is in the range [32 126]. To make mod useful in this case we perform an intermediate step of shifting of the input to the range that mod "likes", i.e. from some [minVal maxVal] to [0 modPeriod-1].
So we need to find two things: the size of the required shift, and the size of the period of the mod. The first one is easy, since this is just -minVal, which is the negative of the ASCII value of the first character, which is space (written as ' ' in MATLAB). As for the period of the mod, this is just the size of your "alphabet", which happens to be "1 larger than the maximum value, after shifting", or in other words - maxVal-minVal+1. Essentially, what we're doing is the following
input -> shift to 0-based ("mod") domain -> apply mod() -> shift back -> output
Now take a look how this can be written using MATLAB's vectorized notation:
function [coded] = caesar(input_text, shift)
FIRST_PRINTABLE = ' ';
LAST_PRINTABLE = '~';
N_PRINTABLE_CHARS = LAST_PRINTABLE - FIRST_PRINTABLE + 1;
coded = char(mod(input_text - FIRST_PRINTABLE + shift, N_PRINTABLE_CHARS) + FIRST_PRINTABLE);
Here are some tests:
>> caesar('blabla', 1)
ans =
'cmbcmb'
>> caesar('cmbcmb', -1)
ans =
'blabla'
>> caesar('blabla', 1000)
ans =
'5?45?4'
>> caesar('5?45?4', -1000)
ans =
'blabla'
We can solve it using the idea of periodic functions :
periodic function repeats itself every cycle and every cycle is equal to 2π ...
like periodic functions ,we have a function that repeats itself every 95 values
the cycle = 126-32+1 ;
we add one because the '32' is also in the cycle ...
So if the value of the character exceeds '126' we subtract 95 ,
i.e. if the value =127(bigger than 126) then it is equivalent to
127-95=32 .
&if the value is less than 32 we subtract 95.
i.e. if the value= 31 (less than 32) then it is equivalent to 31+95
=126..
Now we will translate that into codes :
function out= caesar(string,shift)
value=string+shift;
for i=1:length(value)
while value(i)<32
value(i)=value(i)+95;
end
while value(i)>126
value(i)=value(i)-95;
end
end
out=char(value);
First i converted the output(shift+ text_input) to char.
function coded= caesar(text_input,shift)
coded=char(text_input+shift);
for i=1:length(coded)
while coded(i)<32
coded(i)=coded(i)+95;
end
while coded(i)>126
coded(i)=coded(i)-95;
end
end
Here Is one short code:
function coded = caesar(v,n)
C = 32:126;
v = double(v);
for i = 1:length(v)
x = find(C==v(i));
C = circshift(C,-n);
v(i) = C(x);
C = 32:126;
end
coded = char(v);
end
I want to take a number and convert it into lowercase a-z letters using VBScript.
For example:
1 converts to a
2 converts to b
27 converts to aa
28 converts to ab
and so on...
In particular I am having trouble converting numbers after 26 when converting to 2 letter cell names. (aa, ab, ac, etc.)
You should have a look at the Chr(n) function.
This would fit your needs from a to z:
wscript.echo Chr(number+96)
To represent multiple letters for numbers, (like excel would do it) you'll have to check your number for ranges and use the Mod operator for modulo.
EDIT:
There is a fast food Copy&Paste example on the web: How to convert Excel column numbers into alphabetical characters
Quoted example from microsoft:
For example: The column number is 30.
The column number is divided by 27: 30 / 27 = 1.1111, rounded down by the Int function to "1".
i = 1
Next Column number - (i * 26) = 30 -(1 * 26) = 30 - 26 = 4.
j = 4
Convert the values to alphabetical characters separately,
i = 1 = "A"
j = 4 = "D"
Combined together, they form the column designator "AD".
And its code:
Function ConvertToLetter(iCol As Integer) As String
Dim iAlpha As Integer
Dim iRemainder As Integer
iAlpha = Int(iCol / 27)
iRemainder = iCol - (iAlpha * 26)
If iAlpha > 0 Then
ConvertToLetter = Chr(iAlpha + 64)
End If
If iRemainder > 0 Then
ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64)
End If
End Function
Neither of the solutions above work for the full Excel range from A to XFD. The first example only works up to ZZ. The second example has boundry problems explained in the code comments below.
//
Function ColumnNumberToLetter(ColumnNumber As Integer) As String
' convert a column number to the Excel letter representation
Dim Div As Double
Dim iMostSignificant As Integer
Dim iLeastSignificant As Integer
Dim Base As Integer
Base = 26
' Column letters are base 26 starting at A=1 and ending at Z=26
' For base 26 math to work we need to adjust the input value to
' base 26 starting at 0
Div = (ColumnNumber - 1) / Base
iMostSignificant = Int(Div)
' The addition of 1 is needed to restore the 0 to 25 result value to
' align with A to Z
iLeastSignificant = 1 + (Div - iMostSignificant) * Base
' convert number to letter
ColumnNumberToLetter = Chr(64 + iLeastSignificant)
' if the input number is larger than the base then the conversion we
' just did is the least significant letter
' Call the function again with the remaining most significant letters
If ColumnNumber > Base Then
ColumnNumberToLetter = ColumnNumberToLetter(iMostSignificant) & ColumnNumberToLetter
End If
End Function
//
try this
function converts(n)
Dim i, c, m
i = n
c = ""
While i > 26
m = (i mod 26)
c = Chr(m+96) & c
i = (i - m) / 26
Wend
c = Chr(i+96) & c
converts = c
end function
WScript.Echo converts(1000)
I am trying to round up numbers in a legacy application which I had coded in VB6 to obtain the following outcomes:
2.53 should be 2.60
2.55 should be 2.60
2.56 should be 2.60
2.50 should remain 2.50
2.501 should be 2.50
2.505 should be 2.60
I have tried to use the suggested User-Defined Rounding functions by Microsoft
http://support.microsoft.com/kb/196652/en-gb
The closest I arrived to is the Asymup function
Function AsymUp(ByVal X As Double, _
Optional ByVal Factor As Double = 1) As Double
Dim Temp As Double
Temp = Int(X * Factor)
AsymUp = (Temp + IIf(X = Temp, 0, 1)) / Factor
End Function
I am testing this procedure by calling the function as follows:
Text1.Text = AsymUp(Val(Text1.Text), 10)
But this is not producing the desired results because 2.60 for example becomes 2.7 when I want it to remain 2.6. Strangely enough 2.0 also becomes 2.1, implying that the function is not working well.
How can I correct this to acheive the desired results
Private Function AsymUp(ByVal D As Double, Optional Precision As Double = 1) As Double
Precision = CDbl("1" & String$(Precision, 48))
D = D * Precision
If Int(D) <> D Then
AsymUp = (Int(D) + 1) / Precision
Else
AsymUp = D / Precision
End If
End Function
Visual Basic will always automatically truncate trailing zeros from Double and Single data types. Therefore, unless a function is designed to pass the number back as a string, along with the extra zero(s) appended, it will be impossible to retain trailing zeros of a particular precision.
Bonus tip: The IIf function should not be used where performance is of concern, as both the falsepart and truthpart parameters are always evaluated, regardless of the arguments passed to them.
String manipulation method (retains zeros):
Private Function AsymUp(ByVal D As Double, Optional Precision As Double = 1) As String
Dim P As Double, Z As Long
P = CDbl("1" & String$(Precision, 48))
D = D * P
If Int(D) <> D Then
D = (Int(D) + 1) / P
Else
D = D / P
End If
AsymUp = CStr(D)
Z = Precision - (Len(AsymUp) - InStr(AsymUp, "."))
If Z > 0 Then AsymUp = AsymUp & String$(Z, 48)
End Function
This will obviously not be as efficient to run as my other answer, but it's the only way to keep any trailing zeros intact.
Please note that the function will always return the number as a string. You may need to convert the string back to a decimal number to continue using the number with additional mathematics in your program.
I've resolved the issue using the following code:
Private Sub Command1_Click()
roundnumber = Val(Text1.Text)
Text1.Text = Round(roundnumber, 2)
Text1.Text = AsymUp(Val(Text1.Text), 10)
End Sub
Function AsymUp(ByVal X As Double, _
Optional ByVal Factor As Double = 1) As Double
Dim Temp As Double
Temp = Int(X * Factor)
AsymUp = (Temp + IIf((X * Factor) = Temp, 0, 1)) / Factor
End Function
This is what I was after not precision to 10dp as suggested in this post.
What's the best way to test two Singles for equality in VB6?
I want to test two Single values for equality to 7 significant figures.
This MSDN article recommends using something like
If Abs(a - b) <= Abs(a / 10 ^ 7) Then
valuesEqual = True
End If
However, that can fail for certain values, e.g.
Public Sub Main()
Dim a As Single
Dim b As Single
a = 0.50000005
b = 0.50000014
Debug.Print "a = " & a
Debug.Print "b = " & b
Debug.Print "a = b: " & (a = b)
Debug.Print "SinglesAreEqual(a, b): " & SinglesAreEqual(a, b)
// Output:
// a = 0.5000001
// b = 0.5000001
// b = b: False
// SinglesAreEqual(a, b): False
End Sub
Private Function SinglesAreEqual(a As Single, b As Single) As Boolean
If Abs(a - b) <= Abs(a / 10 ^ 7) Then
SinglesAreEqual = True
Else
SinglesAreEqual = False
End If
End Function
The simplest way I've found of getting the result I need is to convert the values to strings, but seems horribly ugly:
Private Function SinglesAreEqual(a As Single, b As Single) As Boolean
SinglesAreEqual = (Str$(a) = Str$(b))
End Function
Are there any better ways?
I maintain a CAD/CAM application and I have to deal with floating point numbers all the time. I have a function that I call fComp that I pass a floating point value when I need to test for equality. fComp call a rounding function set to a certain level of precision. For our system I round to 6 decimal places. Yours may need higher or get away with lower it depends on the application.
The fComp Function exists so I have one spot to change the rounding factor used in these calculations. This proved handy a couple of years back when we started manufacturing higher precision machines.
Public Function pRound(ByVal Value As Double, ByVal Power As Double) As Double
Dim TempValue As Double
Dim tSign As Double
TempValue = Value
tSign = TempValue
TempValue = Abs(TempValue)
TempValue = TempValue * 10 ^ (Power * -1)
TempValue = Fix(TempValue + 0.5)
TempValue = TempValue / 10 ^ (Power * -1)
pRound = TempValue * Sign(tSign)
End Function
To round to the 6th decimal place you go
RoundedNumber = pRound(MyValue, -6)
Negative is to the right of the decimal place positive to the left.
Instead if rounding and testing for equality, you can take the difference of two numbers and compare that with a factor
If Abs(a - b) < 0.000001 Then
You can adjust the 0.000001 to whatever resolution you need
I don't believe you can use the single data type to that many significant figures. You would need to use double instead:
Dim a As Single
Dim s As String
s = "0.50000005"
a = 0.50000005
Debug.Print s & " " & a
The above outputs:
0.50000005
0.5000001