unit numerot;
{
   This file includes the main input-panel for Kave-program.
     TFormNumerot

   Also one subroutine is global:
     AskValue

   Unit:    numerot
   Purpose: Form to input numbers
   Author:  Vesa Lappalainen
   Date:    8.9.1996
   Changed: 12.7.1998
            + ctrl-oikea nappi poistaa rajat
   Changed: 29.9.2001
            + VCL/CLX compiling (define CLX)
            - no Spin ctrl for CLX


   Vikoja:
            - desimaaliluvun editointi jos se on valittu
}

interface

uses
  SysUtils, Classes,
{$ifdef CLX}
  QGraphics, QControls, QForms, QDialogs,  QStdCtrls, QExtCtrls, 
 {$else}
  Windows, Messages, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Spin,
{$endif}
  kDouble, kComp, savepos;

const DESVARI = 20;
const MAXDOUBLE = 1e300;

type
{------------------------------------------------------------------------------}
  cDesim = class
  private
    value : Double;
    desim : integer; { -3 = luku tuhoutuu 1. painetusta          }
                     { -2 = syöttö alkaa, lukua ei näytetä       }
                     { -1 = syöttö jatkuu, yksi nuemro näytetään }
                     {  0 = desimaalipiste syötetty              }
                     {  1 = 1 desimaali...                       }
    sign   : integer;{ -1 = negatiivinen, 1 = positiivinen       }
    mindes : integer;
    maxdes : integer;
    loval  : double;
    hival  : double;
   public
    constructor Create(d,mi,ma:double; mides,mades:integer);
    procedure Init(v:double);
    procedure Initd(d:cDesim);
    procedure subst(d:cDesim); { = }
    procedure SubstReal(v:Double); { = }
    procedure InitBlank;
    procedure addnum(n:integer);
    function clearnum:boolean;
    procedure add(var a,b:cDesim);
    procedure sub(var a,b:cDesim);
    procedure mul(var a,b:cDesim);
    procedure divd(var a,b:cDesim);
    procedure ChangeSign;
    procedure oper(op:char;var a,b:cDesim);
    function IsOperator(op:char):boolean;
    procedure todes;
    function toStr:string;
    procedure adv(d:double);
    function RValue:double;
    function IsInDelete:boolean;
    function OK:boolean;
    function over:boolean;
    function under:boolean;
    procedure NoHiVal;
    procedure NoLoVal;
  end; { cDesim }

{------------------------------------------------------------------------------}
  TFormNumerot = class(TForm)
    PanelNumerot: TPanel;
    GroupBoxNumerot: TGroupBox;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
    Button0: TButton;
    ButtonBS: TButton;
    ButtonOK: TButton;
    ButtonMiinus: TButton;
    ButtonPlus: TButton;
    ButtonDiv: TButton;
    ButtonMul: TButton;
    ButtonResult: TButton;
    ButtonCancel: TButton;
    PanelKysymys: TPanel;
    PanelKysymysTeksti: TPanel;
    LabelPrompt: TLabel;
    PanelSyotto: TPanel;
{$ifdef CLX}

{$else}
    SpinButtonLuku: TSpinButton;
{$endif}
    EditLuku: TEdit;
    LabelTo: TLabel;
    ButtonDes: TButton;
    ErrorOver: TRadioButton;
    ErrorUnder: TRadioButton;
    ButtonSign: TButton;
    CounterOrig: TCounter;
    SavePos1: TSavePos;
    procedure Button0Click(Sender: TObject);
    procedure ButtonResultClick(Sender: TObject);
    procedure ButtonMiinusClick(Sender: TObject);
    procedure ButtonDesClick(Sender: TObject);
    procedure ButtonBSClick(Sender: TObject);
    procedure SpinButtonLukuDownClick(Sender: TObject);
    procedure SpinButtonLukuUpClick(Sender: TObject);
    function  Ask(prompt:string;var d:double;mi,ma:double;desim:integer):boolean;
    procedure FormShow(Sender: TObject);
    procedure Oper(c:char);
    procedure CalcResult;
    procedure Number(n:integer);
    procedure ChangeSign;
    procedure BS;
    procedure InitOrig;
    procedure Decimal;
    procedure SetStrVal(s:string);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure LabelToClick(Sender: TObject);
    procedure ButtonSignClick(Sender: TObject);
    procedure ErrorUnderMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ErrorOverMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    left  : cDesim; { laskuissa välitulos   }
    right : cDesim; { juuri syötettävä luku }
    rnow  : cDesim; { kokonaistulos         }
{    orig  : cDesim; { alkuperäinen arvo     }
    operator : char;
    procedure UpdateDisplay;
    function GetPasswd: boolean;
    procedure SetPasswd(const Value: boolean);
  public
    { Public declarations }
    property Passwd :boolean read GetPasswd write SetPasswd;
  end;


function AskValue(prompt:string;var d:double;mi,ma:double;desim:integer;passwd:boolean=false):boolean;
function AskIValue(prompt:string;var i:integer;mi,ma:integer;passwd:boolean=false):boolean;

var
  FormNumerot: TFormNumerot;

implementation
{$R *.dfm}
const nNoOper      = ' ';

{------------------------------------------------------------------------------}
procedure cDesim.Init(v:double);
begin
  value := v;
  desim := -3;
  sign  := 1;
end;

{------------------------------------------------------------------------------}
procedure cDesim.SubstReal(v:double);
begin
  if ( Rvalue < 0 ) then sign := -1;
  value := v;
  if ( v <> 0 ) then sign  := 1;
end;

{------------------------------------------------------------------------------}
constructor cDesim.Create(d,mi,ma:double; mides,mades:integer);
begin
  Init(d);
  loval := mi;
  hival := ma;
  maxdes := mades;
  mindes := mides;
end;

{------------------------------------------------------------------------------}
procedure cDesim.Initd(d:cDesim);
begin
  Init(d.Rvalue);
end;

procedure cDesim.subst(d:cDesim);
begin
  value := d.Rvalue;
  sign := 1;
end;

{------------------------------------------------------------------------------}
procedure cDesim.InitBlank;
begin
  value := 0;
  sign := 1;
  desim := -2;
end;

function Power(n,m:integer):double;
var p:double;
    i:integer;
begin
  p := 1;
  for i:=1 to m do p := p*n;
  Result := p;
end;

{------------------------------------------------------------------------------}
procedure cDesim.addnum(n:integer);
var v:double; si:integer;
begin
  if ( desim <= -3 ) then value := 0;
  si := 1;
  if ( desim < -1 ) then desim := -1;
  v := value;
  if ( v < 0 ) then begin si := -1; v:= -v; end;
  if ( desim >= 0 ) then begin
    if ( maxdes <= desim ) then exit;
    inc(desim);
    v := v + n/Power(10,desim);
  end
  else v := v * 10 + n;
  value := sign * si * v;
  if ( v > 0 ) then sign := 1;
end;

{------------------------------------------------------------------------------}
function cDesim.clearnum:boolean;
  function IsZero(nsi:integer):boolean;
  begin
    Result := false;
    if ( desim = -1 ) and ( value = 0 ) then begin
      if ( sign < 0 ) then sign := nsi;
      desim := -2;
      Result := true;
    end;
  end;

var fac:double;
begin
  Result := false;
  if ( desim = -2 ) and ( sign = 1 ) then exit;
  Result := true;
  if ( desim = -2 ) then begin sign := 1; exit; end;
  if ( desim = -3 ) then begin
    desim := min(CountDes(Rvalue),maxdes);
    SubstReal(StrToDouble(DoubleToStr(Rvalue,desim)));
{    desim := -1; }
    exit;
  end;
  if ( IsZero(1) ) then  exit;
  if ( desim = 0 ) then begin desim := -1; exit; end;
  if ( desim < 0 ) then begin { Ei desimaaleja }
    SubstReal(Trunc(Rvalue/10));
    IsZero(-1);
    exit;
  end;
  fac := Power(10,desim-1);
  SubstReal(Trunc(RValue*fac)/fac);
  dec(desim);
end;

{------------------------------------------------------------------------------}
procedure cDesim.add(var a,b:cDesim);
begin
  Init(a.Rvalue + b.Rvalue);
end;

{------------------------------------------------------------------------------}
procedure cDesim.sub(var a,b:cDesim);
begin
  Init(a.Rvalue - b.Rvalue);
end;

{------------------------------------------------------------------------------}
procedure cDesim.mul(var a,b:cDesim);
begin
  Init(a.Rvalue * b.Rvalue);
end;

{------------------------------------------------------------------------------}
procedure cDesim.divd(var a,b:cDesim);
begin
  if ( b.RValue <> 0 ) then Init(a.Rvalue / b.Rvalue)
  else Init(a.Rvalue);
end;

{------------------------------------------------------------------------------}
procedure cDesim.oper(op:char; var a,b:cDesim);
begin
  case ( op ) of
    '+': add(a,b);
    '-': sub(a,b);
    '*',
    'x': mul(a,b);
    '/': divd(a,b);
  end; { case }
end;

{------------------------------------------------------------------------------}
procedure cDesim.ChangeSign;
begin
  if ( RValue = 0) then
    sign := - sign
  else SubstReal(-1*RValue);
end;

{------------------------------------------------------------------------------}
function cDesim.IsOperator(op:char):boolean;
begin
  Result := op in ['+','-','*','x','/'];
end;

{------------------------------------------------------------------------------}
procedure cDesim.todes;
begin
  if ( maxdes <= 0 ) then exit;
  if ( desim < 0 ) then desim := 0;
end;

{------------------------------------------------------------------------------}
function cDesim.toStr:string;
var s:string;
    ndes:integer;
begin
  if ( desim = -3 ) then begin
    ndes := CountDes(Rvalue);
    if ( ndes < mindes ) then ndes := mindes;
    if ( ndes > maxdes ) then ndes := maxdes;
    Result := DoubleToStr(Rvalue,ndes);
    exit;
  end;
  if ( desim = -2 ) and ( Rvalue = 0 ) then s := ''
  else if ( desim = -1 ) and ( Rvalue = 0 ) then s := '0'
  else s := DoubleToStr(Rvalue,desim);
  if ( desim = 0 ) then s := s+'.';
  if ( sign < 0 ) and ( Rvalue = 0 ) then  s := '-'+s;
  Result := s;
end;

{------------------------------------------------------------------------------}
procedure cDesim.adv(d:double);
begin
  SubstReal(Rvalue + d);
end;

{------------------------------------------------------------------------------}
function cDesim.RValue:double;
begin
  Result := sign*value;
end;

{------------------------------------------------------------------------------}
function cDesim.IsInDelete:boolean;
begin
  Result := ( desim = -3 );
end;

{------------------------------------------------------------------------------}
function cDesim.over:boolean;
begin
  Result := Rvalue > hival;
end;

{------------------------------------------------------------------------------}
function cDesim.under:boolean;
begin
  Result := Rvalue < loval;
end;

{------------------------------------------------------------------------------}
function cDesim.OK:boolean;
begin
  Result := NOT (over OR under);
end;

{------------------------------------------------------------------------------}
procedure cDesim.NoHiVal;
begin
  hival := MAXDOUBLE;
end;

{------------------------------------------------------------------------------}
procedure cDesim.NoLoVal;
begin
  loval := -MAXDOUBLE;
end;

{------------------------------------------------------------------------------}
{ TFormNumerot: xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx}
{------------------------------------------------------------------------------}
{
   Syöttö toimii kuten laskimessa.
   Näkyvissä on kuitenkin tarvittaessa laskun vasen (left) operandi,
   operaatio sekä oikea (right) operandi.

   Numerot lisääntyvät aina right-operandiin ja se voi sisältää
   monta desimaalia.  Näytetään ne desimaalit, joka käyttäjä on
   näppäillyt.

   Left näytetään minimimäärällä desimaaleja, kuitenkin korkeintaan
   3:lla.

}
{------------------------------------------------------------------------------}
procedure TFormNumerot.UpdateDisplay;
var sel1:integer;
    s:string;
begin
  if ( right.IsOperator(operator) ) then begin
    s := left.toStr + operator;
    sel1 := Length(s)+1;
    EditLuku.Text := s + right.toStr;
    rnow.oper(operator,left,right);
  end
  else begin
    sel1:=0;
    rnow.subst(right);
    if ( right.IsInDelete ) then EditLuku.Text := rnow.toStr
                            else EditLuku.Text := right.toStr;
  end;
  if ( right.IsInDelete ) then begin
    EditLuku.SelStart :=sel1;
    EditLuku.SelLength  := 50;
  end
  else EditLuku.SelLength  := 0;

  EditLuku.Invalidate;
  ErrorOver.visible := rnow.over;
  ErrorUnder.visible := rnow.under;
  ButtonOK.Visible := rnow.OK;
  if ( ButtonOK.Visible ) then ActiveControl := ButtonOK;
end;

{------------------------------------------------------------------------------}
procedure TFormNumerot.CalcResult;
begin
  right.initd(rnow);
  left.init(0);
  operator := nNoOper;
  UpdateDisplay;
end;

{------------------------------------------------------------------------------}
procedure TFormNumerot.Oper(c:char);
begin
  if ( operator <> nNoOper ) then CalcResult;
  left.subst(right);
  right.InitBlank;
  operator := c;
  UpdateDisplay;
end;

{------------------------------------------------------------------------------}
procedure TFormNumerot.Number(n:integer);
begin
  right.addnum(n);
  UpdateDisplay;
end;

{------------------------------------------------------------------------------}
procedure TFormNumerot.BS;
begin
  if ( not right.clearnum ) AND ( operator <> nNoOper ) then begin
    operator := nNoOper;
    right.initd(left);
    right.clearnum;
  end;
  UpdateDisplay;
end;

{------------------------------------------------------------------------------}
procedure TFormNumerot.Decimal;
begin
  right.todes;
  UpdateDisplay;
end;

{------------------------------------------------------------------------------}
procedure TFormNumerot.InitOrig;
begin
  right.Init(CounterOrig.Value);
  rnow.Init(CounterOrig.Value);
  Left.Init(0);
  operator := nNoOper;
  UpdateDisplay;
end;

{------------------------------------------------------------------------------}
procedure TFormNumerot.ChangeSign;
begin
  right.ChangeSign;
  UpdateDisplay;
end;

procedure TFormNumerot.SetStrVal(s:string);
begin
  Left.Init(0);
  Right.Init(StrToDouble(s));
  operator := nNoOper;
  UpdateDisplay;
end;

{------------------------------------------------------------------------------}
{ Tapahtuman käsittelijät:                                                     }
{------------------------------------------------------------------------------}

{------------------------------------------------------------------------------}
procedure TFormNumerot.Button0Click(Sender: TObject);
begin
  Number((Sender as TButton).Tag);
end;

{------------------------------------------------------------------------------}
procedure TFormNumerot.ButtonResultClick(Sender: TObject);
begin
  CalcResult;
end;

{------------------------------------------------------------------------------}
procedure TFormNumerot.ButtonMiinusClick(Sender: TObject);
begin
  Oper(Char((Sender as TButton).Caption[1]));
end;

{------------------------------------------------------------------------------}
procedure TFormNumerot.ButtonDesClick(Sender: TObject);
begin
  Decimal;
end;

{------------------------------------------------------------------------------}
procedure TFormNumerot.ButtonBSClick(Sender: TObject);
begin
  BS;
end;

{------------------------------------------------------------------------------}
procedure TFormNumerot.SpinButtonLukuDownClick(Sender: TObject);
begin
  right.adv(-1);
  UpdateDisplay;
end;

{------------------------------------------------------------------------------}
procedure TFormNumerot.SpinButtonLukuUpClick(Sender: TObject);
begin
  right.adv(1);
  UpdateDisplay;
end;

{------------------------------------------------------------------------------}
function  TFormNumerot.Ask(prompt:string;var d:double;mi,ma:double;desim:integer):boolean;
begin
  operator := nNoOper;
  left := cDesim.Create(0,mi,ma,0,3);
{  orig.Create(d,mi,ma,desim,desim);}
  right := cDesim.Create(d,mi,ma,0,6);
  rnow := cDesim.Create(d,mi,ma,desim,desim);
  CounterOrig.Value := d;
  CounterOrig.Desim := desim;
  ErrorOver.Caption := DoubleToStr(ma,desim);
  ErrorUnder.Caption := DoubleToStr(mi,desim);
{  ButtonDes.Visible :=  ( desim > 0 ); }
  LabelPrompt.Caption := prompt;
  repeat
    Result := ShowModal = mrOK;
    if ( not Result ) then break;
    if ( rnow.OK ) then begin d := rnow.RValue; break; end;
  until ( false );
  left.Free;
  right.free;
  rnow.free;
  left := NIL;
end;

{------------------------------------------------------------------------------}
function AskValue(prompt:string;var d:double;mi,ma:double;desim:integer;passwd:boolean):boolean;
begin
  if  ( FormNumerot = NIL ) then FormNumerot := TFormNumerot.Create(NIL);
  FormNumerot.passwd := passwd;
  Result := FormNumerot.Ask(prompt,d,mi,ma,desim);
  FormNumerot.passwd := false;
end;

{------------------------------------------------------------------------------}
function AskIValue(prompt:string;var i:integer;mi,ma:integer;passwd:boolean):boolean;
var d:double;
begin
  d := i;
  Result := AskValue(prompt,d,mi,ma,0,passwd);
  if ( Result ) then i := Round(d);
end;


{------------------------------------------------------------------------------}
procedure TFormNumerot.FormShow(Sender: TObject);
begin
  operator := nNoOper;
{$ifdef CLX}

{$else}
  if ( left = NIL ) then begin PostMessage(Handle,WM_CLOSE,0,0); exit; end;
{$endif}
  UpdateDisplay;
end;

{------------------------------------------------------------------------------}
procedure TFormNumerot.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if ( Right.IsOperator(Key) ) then begin
    Oper(key);
  end
  else case Key of
    '0'..'9'               : Number(Ord(Key)-Ord('0'));
    #8                     : BS;
    '.',','                : Decimal;
    '='                    : CalcResult;
    #127                   : InitOrig;
  end; { case }
  Key := #0;
end;

procedure TFormNumerot.LabelToClick(Sender: TObject);
begin
  InitOrig;
end;

procedure TFormNumerot.ButtonSignClick(Sender: TObject);
begin
  ChangeSign;
end;

procedure TFormNumerot.ErrorUnderMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if ( Button = mbLeft ) then begin
    SetStrVal(ErrorUnder.Caption);
    exit;
  end;
  if ( Button <> mbRight ) or ( Shift <> [ssCtrl,ssRight] ) then exit;
  rnow.NoLoVal;
  UpdateDisplay;
end;

procedure TFormNumerot.ErrorOverMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if ( Button = mbLeft ) then begin
    SetStrVal(ErrorOver.Caption);
    exit;
  end;
  if ( Button <> mbRight ) or ( Shift <> [ssCtrl,ssRight] ) then exit;
  rnow.NoHiVal;
  UpdateDisplay;
end;

function TFormNumerot.GetPasswd: boolean;
begin
{$ifdef CLX}
  Result := false;
{$else}
  Result := EditLuku.PasswordChar <> #0;
{$endif}
end;

procedure TFormNumerot.SetPasswd(const Value: boolean);
begin
{$ifdef CLX}

{$else}
  if Value then
    EditLuku.PasswordChar := '*'
  else
    EditLuku.PasswordChar := #0;
{$endif}
end;

end.