unit stru;{string related methods; in  sys .dll strproc}
{$I define.pas}
interface
uses
{$IFNDEF WINDOWS}
  {dos,}
{$ENDIF}
{$IFDEF WIN32}
  SysUtils,
{$ENDIF}
  mytype;

function IsNumber(s:string):boolean;
function IntToString(i:longint;len:integer): string;{$IFDEF PMODE}export;{$ENDIF}
function IToS(i:longint;len:integer):string;

{ $IFNDEF WIN32}
function IntToStr(i:LongInt):string;{$IFDEF PMODE}export;{$ENDIF}
function StrToInt(s:string):LongInt;{$IFDEF PMODE}export;{$ENDIF}
{ $ENDIF}

function IToZS(i:longint; len:byte):string;
 { integer to left zero padded string }
function RToS(re:real;len,dec:byte):string;

function RealToString(R:Real; Len, Dec:integer):string;{$IFDEF PMODE}export;{$ENDIF}

function FloatToRoundStr(Value: extended; ValidDigits: integer; EFromExpValue: integer): string;
  { Returns string representation of the Value rounded to ValidDigits,
    for abs(exponent number) >= EFromExpValue the value will be
    in scientific notation (with E) }

function SToR(st:STRING):real;
function StringToReal(const S:string):real;{$IFDEF PMODE}export;{$ENDIF}
{strproc}

function Pad(s: string; Len: integer) : string;{$IFDEF PMODE}export;{$ENDIF}
 { Pads a string to a specified length, by adding spaces right;
  Cuts to Len if lengt(st) > len) }

function Lpad(const st: string; len: integer): string;{$IFDEF PMODE}export;{$ENDIF}
 { Spaces left }

function PadString(ps:TPadString; S:String; Len:integer):string;
{ Podle ps prov d¡ operace: psLPad, psPad, psCenter, psRight, psLeft,
  psRZero, psLZero  result has ALWAYS length = Len }
{$IFDEF PMODE}export;{$ENDIF}

function AdjustWidth(st:string; len:byte):string;
 { Cuts or pads string to get len width string }
function RPos(ch:char;s:string):byte;
 { On what position from the right ch char is located }
function RZero(st:string;len:byte):string;
 { Append 0 from right to st until len reached }
function Right(st:STRING; i:integer):string;
 { Returns i chars from right }
function Left(st:string; i:byte):string;
 { Returns i chars from left }

procedure IgnoreChars(delimset:setofchar; var strng:string;
  posp:integer; forw:boolean);
{ Removes from strng all chars included in delimset
  (starting from posp position in strng forward or back)}

function FindWord(delimset:setofchar;strng:string;
                                    var posp:integer;forw:boolean):string;
{ vraci retezec nepreruseny oddelovaci a novou posici ukazatele ve stringu,
  pripadne je-li posp mimo rozsah vraci '' a posp=0}

function FSubs(delim:char;strn:string;
                      var posp:integer;forw:boolean):string;
{vraci substring mezi od posp po prvni oddelovac(bez oddelovace), posune posp
 za tento oddelovac; lze hledat i dozadu; pro posp mimo rozsah vraci '' a
  posp=0}

function pospos(ch:string ;strng:string;
                            var posp:integer;forw:boolean):integer;
{hleda posici vyskytu stringu ch v stringu strng od posice posp, i vzad}

function FiWo(delim:char;strn:string;
                     var posp:integer;forw:boolean):string;

function LTrim(strn:string):string;{$IFDEF PMODE}export;{$ENDIF}

function RTrim(strn:string):string;{$IFDEF PMODE}export;{$ENDIF}

{$IFNDEF WIN32}
function Trim(strn:string):string;{$IFDEF PMODE}export;{$ENDIF}
{$ENDIF}
function TrimLZero(s:string):string;

function RepeatChar(ch:char;len:integer):string;{$IFDEF PMODE}export;{$ENDIF}

function Replace(oldsubstr, newsubstr, s:string):string;{$IFDEF PMODE}export;{$ENDIF}
{replaces all occurrences
 of oldsubstr in s by newsubst and returns the result}

function LZero(st:string;len:integer):string;

function Center(st:string;len:integer):string;
{centruje string mezerami z obou stran}

function USUppcase(st:string):string;{$IFDEF PMODE}export;{$ENDIF}

function DelTilde(s:string):string;{$IFDEF PMODE}export;{$ENDIF}
function FixString(fs:TFixString; s:string):string;{$IFDEF PMODE}export;{$ENDIF}

function InsertSpacesIntoMultiWordName(const AText: string): string;
{ e.g. from "InsertSpaces" makes "Insert Spaces" }


(*
procedure FreePString(PointerToPString:pointer);
function SetString(var APString:PString; AString:string):boolean;
function GetString(APString:PString):string;{returns '' for nil, otherwise APString^}
function ConvStreamName(AFileName:PathStr):PathStr;
*)

implementation
{$IFDEF WIN32}
{$HINTS OFF}
{$ENDIF}

function isNumber(s:string):boolean;
var
  code:integer;
  r:real;
begin
  val(s, r, code);
  isNumber := (code = 0);
end;
  {$IFDEF WIN32}
  {$HINTS ON}
  {$ENDIF}

function inttostring{(i,len:integer):string};
var
  st:string;
begin
  if len<=0 then
    str(i, st)
  else
    str(i:len,st);
  inttostring:=st;
end;

function itos;begin itos:=inttostring(i,len);end;

{ $IFNDEF WIN32}
function IntToStr(i:Longint):string;
var s:string;
begin
  str(i, s);
  IntToStr := s;
end;

function StrToInt(s:string):Longint;
var
  code:integer;
  i:longint;
begin
  val(s, i, code);
  if code <> 0 then
    i := 0;
  StrToInt := i;
end;
{ $ENDIF}

function itozs(i:longint;len:byte):string;{integer to left zero padded string}
var st:string;
begin
  str(i:len,st);
  i := 1;
  while (i <= length(st)) and (st[i] = ' ') do begin
    st[i] := '0';
    inc(i);
  end;
  itozs := st;
end;

const spacechar = ' ';
  (*
function Pad{(st :string; Len : byte) : string};
{ Pads a string to a specified length }
var b:byte absolute st;
begin
  if (Len < 0) then
    Len := 0
  else if (Len > 255) then
    Len := 255;
  while b < len do st := st + spacechar;
{writeln(' v mylib.pad b(tj. delka pro prid. space char=',b);readln;}
{$IFNDEF GHWORK}
  if b>len then st:=copy(st,1,len);
{$ENDIF}
{  b:=len-ord(st[0]);
  if b>0 then begin
    fillchar(st[succ(ord(st[0]))],w,spacechar);
    st[0]:=chr(len);
  end;
}
  Pad := st;
end;
*)
{ from btfiler net..}
function Pad(S : String; Len : Integer) : String;
begin
  if Length(S) > Len then
    SetLength(S, Len)
  else
    S := S + RepeatChar(' ', Len - Length(S));
  Pad := S;
end;

function Lpad{(const st:string;len:byte):string};
var
  s:string;
  l:byte;
begin
  s:='';
  l:=length(st);
  if l<len then begin
    l := len - l;
    FillChar(s[1], l, spacechar);
    {$IFDEF WIN32}
    SetLength(s, l);
    {$ELSE}
    s[0] := chr(l);
    {$ENDIF}
    LPad := s + st;
  end else if l > len then begin
    LPad := copy(st, l - len + 1, len);
  end else
    LPad := st;
end;

function PadString(ps:TPadString; S:String; Len:integer):string;
{ Podle ps prov d¡ operace: psLPad, psPad, psCenter, psRight, psLeft,
  psRZero, psLZero  result has ALWAYS length = Len }
begin
  PadString := S;
  case ps of
    psPad : PadString := Pad(S, Len);
    psLPad : PadString := LPad(S, Len);
    psCenter : PadString := Center(S, Len);
    psRight : PadString := Right(S, Len);
    psLeft : PadString := Left(S, Len);
    psRZero : PadString := RZero(S, Len);
    psLZero : PadString := LZero(S, Len);
  end;
end;

function AdjustWidth(st:string; len:byte):string;{cuts or pads string to get len width string}
begin
  if length(st) > len then
    AdjustWidth := system.copy(st, 1, len)
  else if length(st) < len then
    AdjustWidth := pad(st, len)
  else
    AdjustWidth := st;
end;

function rpos(ch:char;s:string):byte;
var p:byte;
begin
  p := length(s);
  while (p > 0) and (s[p] <> ch) do dec(p);
  rpos := p;
end;


function rzero{(st:string;len:byte):string};
{pridava ke stringu 0 zprava do delky stringu len}
begin while length(st)<len do st:=st+'0';rzero:=st end;

function right(st:STRING; i:integer):string;
         {vraci i znaku zprava}
var l:integer;
begin
  l:=length(st);if l<=i then right:=st else right:=copy(st,l-i+1,i);
end;

function left(st:string; i:byte):string;
begin
  left := copy(st, 1, i);
end;


function rtos;
var st:string;
begin
  str(re:len:dec, st);
  rtos := st;
end;

function RealToString(R:Real; Len, Dec:integer):string;
var
  st:string[20];
begin
  if Len > 0 then
    str(R:Len:Dec, st)
  else
    str(R, st);
  RealToString := st;
end;

function stor{(st:STRING):real};
var i:integer;r:real;
begin
 val(st,r,i);stor:=r;
end;
function StringToReal(const S:string):real;
var i:integer;r:real;
begin
  val(s,r,i);
  StringToReal := r;
end;


procedure ignorechars{(delimset:setofchar;var strng:string;posp:integer;
                       forw:boolean)};
{vypousti ze stringu strng chary obsazene v delimsetu (od posice posp vpred
 nebo vzad)}
var i:integer;
begin
  if posp<=0 then posp:=1;
  i:=length(strng);if posp>i then posp:=i;i:=posp;
  while i>0 do begin
    if forw then begin
      if strng[i] in delimset then delete(strng,i,1) else i:=succ(i);
    end else begin
      if strng[i] in delimset then delete(strng,i,1);
      i:=pred(i);
    end;
    if ((i>length(strng)) or (length(strng)=0)) then i:=0;
  end;
end;


function FindWord{(delimset:setofchar;strng:string;
                                    var posp:integer;forw:boolean):string};
{ vraci retezec nepreruseny oddelovaci a novou posici ukazatele ve stringu,
  pripadne je-li posp mimo rozsah vraci '' a posp=0}
type chtype=string[1];
var help:string;
    ch:char; st:chtype; lenstr:integer;
begin {FIndWord}
  help:='';
  lenstr:=length(strng);
  if ((posp<1) or (posp>lenstr)or (lenstr=0)) then posp:=0 else begin
    repeat
      st:=copy(strng,posp,1); ch:=st[1];
      if forw then  posp:=succ(posp) else posp:=pred(posp);
    until ((not (ch in delimset )) or (posp>lenstr) or (posp<1));
    if posp>lenstr then posp:=succ(posp);if posp=0 then posp:=-1;
    while ((not ( ch in delimset )) and (posp<=lenstr) and (posp>=1)) do begin
      if forw then help:=help+ch else help:=ch+help;
      st:=copy(strng,posp,1); ch:=st[1];
      if forw then posp:=succ(posp) else posp:=pred(posp);
    end;
    if not(ch in delimset) then
    if forw then help:=help+ch else help:=ch+help else
    if forw then posp:=pred(posp) else posp:=succ(posp);
    if posp>lenstr then posp:=0;if posp<1 then posp:=0;
  end;
  FindWord:=help;
end;{FindWord}

function FSubs{(delim:char;strn:string;
                      var posp:integer;forw:boolean):string};
{vraci substring mezi od posp po prvni oddelovac(bez oddelovace), posune posp
 za tento oddelovac; lze hledat i dozadu; pro posp mimo rozsah vraci '' a
  posp=0}
 var st:string[1];lenstr:integer;help:string;
begin {FSubs}
  help:=''; lenstr:=length(strn);
  if not(posp in [1..lenstr]) then posp:=0 else begin
    repeat
      st:=copy(strn,posp,1);
      if forw then posp:=succ(posp) else posp:=pred(posp);
      if (st[1]<>delim) then if forw then help:=help+st else help:=st+help;
    until ((st[1]=delim) or not(posp in [1..lenstr]));
    if not(posp in [1..lenstr]) then posp:=0;
  end;
fsubs:=help;
end;{FSubs}


function USUppcase(st:string):string;
var i:byte;
begin
  for i:=1 to length(st) do st[i]:=upcase(st[i]);
  USUppcase:=st;
end;

function pospos{(ch:string ;strng:string;
                            var posp:integer;forw:boolean):integer};
{hleda posici vyskytu stringu ch v stringu strng od posice posp, i vzad}
var help:string; a,i:integer;
begin{pospos}
  if ((posp<1) or (posp>length(strng)) or (length(ch)>length(strng))) then
  begin posp:=0;pospos:=0 end
  else
    begin
    if forw then begin
      help:=copy(strng,posp,length(strng)-pred(posp));
      a:=pos(ch,help);
      if a<>0 then begin
        pospos:=a+pred(posp);posp:=a+pred(posp)+length(ch);
        if posp>length(strng) then posp:=0;
      end
      else begin pospos:=a;posp:=0 end;
    end
    else begin
      i:=1; help:=copy(strng,posp,i); a:=0;
      while ((posp>0) and (a=0)) do begin
        a:=pos(ch,help); posp:=pred(posp);i:=succ(i);
        if posp>0 then help:=copy(strng,posp,i) ;
      end;
      if a<>0 then pospos:=succ(posp) else pospos:=0;
    end;
  end;
end;{pospos}

function FiWo{(delim:char;strn:string;
                     var posp:integer;forw:boolean):string};
var i:integer;help:string;
begin
  i:=1; help:=Fsubs(delim,strn,posp,forw);
  fiwo:=findword([spacechar],help,i,forw);
end;

function Ltrim{(strn:string):string};
var i,j:byte;
begin
  j:=1;i:=length(strn);
  if i=0 then ltrim:='' else begin
    while ((strn[j]=spacechar) and (j<=i)) do j:=succ(j);
    if j>i then ltrim:='' else ltrim:=copy(strn,j,succ(i)-j);
  end;
end;

function Rtrim{(strn:string):string};
var i:byte absolute strn;
begin
{
  j:=length(strn);
  if j=0 then rtrim:='' else begin
    while ((strn[j]=spacechar) and (j>=1)) do j:=pred(j);
    if j=0 then rtrim:='' else rtrim:=copy(strn,1,j);
  end;
}
  while (strn[i] = ' ') and (i > 0)  do dec(i);
  rtrim:= strn;
end;

{$IFNDEF WIN32}
function Trim{(strn:string):string};
begin
  trim := ltrim(rtrim(strn));
end;
{$ENDIF}

function TrimLZero(s:string):string;
var p:byte;
begin
  p := 1;
  while (p <= length(s)) and (s[p] = '0') do
  begin
    if p = 255 then
      break;
    inc(p);
  end;
  TrimLZero := copy(s, p, 255);
end;

function repeatchar{(ch:char;len:integer):string};
var
  st:string;
begin
  st:='';
  while length(st)<len do
    st:=st+ch;
  repeatchar:=st
end;

function replace(oldsubstr, newsubstr, s:string):string;{replaces all occurrences
 of oldsubstr in s by newsubst and returns the result}
var
  res:string;
  p:byte;
begin
  res := '';{insert}
  repeat
    p := pos(oldsubstr, s);
    if p = 0 then
      break;                         {'..aa..'}
    res := res + copy(s, 1, p - 1) + newsubstr;
    s := copy(s, p + length(oldsubstr), 255);
  until false;
  replace := res + s;
end;

function lzero{(st:string;len:integer):string};
begin
  while Length(st) < len do
    st:='0'+st;
  lzero:=st;
end;

function center(st:string;len:integer):string;
var i,j:integer;label en;
begin
  st:=trim(st);i:=length(st);
  if i>=len then goto en;
  j:=(len-i)div 2;
  st:=lpad(st,i+j);st:=pad(st,len);
en:center:=st;
end;

function DelTilde(s:string):string;
var i:integer;
begin
  i:=1;
  while Length(s)>=i do begin
    if s[i]='~' then Delete(s,i,1) else inc(i);
  end;
  deltilde:=s;
end;

function FixString(fs:TFixString; s:string):string;
begin
  case fs of
    fsTrim: s := Trim(s);
    fsLTrim : s := LTrim(s);
    fsRTrim : s := RTrim(s);
    fsTrimLZero : s := TrimLZero(s);
    fsUpcase : s := USUppcase(s);
  end;
  FixString := s;
end;

 (*
procedure FreePString(PointerToPString:pointer);
var
  PtrToPString  : ^PString absolute PointerToPString;
begin
  if PtrToPString = nil then
    exit;
{  if PtrToPString^ = nil then
    exit;}
  DisposeStr(PtrToPString^);
  PtrToPString^ := nil;
end;

function SetString(var APString:PString; AString:string):boolean;
begin
  SetString := false;
  DisposeStr(APString);{objects}
  APString := nil;
  if AString <> '' then begin
    APString := NewStr(AString);
    if APString = nil then
      exit;
  end;
  SetString := true;
end;

function GetString(APString:PString):string;{returns '' for nil, otherwise APString^}
begin
  if APString = nil then
    GetString := ''
  else
    GetString := APString^
end;

function ConvStreamName(AFileName:PathStr):PathStr;
begin
  ConvStreamName := AFileName;
end;
*)
function InsertSpacesIntoMultiWordName(const AText: string): string;
{ e.g. from "InsertSpaces" makes "Insert Spaces" }
var
  i: integer; s: string;
  wasLower:boolean;
begin
  s := '';
  i := 1;
  wasLower := false;
  while i <= length(AText) do begin
    if Upcase(AText[i]) = AText[i] then begin
      if wasLower then
        s := s + ' ';
      wasLower := false;
    end else begin
      wasLower := true;
    end;
    s := s + AText[i];
    inc(i);
  end;
  InsertSpacesIntoMultiWordName := s;
end;

function FloatToRoundStr(Value: extended; ValidDigits: integer; EFromExpValue: integer): string;
  { Returns string representation of the Value rounded to ValidDigits,
    for abs(exponent number) >= EFromExpValue the value will be
    in scientific notation (with E) }
var 
  fr: TFloatRec;
  s: string;
begin
  FloatToDecimal(fr, Value, fvExtended, ValidDigits, 9999);
  s := '';
  if (EFromExpValue <> 0) and (fr.Exponent > EFromExpValue) then begin

  end else begin
    s := fr.Digits;
    if fr.Exponent < 0 then begin
      s := RepeatChar('0', abs(fr.Exponent)) + s;
    end else if fr.Exponent > 0 then begin
      if length(s) < fr.Exponent then
        s := s + RepeatChar('0', (fr.Exponent - length(s)));
    end;
    if length(s) > fr.Exponent then
      Insert(DecimalSeparator, s, fr.Exponent + 1);
  end;
  if s <> '' then begin
    if s[1] = DecimalSeparator then
      s := '0' + s;
    if fr.Negative then
      s := '-' + s;
  end else begin
    s := '0';
  end;
  FloatToRoundStr := s;
end;

end.