Мозги уже закипели.
Пдскажите ка 8-и байтное с плавающей точкой преобразовать в 6-и байтное с плавающей точкой
Прочитал это
http://sources.ru/pascal/datatype/floatype.htm
и это
http://www.vbstreets.ru/VB/Articles/66295.aspx
сдела пока вот это (потом оптимизирую)
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
Private Sub Command1_Click()
Dim i As Integer
Dim str As String
Dim Exponenta As Integer
Dim ee( 1 To 2 ) As Byte
Dim rr( 1 To 6 ) As Byte
Dim dd( 1 To 8 ) As Byte
Dim d As Double
d = 50 . 01
If d = 0 Then
str = Chr( 0 ) & Chr( 0 ) & Chr( 0 ) & Chr( 0 ) & Chr( 0 ) & Chr( 0 )
Else
CopyMemory dd( 1 ), 0 , 8
CopyMemory rr( 1 ), 0 , 6
CopyMemory dd( 1 ), d, 8
Debug.Print dd( 1 ) & " " & dd( 2 ) & " " & dd( 3 ) & " " & dd( 4 ) & " " & dd( 5 ) & " " & dd( 6 ) & " " & dd( 7 ) & " " & dd( 8 )
ee( 1 ) = dd( 7 ) And 240
ee( 2 ) = dd( 8 ) And 127
MsgBox ee( 2 ) & " " & ee( 1 )
Exponenta = 0
For i = 0 To 3
If (ee( 1 ) And 2 ^ (i + 4 )) > 0 Then Exponenta = Exponenta Or 2 ^ i
Next i
For i = 0 To 6
If (ee( 1 ) And 2 ^ i) > 0 Then Exponenta = Exponenta Or 2 ^ (i + 4 )
Next i
MsgBox Exponenta
Exponenta = Exponenta - 1023 + 129
CopyMemory ee( 1 ), Exponenta, 2
rr( 1 ) = ee( 1 )
MsgBox rr( 1 )
rr( 6 ) = dd( 8 ) And 2 ^ 7 ' çíàê
If (dd( 7 ) And 2 ^ 3 ) > 0 Then rr( 6 ) = rr( 6 ) Or 2 ^ 6
If (dd( 7 ) And 2 ^ 2 ) > 0 Then rr( 6 ) = rr( 6 ) Or 2 ^ 5
If (dd( 7 ) And 2 ) > 0 Then rr( 6 ) = rr( 6 ) Or 2 ^ 4
If (dd( 7 ) And 1 ) > 0 Then rr( 6 ) = rr( 6 ) Or 2 ^ 3
If (dd( 6 ) And 2 ^ 7 ) > 0 Then rr( 6 ) = rr( 6 ) Or 2 ^ 2
If (dd( 6 ) And 2 ^ 6 ) > 0 Then rr( 6 ) = rr( 6 ) Or 2
If (dd( 6 ) And 2 ^ 5 ) > 0 Then rr( 6 ) = rr( 6 ) Or 1
If (dd( 6 ) And 2 ^ 4 ) > 0 Then rr( 5 ) = rr( 5 ) Or 2 ^ 7
If (dd( 6 ) And 2 ^ 3 ) > 0 Then rr( 5 ) = rr( 5 ) Or 2 ^ 6
If (dd( 6 ) And 2 ^ 2 ) > 0 Then rr( 5 ) = rr( 5 ) Or 2 ^ 5
If (dd( 6 ) And 2 ) > 0 Then rr( 5 ) = rr( 5 ) Or 2 ^ 4
If (dd( 6 ) And 1 ) > 0 Then rr( 5 ) = rr( 5 ) Or 2 ^ 3
If (dd( 5 ) And 2 ^ 7 ) > 0 Then rr( 5 ) = rr( 5 ) Or 2 ^ 2
If (dd( 5 ) And 2 ^ 6 ) > 0 Then rr( 5 ) = rr( 5 ) Or 2
If (dd( 5 ) And 2 ^ 5 ) > 0 Then rr( 5 ) = rr( 5 ) Or 1
If (dd( 5 ) And 2 ^ 4 ) > 0 Then rr( 4 ) = rr( 4 ) Or 2 ^ 7
If (dd( 5 ) And 2 ^ 3 ) > 0 Then rr( 4 ) = rr( 4 ) Or 2 ^ 6
If (dd( 5 ) And 2 ^ 2 ) > 0 Then rr( 4 ) = rr( 4 ) Or 2 ^ 5
If (dd( 5 ) And 2 ) > 0 Then rr( 4 ) = rr( 4 ) Or 2 ^ 4
If (dd( 5 ) And 1 ) > 0 Then rr( 4 ) = rr( 4 ) Or 2 ^ 3
If (dd( 4 ) And 2 ^ 7 ) > 0 Then rr( 4 ) = rr( 4 ) Or 2 ^ 2
If (dd( 4 ) And 2 ^ 6 ) > 0 Then rr( 4 ) = rr( 4 ) Or 2
If (dd( 4 ) And 2 ^ 5 ) > 0 Then rr( 4 ) = rr( 4 ) Or 1
If (dd( 4 ) And 2 ^ 4 ) > 0 Then rr( 3 ) = rr( 3 ) Or 2 ^ 7
If (dd( 4 ) And 2 ^ 3 ) > 0 Then rr( 3 ) = rr( 3 ) Or 2 ^ 6
If (dd( 4 ) And 2 ^ 2 ) > 0 Then rr( 3 ) = rr( 3 ) Or 2 ^ 5
If (dd( 4 ) And 2 ) > 0 Then rr( 3 ) = rr( 3 ) Or 2 ^ 4
If (dd( 4 ) And 1 ) > 0 Then rr( 3 ) = rr( 3 ) Or 2 ^ 3
If (dd( 3 ) And 2 ^ 7 ) > 0 Then rr( 3 ) = rr( 3 ) Or 2 ^ 2
If (dd( 3 ) And 2 ^ 6 ) > 0 Then rr( 3 ) = rr( 3 ) Or 2
If (dd( 3 ) And 2 ^ 5 ) > 0 Then rr( 3 ) = rr( 3 ) Or 1
If (dd( 3 ) And 2 ^ 4 ) > 0 Then rr( 2 ) = rr( 2 ) Or 2 ^ 7
If (dd( 3 ) And 2 ^ 3 ) > 0 Then rr( 2 ) = rr( 2 ) Or 2 ^ 6
If (dd( 3 ) And 2 ^ 2 ) > 0 Then rr( 2 ) = rr( 2 ) Or 2 ^ 5
If (dd( 3 ) And 2 ) > 0 Then rr( 2 ) = rr( 2 ) Or 2 ^ 4
If (dd( 3 ) And 1 ) > 0 Then rr( 2 ) = rr( 2 ) Or 2 ^ 3
If (dd( 2 ) And 2 ^ 7 ) > 0 Then rr( 2 ) = rr( 2 ) Or 2 ^ 2
If (dd( 2 ) And 2 ^ 6 ) > 0 Then rr( 2 ) = rr( 2 ) Or 2
If (dd( 2 ) And 2 ^ 5 ) > 0 Then rr( 2 ) = rr( 2 ) Or 1
str = Chr(rr( 1 )) & Chr(rr( 2 )) & Chr(rr( 3 )) & Chr(rr( 4 )) & Chr(rr( 5 )) & Chr(rr( 6 ))
End If
'
MsgBox RealToDouble(str)
End Sub
Public Function RealToDouble(ByVal Data As String) As Double
Dim dMantissa As Double
Dim i As Integer
Dim j As Long
Dim k As Long
Dim t As Integer
If Len(Data) <> 6 Then
'Err.Raise
'exception
Exit Function
End If
'accumulate the mantissa
dMantissa = 1
For i = 6 To 2 Step - 1
If i = 6 Then
t = 6
Else
t = 7
End If
For j = CLng(t) To 0 Step - 1
k = k + 1
If (Asc(Mid$(Data, i, 1 )) And CLng( 2 ^ j)) <> 0 Then
dMantissa = dMantissa + 2 ^ -k
End If
Next j
Next i
'finally, assemble all the pieces into a number
If (Asc(Mid$(Data, 6 , 1 )) And &H80) = &H80 Then
RealToDouble = -dMantissa * 2 ^ (Asc(Mid$(Data, 1 , 1 )) - 129 )
Else
RealToDouble = dMantissa * 2 ^ (Asc(Mid$(Data, 1 , 1 )) - 129 )
End If
'Thanks for your help
'David
End Function
realTodouble работает ка часы, гдето я это свиснул.
А вот обратно Command1_Click() работает если целая часть>10 иначе почемуто экспонента=2047, те максимально возможному, почему так ???
