Delphi bytes to word

← →
ZV ©
 
(2011-01-26 17:04)
[0]

Как в Delphi  преобразовать 2 значения Byte в Word. На Си делаю побитовый сдвиг и наложение маски а как это сделать в Delphi? Может есть какая функция или делать так же как и на Си. Может кто покажет пример?

---

← →
sniknik ©
 
(2011-01-26 17:19)
[1]

> Может кто покажет пример?
w:= b;

---

← →
Германн ©
 
(2011-01-26 17:21)
[2]

1. Word1:=Byte1+(Byte2 shl 8)
2. type
 TMyWord = packed record
   case Integer of
     0 : (Byte1, Byte2 : Byte);
     1 : (Word1 : Word);
   end;

---

← →
12 ©
 
(2011-01-26 17:33)
[3]

var
 w:Word;
 b1, b2:Byte;
begin
 b1 := 0;
 b2 := 1;
 asm
   push ax
   mov al, b1
   mov ah, b2
   mov w, ax
   pop ax
 end;
 ShowMessage( IntToStr(w) );

---

← →
sniknik ©
 
(2011-01-26 17:55)
[4]

и еще на конкурс извращенцев…
procedure TForm1.Button1Click(Sender: TObject);
var
 w: Word;
 b: byte absolute w;
begin
 w:= 0;
 b:= $FF;
 ShowMessage(IntToStr(w));
end;

---

← →
Игорь Шевченко ©
 
(2011-01-26 18:17)
[5]

---

← →
Германн ©
 
(2011-01-26 18:20)
[6]

> sniknik ©   (26.01.11 17:55) [4]
>
> и еще на конкурс извращенцев…

Не проходит по условию. Нужно два байта.

---

← →
ZV ©
 
(2011-01-26 19:11)
[7]

---

← →
DiamondShark ©
 
(2011-01-26 19:26)
[8]

мне бы ваши проблемы

---

← →
sniknik ©
 
(2011-01-26 19:28)
[9]

> Не проходит по условию. Нужно два байта.
блин, упустил почему то, и получается фигню нес…
тогда так
var
 w: Word;
 b: array[0..1] of byte absolute w;
begin
 b[0]:= 1;
 b[1]:= 1;
 ShowMessage(IntToStr(w));
end;

---

← →
DiamondShark ©
 
(2011-01-26 19:36)
[10]

---

← →
sniknik ©
 
(2011-01-26 19:48)
[11]

ну или тот же код что в [9] по мотивам asm ([3])
var
 w: Word;
begin
 asm
   mov byte ptr w[0], $01
   mov byte ptr W[1], $01
 end;
 ShowMessage(IntToStr(w));
end;

---

← →
Студент
 
(2011-01-27 04:42)
[12]

---

← →
KilkennyCat ©
 
(2011-01-27 04:55)
[13]

strtoint(inttostr(b1) +inttostr(b2))

---

← →
Студент
 
(2011-01-27 05:39)
[14]

Ну… Вот с «Hex» такое бы сработало…

---

← →
Inovet ©
 
(2011-01-27 05:45)
[15]

> [12] Студент   (27.01.11 04:42)
> А какой будет самым быстрым?

Самый быстрый, который ничего не делает — с рекордом и с массивом, а [10] — это явный кандидат в победители на конкурсе извращенцев.:)))

---

← →
Студент
 
(2011-01-27 06:50)
[16]

Скомпилировал [10]… Неправильно считает… Нужно как-то по другому заполнять масив…
Про [11] говорит мол «Invalid combination of opcode and operands» если пытаться пременную подставить…((
У [13] результат неверный… Нужно через Hex: Word1:=HexToInt(IntToHex(Byte2, 2)+IntToHex(Byte1, 2));

---

← →
Студент
 
(2011-01-27 06:51)
[17]

---

← →
han_malign
 
(2011-01-27 08:41)
[18]

> А какой будет самым быстрым? Случайно не [10]?

— случайно:
Германн ©   (26.01.11 17:21) [2]
1. Word1:=Byte1+(Byte2 shl

— т.к. нет лишних обращений к памяти, а таких регистровых операций — современные CPU хавают по десятку за такт…
Недаром девиз Мелкомягких — «Все что можно пересчитать — лучше не хранить»…

---

← →
RWolf ©
 
(2011-01-27 09:25)
[19]

> Inovet ©   (27.01.11 05:45) [15]
> > [12] Студент   (27.01.11 04:42)> А какой будет самым быстрым?
> Самый быстрый, который ничего не делает — с рекордом и с
> массивом,

Самый быстрый — это сдвиг + OR.

---

← →
Игорь Шевченко ©
 
(2011-01-27 10:30)
[20]

---

← →
Германн ©
 
(2011-01-27 15:10)
[21]

> han_malign   (27.01.11 08:41) [18]
>
>
> > А какой будет самым быстрым? Случайно не [10]?
>
> — случайно:
> Германн ©   (26.01.11 17:21) [2]
> 1. Word1:=Byte1+(Byte2 shl
>
> — т.к. нет лишних обращений к памяти, а таких регистровых
> операций — современные CPU хавают по десятку за такт…
>

Хорошо подумал прежде чем написать такую чушь?
Нахрена нужны какие-то «операции» для того, чтобы всего лишь расположить два байта рядом в памяти???

---

← →
han_malign
 
(2011-01-27 17:40)
[22]

> ты спутал, батя

— я изредка брежу, но редко путаю:program hilo_word;
{$APPTYPE CONSOLE}
{$IF CompilerVersion >= 15.0}
{$WARN UNSAFE_TYPE OFF}
{$WARN UNSAFE_CODE OFF}
{$WARN UNSAFE_CAST OFF}
{$IFEND}
uses
 Windows, SysUtils;

const repeatCount = 10;

type
  TLoHiWord = packed record
  case Integer of
    0 : (Lo, Hi : Byte);
    1 : (value : Word);
  end;

  PByteArray = ^TByteArray;
  TByteArray = array[word]of byte;
  PWordArray = ^TWordArray;
  TWordArray = array[word]of TLoHiWord;

var _ft_start: TFileTime;
procedure _startProfile;
var _ftDumb: TFileTime;
begin
  GetThreadTimes(GetCurrentThread(), _ftDumb, _ftDumb, _ftDumb, _ft_start);

end;
procedure _stopProfile(const title: string);
var _ft_end, _ftDumb: TFileTime;
begin
  GetThreadTimes(GetCurrentThread(), _ftDumb, _ftDumb, _ftDumb, _ft_end);
  WriteLn(title:10,": ", _ft_end.dwHighDateTime - _ft_start.dwHighDateTime, ".", _ft_end.dwLowDateTime - _ft_start.dwLowDateTime:10, " x 100ns" );
end;

var rgwLookup: array[byte,byte]of word;
var
   pbl, pbh: PByteArray;
   pw: PWordArray;
   alloc, base, i, cnt: cardinal;
   si: TSystemInfo;
begin
  alloc:= 0;
  if( ParamCount > 0 )then alloc:= StrToIntDef(ParamStr(1), 0);
  if( alloc = 0 )then alloc:= 1024*1024*1024;

  GetSystemInfo(si);
  inc(alloc, cardinal(-alloc) mod si.dwAllocationGranularity);

  pbl:= PByteArray(VirtualAlloc(nil, alloc, MEM_COMMIT, PAGE_READWRITE));
  if( pbl = nil )then begin
     Writeln("Alloc failed - ", GetLastError());
  end;
  //prepare lookup table
  for i:= 0 to $FFFF do PWordArray(@rgwLookup)[i].value:= i;

  base:= alloc div 4;
  Write("GO"#13);
  _startProfile;
  for cnt:= 1 to repeatCount do begin
     for i:= 0 to base - 1 do PWordArray(pbl)[i].value:= Random(65536);
     Write(cnt:2,#13);
  end;
  _stopProfile("Random");

  pbh:= PByteArray(@pbl[base]);
  pw:= PWordArray(@pbh[base]);

  _startProfile;
  for cnt:= 1 to repeatCount do begin
     for i:= 0 to base - 1 do pw[i].value:= (pbh[i] shl 8) or pbl[i];
     Write(cnt:2,#13);
  end;
  _stopProfile("Combine");

  _startProfile;
  for cnt:= 1 to repeatCount do begin
     for i:= 0 to base - 1 do with pw[i] do begin
        lo:= pbl[i];
        hi:= pbh[i];
     end;
     Write(cnt:2,#13);
  end;
  _stopProfile("Direct");

  _startProfile;
  for cnt:= 1 to repeatCount do begin
     for i:= 0 to base - 1 do pw[i].value:= rgwLookup[pbl[i], pbh[i]];
     Write(cnt:2,#13);
  end;
  _stopProfile("Lookup");

  _startProfile;
  for cnt:= 1 to repeatCount do begin
     move(pbl^, pw^, base*2);
     Write(cnt:2,#13);
  end;
  _stopProfile("just copy");

  VirtualFree(pbl, 0, MEM_RELEASE);
end.

——————————————————
   Random: 0. 106406250 x 100ns
  Combine: 0.  52500000 x 100ns
   Direct: 0.  55781250 x 100ns
   Lookup: 0.  91406250 x 100ns
just copy: 0.  33125000 x 100ns


---

← →
Игорь Шевченко ©
 
(2011-01-27 18:12)
[23]

---

← →
Игорь Шевченко ©
 
(2011-01-27 18:13)
[24]

program BtoWProfile;
{$APPTYPE CONSOLE}
{$IF CompilerVersion >= 15.0}
{$WARN UNSAFE_TYPE OFF}
{$WARN UNSAFE_CODE OFF}
{$WARN UNSAFE_CAST OFF}
{$IFEND}
uses
 Windows,
 SysUtils;

const repeatCount = 10;

type
 TLoHiWord = packed record
 case Integer of
   0 : (Lo, Hi : Byte);
   1 : (value : Word);
 end;

 PByteArray = ^TByteArray;
 TByteArray = array[word]of byte;
 PWordArray = ^TWordArray;
 TWordArray = array[word]of TLoHiWord;

var _ft_start: TFileTime;
procedure _startProfile;
var _ftDumb: TFileTime;
begin
 GetThreadTimes(GetCurrentThread(), _ftDumb, _ftDumb, _ftDumb, _ft_start);

end;
procedure _stopProfile(const title: string);
var _ft_end, _ftDumb: TFileTime;
begin
 GetThreadTimes(GetCurrentThread(), _ftDumb, _ftDumb, _ftDumb, _ft_end);
 WriteLn(title:10,": ", _ft_end.dwHighDateTime - _ft_start.dwHighDateTime, ".", _ft_end.dwLowDateTime - _ft_start.dwLowDateTime:10, " x 100ns" );
end;

var rgwLookup: array[byte,byte]of word;
var
  pbl, pbh: PByteArray;
  pw: PWordArray;
  alloc, base, i, cnt: cardinal;
  si: TSystemInfo;
begin
 alloc:= 0;
 if( ParamCount > 0 )then alloc:= StrToIntDef(ParamStr(1), 0);
 if( alloc = 0 )then alloc:= 256*1024*1024;

 GetSystemInfo(si);
 inc(alloc, cardinal(-alloc) mod si.dwAllocationGranularity);

 pbl:= PByteArray(VirtualAlloc(nil, alloc, MEM_COMMIT, PAGE_READWRITE));
 if( pbl = nil )then begin
    Writeln("Alloc failed - ", GetLastError());
 end;
 //prepare lookup table
 for i:= 0 to $FFFF do PWordArray(@rgwLookup)[i].value:= i;

 base:= alloc div 4;
 Write("GO"#13);

   pbh:= PByteArray(@pbl[base]);
 pw:= PWordArray(@pbh[base]);

 _startProfile;
 for cnt:= 1 to repeatCount do begin
    for i:= 0 to base - 1 do pw[i].value:= (pbh[i] shl 8) or pbl[i];
    Write(cnt:2,#13);
 end;
 _stopProfile("Combine");

 _startProfile;
 for cnt:= 1 to repeatCount do begin
    move(pbl^, pw^, base*2);
    Write(cnt:2,#13);
 end;
 _stopProfile("just copy");

 _startProfile;
 for cnt:= 1 to repeatCount do begin
    for i:= 0 to base - 1 do pw[i].value:= rgwLookup[pbl[i], pbh[i]];
    Write(cnt:2,#13);
 end;
 _stopProfile("Lookup");

 _startProfile;
 for cnt:= 1 to repeatCount do begin
    for i:= 0 to base - 1 do PWordArray(pbl)[i].value:= Random(65536);
    Write(cnt:2,#13);
 end;
 _stopProfile("Random");

 _startProfile;
 for cnt:= 1 to repeatCount do begin
    for i:= 0 to base - 1 do with pw[i] do begin
       lo:= pbl[i];
       hi:= pbh[i];
    end;
    Write(cnt:2,#13);
 end;
 _stopProfile("Direct");

 VirtualFree(pbl, 0, MEM_RELEASE);
end.

---

← →
han_malign
 
(2011-01-27 18:27)
[25]

>    Lookup: 0.  15156250 x 100ns
>    Random: 0.  25625000 x 100ns

— молодец, но даже учитывая, что тест всегда обращается к rgwLookup[0, 0], поскольку память инициализирована нулями — таблица все равно самый плохой вариант…

---

← →
han_malign
 
(2011-01-27 18:33)
[26]

и естественно — все Page Fault достались Combine…

---

← →
Игорь Шевченко ©
 
(2011-01-27 18:39)
[27]

---

← →
Inovet ©
 
(2011-01-27 19:54)
[28]

> [18] han_malign   (27.01.11 08:41)

> [19] RWolf ©   (27.01.11 09:25)
> Самый быстрый — это сдвиг + OR.

Это в произвольном случае, а когда надо всё время и так и так обращаться, то лучше ничего не делать а сразу организовать хранение рядом, я об этом говорил. Хотя как оно там будет на каком железе должно

> [20] Игорь Шевченко ©   (27.01.11 10:30)
> подкрепляются тестовыми измерениями

---

← →
han_malign
 
(2011-01-28 09:02)
[29]

---

← →
12 ©
 
(2011-01-28 09:44)
[30]

> han_malign   (27.01.11 17:40) [22]


> Игорь Шевченко ©   (27.01.11 18:13) [24]

вы — маньяки

---

← →
han_malign
 
(2011-01-28 09:45)
[31]

И о главном: почему опасно пользоваться приведением типа для доступа к битовым полям(в Delphi, в C — все порадужней), и когда таблица таки выгодна…
(посвящается структуре TRGBQuad)
program hilo_word;
{$APPTYPE CONSOLE}
{$IF CompilerVersion >= 15.0}
{$WARN UNSAFE_TYPE OFF}
{$WARN UNSAFE_CODE OFF}
{$WARN UNSAFE_CAST OFF}
{$IFEND}
uses
 Windows, SysUtils;

const repeatCount = 10;

type
  TLoHiWord = packed record
  case Integer of
    0 : (Lo, Hi : Byte);
    1 : (value : Word);
  end;
  PLoHiWord = ^TLoHiWord;

  PByteArray = ^TByteArray;
  TByteArray = array[word]of byte;
  PWordArray = ^TWordArray;
  TWordArray = array[word]of word;

var _ft_start: TFileTime;
procedure _startProfile;
var _ftDumb: TFileTime;
begin
  GetThreadTimes(GetCurrentThread(), _ftDumb, _ftDumb, _ftDumb, _ft_start);

end;
procedure _stopProfile(const title: string);
var _ft_end, _ftDumb: TFileTime;
begin
  GetThreadTimes(GetCurrentThread(), _ftDumb, _ftDumb, _ftDumb, _ft_end);
  WriteLn(title:10,": ", _ft_end.dwHighDateTime - _ft_start.dwHighDateTime, ".", _ft_end.dwLowDateTime - _ft_start.dwLowDateTime:10, " x 100ns" );
end;

function TRANSFORM(val: word): word;
begin
  //ну пускай будет BGR16 в BGR15
  Result:= val and $1F or (val shr 1) and $7FE;
end;

const _title: array[0..2]of string = ("Combine", "Cast", "Map");

var rgwLookup: array[byte,byte]of word;
var
   pbl, pbh: PByteArray;
   pw: PWordArray;
   alloc, base, i, cnt: cardinal;
   si: TSystemInfo;
   _b2w: TLoHiWord;
   choice: integer;
   _hitChoice: array[0..2]of integer;
   fdwDoneChoice: LongWord;
begin
  alloc:= 0;
  if( ParamCount > 0 )then alloc:= StrToIntDef(ParamStr(1), 0);
  if( alloc = 0 )then alloc:= 1024*1024*1024;

  GetSystemInfo(si);
  inc(alloc, cardinal(-alloc) mod si.dwAllocationGranularity);

  pbl:= PByteArray(VirtualAlloc(nil, alloc, MEM_COMMIT, PAGE_READWRITE));
  if( pbl = nil )then begin
     Writeln("Alloc failed - ", GetLastError());
  end;
  //prepare lookup table
  for i:= 0 to $FFFF do PWordArray(@rgwLookup)[i]:= TRANSFORM(i);

  base:= alloc div 4;
  Write("GO"#13);
  _startProfile;
  for i:= 0 to base*2 - 1 do PWordArray(pbl)[i]:= Random(65536);
  _stopProfile("Random");

  pbh:= PByteArray(@pbl[base]);
  pw:= PWordArray(@pbh[base]);

  FillChar(_hitChoice, sizeof(_hitChoice), 0);
  fdwDoneChoice:= 0;

  while( fdwDoneChoice <> 7 )do begin
     //дабы никому не пришло в голову упрекнуть меня в предвзятости
     choice:= Random(3);
     inc(_hitChoice[choice]);
     if( _hitChoice[choice] > 2 )then fdwDoneChoice:= fdwDoneChoice or (1 shl choice);
     _startProfile;
     for cnt:= 1 to repeatCount do begin
        case(choice)of
        0: for i:= 0 to base - 1 do pw[i]:= TRANSFORM((pbh[i] shl 8) or pbl[i]);
        1: for i:= 0 to base - 1 do with _b2w do begin
           lo:= pbl[i];
           hi:= pbh[i];
           pw[i]:= TRANSFORM(value);
        end;
        2: for i:= 0 to base - 1 do pw[i]:= rgwLookup[pbl[i], pbh[i]];
        end;
        Write(cnt:2,#13);
     end;
     _stopProfile(_title[choice]);
  end;

  VirtualFree(pbl, 0, MEM_RELEASE);
end.

—————————————
     Cast: 0. 274687500 x 100ns
      Map: 0.  90000000 x 100ns
  Combine: 0. 141250000 x 100ns
  Combine: 0. 141250000 x 100ns
     Cast: 0. 275000000 x 100ns
     Cast: 0. 275000000 x 100ns
      Map: 0.  89843750 x 100ns
  Combine: 0. 141250000 x 100ns
      Map: 0.  90000000 x 100ns

---

← →
RWolf ©
 
(2011-01-28 10:20)
[32]

---

← →
RWolf ©
 
(2011-01-28 10:28)
[33]

или смысл в том, чтобы загнать тест в свопы?

---

← →
uniken1 ©
 
(2011-01-31 08:04)
[34]

> и еще на конкурс извращенцев…

Интересно на какое место попадет функция
TwoByteToWord из Indy модуль(IdGlobal)? Собственный динамический массив с изменением размера и с двойным преобразованием.
Появляются подозрения, что Indy не очень-то оптимальна по производительности.

---

← →
Anatoly Podgoretsky ©
 
(2011-01-31 08:48)
[35]

---

← →
sniknik ©
 
(2011-01-31 09:28)
[36]

---

← →
Anatoly Podgoretsky ©
 
(2011-01-31 11:22)
[37]

---

These functions are useful:

function MakeWord(low, high: char): word;
begin
  result := byte(high) shl 8 + byte(low);
end; 

function MakeWord(low, high: byte): word;
begin
  result := high shl 8 + low;
end; 

However I am wondering if these kinds of functions (could be implemented differently) already exist somewhere (not in a windows api specific file, but rather a cross platform RTL function).

Example use case: take the two characters GT and make a WORD result out of it.

MakeWord('G','T');

I find this more readable than inserting SHL/SHR AND/OR hex operations and other hacks in the code that do not describe what the code is doing… so surely these functions exist somewhere already? Or do people roll their own in their applications?

Or something like:

var x: word;
begin
  lo(x) := byte('G');
  hi(x) := byte('T');
end;

However, that will not work as the left side cannot be assigned to: but it is more readable, than some other solutions, IMO.

I think I have seen LoWord and HiWord functions too (or LoByte, HiByte) but usually in read only cases. What about writing to the hi and lo?

Нравится ресурс? Помоги проекту!

[ Script execution time: 0,0234 ]   [ 16 queries used ]   [ Generated: 13.04.23, 22:37 GMT ]  

Модераторы: Poseidon, Snowy, bems, MetalFan

Поиск:

 

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)

0 Пользователей:

« Предыдущая тема | Delphi: Общие вопросы | Следующая тема »

Use the built-in SetString command. It sets the string to the required length and copies the bytes. There’s no need for the array to be null-terminated. In fact, if the array has zero—valued bytes in it, they’ll correctly appear within the string; they won’t terminate the string.

SetString(AnsiStr, PAnsiChar(@ByteArray[0]), LengthOfByteArray);

If you have a UnicodeString, then you’ll need to halve the length parameter since it measures characters, not bytes:

SetString(UnicodeStr, PWideChar(@ByteArray[0]), LengthOfByteArray div 2);

See also, Converting TMemoryStream to String in Delphi 2009.