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

Just another update

Browse source
This commit is contained in:
Ingy döt Net 2015-02-20 00:35:01 -05:00
parent a25938f123
commit 00a190b0a6
6591 changed files with 94363 additions and 23227 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -1,4 +1,37 @@
function IntToBinStr(AInt : integer) : string;
{$IFDEF FPC}
{$MODE DELPHI}
{$OPTIMIZATION ON,Regvar,ASMCSE,CSE,PEEPHOLE}
{$ELSE}
{$APPTYPE CONSOLE}
{$ENDIF}
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;
function IntToBinStr(AInt : LongWord) : string;
begin
Result := '';
repeat
@ -9,7 +42,24 @@ end;
procedure Binary_Digits;
begin
writeln(' 5: '+IntToBinStr(5));
writeln(' 50: '+IntToBinStr(50));
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);
end.