UFor.pas

   1 unit UFor;
   2
   3 interface
   4
   5 function points(d : boolean; t : string; m : integer): string;
   6 function toreal(r : string): real;
   7 function rtostr(r : real): string;
   8 function plslop(o, c: string; back, buys: boolean): string;
   9 function plslom(o, c: string; back, buys: boolean; size, amnt, intr: string): string;
  10 function chkprc(o, c, q, b: string): boolean;
  11
  12 implementation
  13 uses SysUtils;
  14
  15 function points;
  16 var s : string;
  17     p,
  18     i,
  19     e : integer;
  20 begin
  21    s := t;
  22    if pos('.', s) = 0 then s := s + '.';
  23    while length(s) < 6  do s := s + '0';
  24    p := pos('.', s);
  25    s := copy(s, 1, p - 1) + copy(s, p + 1, 6 - p);
  26    val(s, i, e);
  27    if d then inc(i, m) else dec(i, m);
  28    s := inttostr(i);
  29    while length(s) < 5 do s := '0' + s;
  30    s := copy(s, 1, p - 1) + '.' + copy(s, p, 6 - p);
  31    points := s;
  32 end;
  33
  34 function toreal(r: string): real;
  35 var f : real;
  36     i : integer;
  37     s : string;
  38 begin
  39    S := R;
  40    val(trim(S), F, I);
  41    if (i > 0) and (I < length(S)) then begin
  42       if S[I] = '.' then S[I] := ',' else
  43       if S[I] = ',' then S[i] := '.';
  44       val(trim(S), F, I);
  45    end;
  46    result := F;
  47 end;
  48
  49 function rtostr;
  50 var s : string;
  51 begin
  52     str(r:5:2, s);
  53     rtostr := s;
  54 end;
  55
  56 function plslop;
  57 var op,
  58     cl : real;
  59      j : integer;
  60 begin
  61    op := toreal(o);
  62    cl := toreal(c);
  63    repeat
  64       op := op * 10;
  65       cl := cl * 10;
  66    until op > 3000;
  67    j := round(cl - op);
  68    if back xor buys then j := -j;
  69    plslop := inttostr(j);
  70 end;
  71
  72 function plslom;
  73 var op, cl: real;
  74         dd: real;
  75 begin
  76    plslom := '0';
  77    op := toreal(o);
  78    cl := toreal(c);
  79    if (op = 0) or (cl = 0) then exit;
  80    if back then dd :=   cl -   op
  81            else dd := 1/op - 1/cl;
  82    dd := dd * toreal(size);
  83    if back xor buys then dd := -dd;
  84    dd := dd * strtoint(amnt) - toreal(intr);
  85    plslom := rtostr(dd);
  86 end;
  87
  88 function chkprc;
  89 var op, cl: real;
  90     bk, sb: boolean;
  91 begin
  92    op := toreal(o);
  93    cl := toreal(c);
  94    bk := (q = 'EUR') or (q = 'GBP');
  95    sb := (b = 'Buy');
  96    chkprc := (op >= cl) xor (bk xor sb);
  97 end;
  98
  99 end.