aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

2016 Update

Browse source
This commit is contained in:
Tina Müller 2016-12-05 22:15:40 +01:00
parent 948b86eafa
commit dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions
Download patch file Download diff file Expand all files Collapse all files

58
Task/Binary-digits/Delphi/binary-digits.delphi
View file

@ -1,35 +1,7 @@
{$IFDEF FPC}
{$MODE DELPHI}
{$OPTIMIZATION ON,Regvar,ASMCSE,CSE,PEEPHOLE}
{$ELSE}
{$APPTYPE CONSOLE}
{$ENDIF}
program BinaryDigit;
{$APPTYPE CONSOLE}
uses
sysutils; //only for timing
function IntToBinStrNew(AInt : LongWord):string;
const
IO : array[0..1] of char = ('.','X');
var
idx,m : LongWord;
pC : pChar;
begin
IF AInt = 0 then Begin
result := IO[0];EXIT;end;
// search for the first set bit
idx:= 32;m := 1 shl (idx-1);
While ORD((AInt AND m) = 0)+ORD(m>0) = 2 do begin
dec(idx);m := m shr 1;end;
//set right length and insert one by one
setlength(result,idx);
pC := @result[1];
repeat
pC^ := IO[ORD((AInt and m) <> 0)];
m := m shr 1;
inc(pC);
until m=0;
end;
sysutils;
function IntToBinStr(AInt : LongWord) : string;
begin
@ -40,26 +12,8 @@ begin
until (AInt = 0);
end;
procedure Binary_Digits;
begin
writeln(' 5: ',IntToBinStr(5));
writeln(' 5: ',IntToBinStrNew(5));
writeln(' 50: ',IntToBinStr(50));
writeln(' 50: ',IntToBinStrNew(50));
writeln('9000: '+IntToBinStr(9000));
writeln('9000: '+IntToBinStrNew(9000));
end;
var
i: LongInt;
t :TDateTime;
Begin
Binary_Digits;
//speed test
t := time;
For i := 1 to 10*1000*1000 do
IntToBinStrNew(i);t := time-t; Writeln(' New ',t*86400.0:6:3);
t := time;
For i := 1 to 10*1000*1000 do
IntToBinStr(i);t := time-t; Writeln(' Old ',t*86400.0:6:3);
writeln(' 5: ',IntToBinStr(5));
writeln(' 50: ',IntToBinStr(50));
writeln('9000: '+IntToBinStr(9000));
end.