paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 21:49:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Spaces version improved.

Browse Source 
git-svn-id: trunk@8780 -
This commit is contained in:
marco 2007-10-13 19:40:16 +00:00
parent f66916fc95
commit a43e03f6c0
1 changed files with 26 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
rtl/objpas/strutils.pp
View File

@ -1304,21 +1304,40 @@ begin
end; end;
end; end;
{$implicitexceptions off}
function intToBin(Value: Longint; Digits, Spaces: Integer): string; function intToBin(Value: Longint; Digits, Spaces: Integer): string;
var endpos : integer;
p,p2:pchar;
k: integer;
begin begin
Result:=''; Result:='';
if (Digits>32) then if (Digits>32) then
Digits:=32; Digits:=32;
while (Digits>0) do if (spaces=0) then
begin
result:=inttobin(value,digits);
exit;
end;
endpos:=digits+ (digits-1) div spaces;
setlength(result,endpos);
p:=@result[endpos];
p2:=@result[1];
k:=spaces;
while (p>=p2) do
begin begin
if (Digits mod Spaces)=0 then if k=0 then
Result:=Result+' '; begin
Dec(Digits); p^:=' ';
Result:=Result+intToStr((Value shr Digits) and 1); dec(p);
end; k:=spaces;
end;
p^:=chr(48+(cardinal(value) and 1));
value:=cardinal(value) shr 1;
dec(p);
dec(k);
end;
end; end;
{$implicitexceptions off}
function intToBin(Value: Longint; Digits:integer): string; function intToBin(Value: Longint; Digits:integer): string;
var p,p2 : pchar; var p,p2 : pchar;
begin begin