Помогите перевести код с делфи

[студент]

Помогите перевести код с делфи

Код: Выделить всё

function DecodeFloat(D : dword) : single;
var F : single absolute D;
const Mask1 = $FF800000;
      Mask2 = $FF000000;
begin
  D := (D and not Mask1)
        or ((D and Mask2) shr 1);
  result := F;
end;

я попробовал, но чтото у меня результаты несовпадают(

Код: Выделить всё

Function DecodeFloat(ByVal D As long) As single
Dim Mask1 As Long, Mask2 As Long
Mask1 = &HFF800000
Mask2 = &HFF000000
D = (D And Not Mask1) Or ((D And Mask2) \ 2)
DecodeFloat = D
End Function

[Денис]

А может Double a не Long?

[iGrok]

Не. dword - это всё-таки long.
Но у тебя идёт конверт из long в single.
Попробуй вместо присвоения сделать LSet.

Код: Выделить всё


Type UDTLong
  l as Long
End Type

Type UDTSingle
s as Single
End Type

...
Dim ul as UDTLong, us as UDTSingle
ul.l = D
LSet us = ul
DecodeFloat = us.s
...


[Mikle]

Замена shr на целочисленное деление не сработает для отрицательных, кроме того может нарушиться порядок действий.

[iGrok]

О. Кстати, да.

Для этого лучше заюзать SHIFT из modDWORD из кирпичей.

[студент]

все, всем спасибо, разобрался, проблемма была в single absolute D - заменил на CopyMemory
и в Mask1 = &HFF800000, бйсик ее переводил в число -8388608 а не в 4286578688, и Mask2...
сделал так:

Код: Выделить всё

Function DecodeFloat(ByVal D As Long) As Double
Dim Mask1 As Long, Mask2 As Long
Dim b1 As Byte, b2 As Byte, b3 As Byte, b4 As Byte

Mask1 = 8388607
Mask2 = 16777215
D = (D And Mask1) Or ((D And Not Mask2) \ 2)
b1 = CByte(((D) And &HFF000000) / &HFFFFFF)
b2 = CByte(((D) And &HFF0000) / 65535)
b3 = CByte((D And 65280) / &HFF)
b4 = CByte(D And &HFF)

DecodeFloat = Round(HexToFloat4Byte(b1, b2, b3, b4), 4)

End Function

Function HexToFloat4Byte(ByVal b1 As Byte, ByVal b2 As Byte, ByVal b3 As Byte, ByVal b4 As Byte) As Double
Dim uint(3) As Byte
Dim uint2 As Single
'Здесь заполняем их
uint(3) = b1
uint(2) = b2
uint(1) = b3
uint(0) = b4
CopyMemory uint2, uint(0), 4
HexToDecFloat4Byte1 = uint2
End Function

коряво наверное... но работает вроде правильно

[Хакер]

все, всем спасибо, разобрался, проблемма была в single absolute D - заменил на CopyMemory

viewtopic.php?f=68&t=36758

и в Mask1 = &HFF800000, бйсик ее переводил в число -8388608 а не в 4286578688,

Бред, бейсик вообще не занимается такой ерундой, как перевод чисел в десятичную человекопонятную систему счисления.

[студент]

Бред, бейсик вообще не занимается такой ерундой, как перевод чисел в десятичную человекопонятную систему счисления.

возможно,я в бейсике только недавно..., тогда вопрос:
а почему
Mask1 = &HFF800000
Mask2 = &HFF000000
D = (D And Not Mask1) Or ((D And Mask2) \ 2)
не работает(вернее нетот результат выдает который нужен)
а
Mask1 = 8388607
Mask2 = 16777215
D = (D And Mask1) Or ((D And Not Mask2) \ 2)
работает
??

[Хакер]

возможно,я в бейсике только недавно..., тогда вопрос:

А это не только в бейсике, это во всех существующих языках программирования. Никто не конвертирует числа в десятичную форму для того, чтобы выполнить над ними побитовые операции.

Возможную причину уже сказали: целочисленное деление на два не эквивалентно простому битовому сдвигу.

Используй теги для оформления кода, иначе накажем.

[студент]

возможно,я в бейсике только недавно..., тогда вопрос:

А это не только в бейсике, это во всех существующих языках программирования. Никто не конвертирует числа в десятичную форму для того, чтобы выполнить над ними побитовые операции.

Возможную причину уже сказали: целочисленное деление на два не эквивалентно простому битовому сдвигу..

тоесть причина в shr? и ее нуна заменить на

Код: Выделить всё

Public Function SHIFT(ByVal func As ShiftModes, ByVal Value As Long, ByVal BitCount As Long) As Long
  On Error GoTo errh
  SHIFT = CallWindowProc(AsmFunctions(1, func), Value, BitCount, 0, 0)
  Exit Function
 
errh:
  'Это потому, что у модуля нет события инициализации.
  'Можно, конечно, вынести это в процедуру Init. Хум хау.
  ReDim AsmFunctions(1 To 4, 1 To 4)
  AsmFunctions(1, smShiftLeft) = &H8BEC8B55
  AsmFunctions(2, smShiftLeft) = &H458B0C4D
  AsmFunctions(3, smShiftLeft) = &H5DE0D308
  AsmFunctions(4, smShiftLeft) = &H10C2&
 
  AsmFunctions(1, smShiftRight) = &H8BEC8B55
  AsmFunctions(2, smShiftRight) = &H458B0C4D
  AsmFunctions(3, smShiftRight) = &H5DE8D308
  AsmFunctions(4, smShiftRight) = &H10C2&
 
  AsmFunctions(1, smRotateLeft) = &H8BEC8B55
  AsmFunctions(2, smRotateLeft) = &H458B0C4D
  AsmFunctions(3, smRotateLeft) = &HC0A50F08
  AsmFunctions(4, smRotateLeft) = &H10C25D
 
  AsmFunctions(1, smRotateRight) = &H8BEC8B55
  AsmFunctions(2, smRotateRight) = &H458B0C4D
  AsmFunctions(3, smRotateRight) = &HC0AD0F08
  AsmFunctions(4, smRotateRight) = &H10C25D
  Resume
End Function

??? честно я несильно попимаю работу этой функции, непонимаю КАК она чтото делает...

[Хакер]

Эта функция «генерирует» функцию, которая с помощью инструкции процессора SHX делает то, что нужно, то есть сдвиг.

[Хакер]

Вообще, я крайне не советую использовать этот модуль без модификации, делающей его DEP-совместимым.

[студент]

по поводу GetMem4

Код: Выделить всё

Declare Function GetMem4 Lib "msvbvm60" (ByVal pSrc As Long, ByVal pDst As Long) [b]As Long[/b]

а у меня с число с плавающей точкой длиной 4 байта... пока нет бейсика под рукой но надо попробовать какой будет результат

[Хакер]

Последний раз предупреждаю о необходимости оформлять код!

Эта функция ничего не возвращает. Тип возврата указан, чтобы VB не «додумал», что там Variant. Потому что Variant передаётся иначе.

Судя по всему, ты вообще не понял, что это за функция. Ищи, читай.

[iGrok]

Вообще, я крайне не советую использовать этот модуль без модификации, делающей его DEP-совместимым.

Возможно это странно, но у меня на xp sp2 с включенным DEP эта процедурка работает без проблем.

UPD: Ага, осознал. В скомпилированном виде уже не работает.

[студент]

ага, с GetMem4 разобрался, а вот что делать со сдвигом ? что это за чудо модификация?

[Хакер]

Размещать код на странице с E-флагом.Это если модлификацию. Рекомендуется же сделать крохотную библиотеку с функцией.

[iGrok]

Держи последний вариант (библиотека).
Мне как раз вчера то же самое(shift) понадобилось.. )

Код: Выделить всё

Public Declare Function SHL Lib "binutils.dll" (ByVal value As Long, ByVal nbits As Long) As Long
Public Declare Function SHR Lib "binutils.dll" (ByVal value As Long, ByVal nbits As Long) As Long


[студент]

iGrok о круто! спасибо!
а исходничком неподелишся? мне просто хочится сделать более расшириную библу

[iGrok]

Да пожалуйста. Только она на FASM. )

Код: Выделить всё

format PE GUI 4.0 DLL
entry DllEntryPoint

include 'win32a.inc'

section '.text' code readable executable

proc DllEntryPoint hinstDLL,fdwReason,lpvReserved
   mov   eax,TRUE
   ret
endp

proc ShiftLeft dwVal,dwBitCount
    mov   eax, [dwVal]
    mov   ecx, [dwBitCount]
    shl   eax, cl
    ret
endp

proc ShiftRight dwVal,dwBitCount
    mov   eax, [dwVal]
    mov   ecx, [dwBitCount]
    shr   eax, cl
    ret
endp

section '.edata' export data readable

  export 'BINUTILS.DLL',\
    ShiftLeft,'SHL',\
    ShiftRight,'SHR'

section '.reloc' fixups data discardable


З.Ы. Писал для себя, поэтому там хватает косяков.
К примеру, она, конечно, принимает в nbits long, но при сдвиге используется только младший байт nbits.
Меня она в таком виде пока устраивает, потом может перепишу, но тебя на всякий случай предупреждаю.

[студент]

а, пдумал, зачем мучатся, переводить на бейсик, извращаться с этим сдвигом, сделал просто:
на делфях написал дллку в которую засунул всю функцию с 1го поста