{------------------------------------------------------------------------------}
{
   Unit Name: kdouble
   Purpose  : Subroutines for handling double-numbers.  Look interface part
              for explanation.
   Author   : Vesa Lappalainen
   Date     : 15.9.1996
   Changed  : 6.10.1996
              + sign -funktio
              05.04.1997
              + Extract -funtiot
              18.8.2000
              + Ini-format, that is double allways in format 1 234.50
   ToDo     :
}
{------------------------------------------------------------------------------}

unit kdouble;

interface

uses SysUtils,inifiles;

function max(a,b:integer):integer;
// suurempi luvuista a,b

function min(a,b:integer):integer;
// pienempi luvuista a,b

function fmax(a,b:double):double;
// suurempi luvuista a,b

function fmin(a,b:double):double;
// pienempi luvuista a,b

function clean(const s:string) : string;
// siivoaa tuhaterottimet pois desimaaliluka esittävästä merkkijonosta

function StrToDouble(const s:string):double;
// Muuttaa merkkijonon reaaliluvuksi, oletus 0

function IniStrToDouble(s:string;def:double=0):double;
// Muuttaa merkkijonon reaaliluvuksi, oletus 0.
// Merkkijono aina desimaalipisteellä

function StrToDoubleDef(s:string;def:double=0):double;
// Muuttaa merkkijonon reaaliluvuksi, oletus def

function StrToAnyDouble(s:string;def:double=0):double;
// Muuttaa merkkijonon reaaliluvuksi.
// Merkkijono voi olla joko 1.23 tai 1,23

function DoubleToStr(d:double;des:integer=-1):string; overload;
// Reaaliluku merkkijonoksi halutulla desimaalimäärällä (-1 = tarvittava määrä)
// Tulee tuhaterotin

function DoubleToStr(d:double;num,des:integer):string; overload;
// Reaaliluku merkkijonoksi halutulla numero ja desimaalimäärällä
// Tulee tuhaterotin

function DoubleToStr(d:double;fmt:string):string; overload;
// Reaaliluku merkkijonoksi halutulla formaatilla

function DoubleToFStr(d:double;len:integer;des:integer=-1):string;
// Reaaliluku merkkijonoksi halutun pituiseksi ja halutulla desimaalimäärällä
// Ei tuhat-erotinta

function DoubleToIniStr(d:double;des:integer=-1):string; overload;
// Reaaliluku merkkijonoksi halutulla desimaalimäärällä (-1 = tarvittava määrä)
// Merkkijonoon aina desimaalipiste (.)

function DoubleToIniStr(d:double;num,des:integer):string; overload;
// Reaaliluku merkkijonoksi halutulla numero ja desimaalimäärällä
// Merkkijonoon aina desimaalipiste (.)

function DoubleToIniStr(d:double;fmt:string):string; overload;
// Reaaliluku merkkijonoksi halutulla formaatilla
// Merkkijonoon aina desimaalipiste (.)
// Ei tuhat-erotinta

function CountDes(d:double):integer;
// Laskee luvun desimaalien määrän, ei toimi 100% oikein

function sign(a:double):integer;
// a: etumerkki, negat => -1, 0 => 0, posit. => 1

procedure GetDoubleRangeLimit(const s:string; var r1,r2:double;l1,l2:double);
// Merkkijonosta, joka on muotoa 1-5 etsitään yläraja ja alaraja

function IniReadDouble(Ini:TIniFile;section:string;item:string;def:double):double;
// Luetaan ini-tiedostosta reaaliluku, muoto aina desimaalipisteellä

procedure IniWriteDouble(Ini:TIniFile;section:string;item:string;d:double);
// kirjoitetaan ini-tiedostoon reaaliluku, muoto aina desimaalipisteellä

function ExtractString(var s:string; const ByWhat:string=' '; const def:string='') : string;
// Erottaa jonosta ensimmäisen ByWhat-jonosta löytyvän merkin mukaan
// alkuosan ja loppuosan.
// Esim. ExtractString('12;34 5','; ')  => 12  ja s := 34 5

function ExtractDouble(var s:string; const ByWhat:string=' '; def:double=0) : double;
// Erotetaan seuraava reaaliluku, käytetään käytössä olevaa desimaalierotinta

function ExtractIniDouble(var s:string; const ByWhat:string=' '; def:double=0) : double;
// Erotetaan seuraava reaaliluku, luvussa oletetaan olevan desimaalipiste (.)

function ExtractAnyDouble(var s:string; const ByWhat:string=' '; def:double=0) : double;
// Erotetaan seuraava reaaliluku, luvussa kelpaa , tai ., mutta ei saa olla
// sitten tuhaterottimena , tai .

function ExtractInt(var s:string; const ByWhat:string=' '; def:integer=0) : integer;
// Erotetaan seuraava kokonaisluku

function ExtractSString(var s:string; const ByWhat:string=' '; const def:string='') : string;
// Erottaa jonosta ByWhat jonon kohdalta alkuosan ja loppuosan
// Esim. ExtractString('12;34 5','; ')   => 12;34 5  ja  s = ''
//       ExtractString('12; 34 5','; ')  => 12  ja  s = 34 5

function ExtractSDouble(var s:string; const ByWhat:string=' '; def:double=0) : double;
// Erotetaan seuraava reaaliluku, käytetään käytössä olevaa desimaalierotinta

function ExtractSIniDouble(var s:string; const ByWhat:string=' '; def:double=0) : double;
// Erotetaan seuraava reaaliluku, luvussa oletetaan olevan desimaalipiste (.)

function ExtractSAnyDouble(var s:string; const ByWhat:string=' '; def:double=0) : double;
// Erotetaan seuraava reaaliluku, luvussa kelpaa , tai ., mutta ei saa olla
// sitten tuhaterottimena , tai .

function ExtractSInt(var s:string; const ByWhat:string=' '; def:integer=0) : integer;
// Erotetaan seuraava kokonaisluku

procedure SetNumberFormat;
// ei tee mitään tällä hetkellä

function StrToFloatDef(s:string;def:double=0):double;
// Merkkijonosta reaaliluku, käytetään nykyistä desimaalierotinta

function ExtractStartChars(var s:string):string;
// Extracts all none number characters from the begining

function NumberInSet(const s1,s2:string):boolean;
// Tells if s2 in set s1 (like  '2'  '1-3');

implementation

{------------------------------------------------------------------------------}
function max(a,b:integer):integer;
begin
  Result := a;
  if ( b > a ) then Result := b;
end;

{------------------------------------------------------------------------------}
function min(a,b:integer):integer;
begin
  Result := a;
  if ( b < a ) then Result := b;
end;

{------------------------------------------------------------------------------}
function fmax(a,b:double):double;
begin
  Result := a;
  if ( b > a ) then Result := b;
end;

{------------------------------------------------------------------------------}
function fmin(a,b:double):double;
begin
  Result := a;
  if ( b < a ) then Result := b;
end;

{------------------------------------------------------------------------------}
function clean(const s:string):string;
var i:integer;
begin
  Result := s;
  if ( ThousandSeparator <> ',' ) then
    while ( true ) do begin
      i := Pos(ThousandSeparator,Result);
      if ( i = 0 ) then break;
      Delete(Result,i,1);
    end;

  for i:=1 to Length(Result) do
    if Result[i] = #$a0 then Result[i] := ' '; // Jos erotin on väli, tallettuu näin!

  while ( true ) do begin
    i := Pos(' ',Result);
    if ( i = 0 ) then break;
    Delete(Result,i,1);
  end;
end;

{------------------------------------------------------------------------------}
function cleanIni(const s:string):string;
var i:integer;
begin
  Result := s;

  for i:=1 to Length(Result) do
    if Result[i] in [#$a0,','] then Result[i] := ' '; // Jos erotin on väli, tallettuu näin!

  while ( true ) do begin
    i := Pos(' ',Result);
    if ( i = 0 ) then break;
    Delete(Result,i,1);
  end;
end;

{------------------------------------------------------------------------------}
function StrToDoubleDef(s:string;def:double):double;
var i:integer;
    d:double;
begin

  s := clean(s);
  if DecimalSeparator = ',' then begin
    try
      d := StrToFloat(s);
    except
      d := def;
    end;
    Result := d;
  end
  else begin
    Val(s,d,i);  // Tulee nolla jos s = 'E' ja i = 2;
    if ( i = 1 ) then d := def;
    if ( i > 1 ) and ( d = 0 ) and ( def <> 0 ) and ( s <> '' ) and
       ( ( s[1] = 'E' ) or ( s[1] = 'e' ) ) then d := def;
    Result := d;
  end;
end;

{------------------------------------------------------------------------------}
function IniStrToDouble(s:string;def:double):double;
var i:integer;
    d:double;
begin
  s := cleanIni(s);
  if ( DecimalSeparator <> '.' ) then begin i := Pos('.',s); if ( i > 0 ) then s[i] := DecimalSeparator; end;
  if ( s = '' ) then begin Result := def; exit; end;
  try
    d := StrToFloat(s);
  except
    d := def;
  end;
  Result := d;
end;

const thousand : string = #$a0+' ';
const desnum   : string = '0123456789Ee,.-+';
{------------------------------------------------------------------------------}
function StrToAnyDouble(s:string;def:double):double;
{
Esimerkkejä:
DoubleToIniStr(d)             :       "123456789.12345" =>        123456789.12345
DoubleToStr(d)                :       "123456789,12345" =>        123456789.12345
DoubleToIniStr(d,20,3)        :  "       123456789.123" =>          123456789.123
DoubleToStr(d,20,3)           :  "     123 456 789,123" =>          123456789.123
DoubleToFStr(d,20,3)          :  "       123456789,123" =>          123456789.123
DoubleToFStr(d,20,3)+mk       :  "       123456789,123mk" =>          123456789.123
-123.23e8 mk                  :          "-123.23e8 mk" =>           -12323000000
-123.23E-8 mk                 :         "-123.23E-8 mk" =>             -1.2323E-6
-123.23E-8E mk                :        "-123.23E-8E mk" =>                      0
123e                          :                  "123e" =>                    123
123 e                         :                 "123 e" =>                    123
123 €                         :                 "123 €" =>                    123
123e2e                        :                "123e2e" =>                      0
}
var p,i:integer;
    d:double;
begin
  if ( DecimalSeparator <> ',' ) then begin i := Pos(',',s); if ( i > 0 ) then s[i] := DecimalSeparator; end;
  if ( DecimalSeparator <> '.' ) then begin i := Pos('.',s); if ( i > 0 ) then s[i] := DecimalSeparator; end;
  i := 1;
  while ( i <= Length(s) ) do begin // eat thousand sep and stop not num
    p := Pos(s[i],thousand);
    if ( p > 0 ) then begin Delete(s,i,1); continue; end;
    p := Pos(s[i],desnum);
    if ( p <= 0 ) then begin Delete(s,i,1000); break; end;
    inc(i);
  end;
  if ( s = '' ) then begin Result := def; exit; end;
  try
    d := StrToFloat(s);
  except
    d := def;
  end;
  Result := d;
end;

{------------------------------------------------------------------------------}
function StrToDouble(const s:string):double;
begin
  Result := StrToDoubleDef(s,0);
end;

{------------------------------------------------------------------------------}
function DoubleToStr(d:double;des:integer):string;
begin
  if ( des < 0 ) then
    Result := format('%g',[d])
  else
    Result := format('%1.*n',[des,d]);
end;

{------------------------------------------------------------------------------}
function DoubleToStr(d:double;num,des:integer):string;
begin
  Result := format('%*.*n',[num,des,d]);
end;

{------------------------------------------------------------------------------}
function DoubleToStr(d:double;fmt:string):string;
begin
  Result := format(fmt,[d]);
end;

{------------------------------------------------------------------------------}
function DoubleToIniStr(d:double;des:integer):string;
var i:integer; s:string;
begin
  if ( des < 0 ) then
    s := format('%g',[d])
  else
    s := format('%1.*f',[des,d]);

  if ( DecimalSeparator <> '.' ) then begin i := Pos(DecimalSeparator,s); if ( i > 0 ) then s[i] := '.'; end;
  Result := s;
end;

{------------------------------------------------------------------------------}
function DoubleToIniStr(d:double;num,des:integer):string;
var i:integer; s:string;
begin
  s := format('%*.*f',[num,des,d]);
  if ( DecimalSeparator <> '.' ) then begin i := Pos(DecimalSeparator,s); if ( i > 0 ) then s[i] := '.'; end;
  Result := s;
end;

{------------------------------------------------------------------------------}
function DoubleToIniStr(d:double;fmt:string):string;
var i:integer; s:string;
begin
  s := format(fmt,[d]);

  while ( true ) do begin
    i := Pos(ThousandSeparator,s);
    if ( i = 0 ) then break;
    Delete(s,i,1);
  end;
  if ( DecimalSeparator <> '.' ) then begin i := Pos(DecimalSeparator,s); if ( i > 0 ) then s[i] := '.'; end;
  Result := s;
end;

{------------------------------------------------------------------------------}
function DoubleToFStr(d:double;len,des:integer):string;
begin
  Result := format('%*.*f',[len,max(des,0),d]);
end;

{------------------------------------------------------------------------------}
function CountDes(d:double):integer;
{ Palautetaan -1 jos ei desimaaleja lainkaan                                   }
var s:string; frac:double;
    i:integer;
begin
  frac := abs(d-trunc(d));
  s := format('%g',[frac]);
  i := pos('E',s);
  if ( i > 0 ) then begin
    Result := -StrToInt(copy(s,i+1,5));
    Exit;
   end;
  Result := Length(s)-2; { 0. }
end;

{------------------------------------------------------------------------------}
function sign(a:double):integer;
begin
  Result := 0;
  if ( a > 0 ) then Result :=  1;
  if ( a < 0 ) then Result := -1;
end;

{------------------------------------------------------------------------------}
{ Vaihtoehdot:  (l1=0, l2=100)
    1-3   =>  1.0    3.0
    -3    =>  0.0    3.0
    1     =>  1.0  100.0
    1-    =>  1.0  100.0
   -1-3   => -1.0    3.0
}
procedure GetDoubleRangeLimit(const s:string; var r1,r2:double;l1,l2:double);
var p,p2:integer;
    st:string;
    t:double;
begin
  r1:=l1; r2:=l2; st := s;
  p := Pos('-',st);
  if ( p = 0 ) then begin r1 := IniStrToDouble(st); Exit; end; { 1 }
  st[p] := '=';
  if ( p = 1 ) then begin   { -3 tai -1-3 }
    p2 := Pos('-',st);
    if ( p2 <> 0 ) then begin   { -1-3 }
      st[p] := '-';
      st[p2] := '=';
      p := p2;
    end
    else begin  { -3 }
      r2 := IniStrToDouble(Copy(st,2,10));
      Exit;
    end;
  end;
  r1 := IniStrToDouble(Copy(st,1,p-1),l1);
  r2 := IniStrToDouble(Copy(st,p+1,10),l2);
  if ( r1 > r2 ) then begin t:=r1; r1:=r2; r2:=t; end;
end;

function IniReadDouble(Ini:TIniFile;section:string;item:string;def:double):double;
begin
  Result := IniStrToDouble(Ini.ReadString(section,item,''),def);
end;

procedure IniWriteDouble(Ini:TIniFile;section:string;item:string;d:double);
begin
  Ini.WriteString(section,item,DoubleToIniStr(d,CountDes(d)));
end;


function ExtractString(var s:string; const ByWhat:string; const def:string) : string;
var ib,i,i1,blen:integer;
begin
  blen := Length(ByWhat);
  if ( blen = 0 ) then begin
    Result := s; s := '';
    if ( Result = '' ) then Result := def;
    exit;
  end;


  i := Pos(ByWhat[1],s);
  if ( i = 0 ) then i := Length(s)+1;

  for ib := 2 to blen do begin
    i1 := Pos(ByWhat[ib],s);
    if ( i1 > 0 ) and ( i1 < i ) then i := i1;
  end;  

  Result := copy(s,1,i-1);

  if ( Result = '' ) then Result := def;
  Delete(s,1,i);
end;

function ExtractSString(var s:string; const ByWhat:string; const def:string) : string;
var i,blen:integer;
begin
  blen := Length(ByWhat);
  if ( blen = 0 ) then begin
    Result := s; s := '';
    if ( Result = '' ) then Result := def;
    exit;
  end;


  i := Pos(ByWhat,s);
  if ( i = 0 ) then i := Length(s)+1;

  Result := copy(s,1,i-1);

  if ( Result = '' ) then Result := def;
  Delete(s,1,i+blen-1);
end;

function ExtractDouble(var s:string; const ByWhat:string; def:double) : double;
var r : string;
begin
  r := ExtractString(s,ByWhat,'');
  Result := StrToDoubleDef(r,def);
end;

function ExtractIniDouble(var s:string; const ByWhat:string; def:double) : double;
var r : string;
begin
  r := ExtractString(s,ByWhat,'');
  Result := IniStrToDouble(r,def);
end;

function ExtractAnyDouble(var s:string; const ByWhat:string; def:double) : double;
var r : string;
begin
  r := ExtractString(s,ByWhat,'');
  Result := StrToAnyDouble(r,def);
end;

function ExtractInt(var s:string; const ByWhat:string; def:integer) : integer;
var r : string;
begin
  r := ExtractString(s,ByWhat,'');
  Result := StrToIntDef(r,def);
end;

function ExtractSDouble(var s:string; const ByWhat:string; def:double) : double;
var r : string;
begin
  r := ExtractSString(s,ByWhat,'');
  Result := StrToDoubleDef(r,def);
end;

function ExtractSIniDouble(var s:string; const ByWhat:string; def:double) : double;
var r : string;
begin
  r := ExtractSString(s,ByWhat,'');
  Result := IniStrToDouble(r,def);
end;

function ExtractSAnyDouble(var s:string; const ByWhat:string; def:double) : double;
var r : string;
begin
  r := ExtractSString(s,ByWhat,'');
  Result := StrToAnyDouble(r,def);
end;

function ExtractSInt(var s:string; const ByWhat:string; def:integer) : integer;
var r : string;
begin
  r := ExtractSString(s,ByWhat,'');
  Result := StrToIntDef(r,def);
end;

{------------------------------------------------------------------------------}
procedure SetNumberFormat;
begin
//  DecimalSeparator := '.';
//  ThousandSeparator := #$a0;
end;

{------------------------------------------------------------------------------}
function StrToFloatDef(s:string;def:double):double;
begin
  Result := def;
  try
    Result := StrToFloat(s);
  except
  end;
end;


{------------------------------------------------------------------------------}
function ExtractStartChars(var s:string):string;
// Extracts all none number characters from the begining
var i:integer;
begin
  i := 1;
  while ( i < Length(s) ) do begin
    if ( Pos(s[i],'-0123456789') > 0 ) then break;
    inc(i);
  end;
  Result := Copy(s,1,i-1);
  Delete(s,1,i-1);  
end;

function NumberInSet(const s1,s2:string):boolean;
//     s1      s2    Result
// =============================
//    1        1     true
//    1-4      2     true
//    1-4      5     false
//    1,2,3    2     true
//    1-4,6    6     true
var n,s:string; d,r1,r2:double;
begin
  Result := false;  if ( s2 = '' ) then exit;
  s := s1;
  d := StrToDoubleDef(s2,0);

  while ( s <> '' ) do begin
    n := ExtractString(s,',');

    if ( n = '' ) then continue;

    if ( Pos('-',n) > 0 ) then begin
      GetDoubleRangeLimit(n,r1,r2,0,100000);
      if ( r1 <= d ) and ( d <= r2 ) then begin
        Result := true;
        exit;
      end;
    end; // form 1-4

    if ( n = s2 ) then begin
      Result := true;
      exit;
    end; // form 2

  end;
end;

end.