126 lines
2.4 KiB
ObjectPascal
126 lines
2.4 KiB
ObjectPascal
program StrInc;
|
|
//increments a positive numerical string in different bases.
|
|
//the string must be preset with a value, length >0 ;
|
|
{$IFDEF WINDOWS}
|
|
{$APPTYPE CONSOLE}
|
|
{$ENDIF}
|
|
{$IFDEF FPC}
|
|
{$Mode Delphi} {$Optimization ON,ALL}{$Align 32}
|
|
uses
|
|
sysutils;
|
|
{$ELSE}
|
|
uses
|
|
system.SysUtils;
|
|
{$ENDIF}
|
|
type
|
|
tMyNumString = Ansistring; //string[31];//
|
|
|
|
function IncLoop(ps: pChar;le,Base: NativeInt):NativeInt;inline;
|
|
//Add 1 and correct carry
|
|
//returns 0, if no overflow, else 1
|
|
var
|
|
dgt: nativeInt;
|
|
Begin
|
|
//convert base to the highest char in base 2 > '1' ;10 -> '9'
|
|
base += Ord('0')-1;
|
|
dec(le);//ps is 0-based
|
|
|
|
result := 0;
|
|
repeat
|
|
dgt := ord(ps[le]);
|
|
IF dgt < base then
|
|
begin
|
|
ps[le] := chr(dgt+1);
|
|
EXIT;
|
|
end;
|
|
ps[le] := '0';
|
|
dec(le);
|
|
until (le<0);
|
|
result:= 1;
|
|
end;
|
|
|
|
procedure IncIntStr(base:NativeInt;var s:tMyNumString);
|
|
var
|
|
le: NativeInt;
|
|
begin
|
|
le := length(s);
|
|
//overflow -> prepend a '1' to string
|
|
if (IncLoop(pChar(@s[1]),le,base) <>0) then
|
|
Begin
|
|
// s := '1'+s;
|
|
setlength(s,le+1);
|
|
move(s[1],s[2],le);
|
|
s[1] := '1';
|
|
end;
|
|
end;
|
|
|
|
procedure IncMyString(var NumString: tMyNumString);
|
|
var
|
|
i: integer;
|
|
f_code: word;
|
|
begin
|
|
// string to num
|
|
val(Numstring,i,f_code);
|
|
//num to string
|
|
if f_code= 0 then
|
|
str(i+1,NumString);
|
|
end;
|
|
|
|
procedure IncMyStringOrg(var NumString: tMyNumString);
|
|
var
|
|
i: integer;
|
|
begin
|
|
readStr(NumString, i);
|
|
writeStr(NumString, succ(i));
|
|
end;
|
|
|
|
const
|
|
strLen = 26;
|
|
MAX = 1 shl strLen -1;
|
|
|
|
var
|
|
s : tMyNumString;
|
|
i,base : nativeInt;
|
|
T0: TDateTime;
|
|
Begin
|
|
writeln(MAX,' increments in base');
|
|
For base := 2 to 10 do
|
|
Begin
|
|
//s := '0' doesn't work
|
|
setlength(s,1);
|
|
s[1]:= '0';
|
|
{ //Zero pad string
|
|
setlength(s,strLen);fillchar(s[1],strLen,'0');
|
|
}
|
|
T0 := time;
|
|
For i := 1 to MAX do
|
|
IncIntStr(Base,s);
|
|
T0 := (time-T0)*86400;
|
|
if base = 10 then
|
|
writeln(' IncAnsiString '); ;
|
|
writeln(s:strLen,' base ',base:2,T0:8:3,' s');
|
|
end;
|
|
|
|
writeln(' val -> str ');
|
|
setlength(s,1);
|
|
s[1]:= '0';
|
|
T0 := time;
|
|
For i := 1 to MAX do
|
|
IncMyString(s);
|
|
T0 := (time-T0)*86400;
|
|
writeln(s:strLen,' base ',10:2,T0:8:3,' s');
|
|
|
|
writeln(' readstr -> writestring ');
|
|
setlength(s,1);
|
|
s[1]:= '0';
|
|
T0 := time;
|
|
For i := 1 to MAX do
|
|
IncMyStringOrg(s);
|
|
T0 := (time-T0)*86400;
|
|
writeln(s:strLen,' base ',10:2,T0:8:3,' s');
|
|
|
|
s:='';
|
|
{$IFDEF WINDOWS}
|
|
readln;
|
|
{$ENDIF}
|
|
end.
|