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

* Add BinStr

Browse Source
This commit is contained in:
michael 2020-04-25 16:23:30 +00:00
parent 2d309499e9
commit 4ec47938ee
1 changed files with 18 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
packages/rtl/system.pas
View File

@ -92,6 +92,11 @@ type
TDynArrayIndex = NativeInt; TDynArrayIndex = NativeInt;
TTextLineBreakStyle = (tlbsLF,tlbsCRLF,tlbsCR); TTextLineBreakStyle = (tlbsLF,tlbsCRLF,tlbsCR);
TCompareOption = ({coLingIgnoreCase, coLingIgnoreDiacritic, }coIgnoreCase{,
coIgnoreKanaType, coIgnoreNonSpace, coIgnoreSymbols, coIgnoreWidth,
coLingCasing, coDigitAsNumbers, coStringSort});
TCompareOptions = set of TCompareOption;
{***************************************************************************** {*****************************************************************************
TObject, TClass, IUnknown, IInterface, TInterfacedObject TObject, TClass, IUnknown, IInterface, TInterfacedObject
*****************************************************************************} *****************************************************************************}
@ -360,6 +365,7 @@ function Pos(const Search, InString: String; StartAt : Integer): Integer; assemb
procedure Insert(const Insertion: String; var Target: String; Index: Integer); overload; procedure Insert(const Insertion: String; var Target: String; Index: Integer); overload;
function upcase(c : char) : char; assembler; function upcase(c : char) : char; assembler;
function HexStr(Val: NativeInt; cnt: byte): string; external name 'rtl.hexStr'; overload; function HexStr(Val: NativeInt; cnt: byte): string; external name 'rtl.hexStr'; overload;
function binstr(val : int64; cnt : byte) : string;
procedure val(const S: String; out NI : NativeInt; out Code: Integer); overload; procedure val(const S: String; out NI : NativeInt; out Code: Integer); overload;
procedure val(const S: String; out NI : NativeUInt; out Code: Integer); overload; procedure val(const S: String; out NI : NativeUInt; out Code: Integer); overload;
@ -710,6 +716,18 @@ begin
Code:=1; Code:=1;
end; end;
function binstr(val : int64;cnt : byte) : string;
var
i : Integer;
begin
SetLength(Result,cnt);
for i:=cnt downto 1 do
begin
Result[i]:=char(48+val and 1);
val:=val shr 1;
end;
end;
function upcase(c : char) : char; assembler; function upcase(c : char) : char; assembler;
asm asm
return c.toUpperCase(); return c.toUpperCase();