{------------------------------------------------------------------------------}
{
   Unit Name: EditDouble
   Purpose  : Simple edit component for double values
              Remember take also kCkeck.pas
   Author   : Vesa Lappalainen
   Date     : 17.12.1997
   Changed  : 10.09.2000
     + can not input illegal keys
     + value checking (look kCheck)
   Changed  : 30.12.2000
     + Check-property changed more ploymorphic and the type can easily
       be changed by inheriting and overriding CreateCheck-method
   Changed  : 15.9.2001/vl
    + VCL/CLX compiling (define const CLX)
   ToDo     :
     - Exponent notation
     - parser for simple calculations like 12+34
}
{------------------------------------------------------------------------------}
unit EditDouble;

interface

uses
  SysUtils, Classes,
{$ifdef CLX}
  QStdctrls,
{$else}
  Windows,
  stdctrls,
{$endif}
   kCheck;

type

  TEditDouble = class(TEdit)
  private
    FValue : double;
    FDesim : Integer;
    FPrecision : integer;
    FCheck: TCheckLegal;
  protected
    procedure Change; override;
    procedure KeyPress(var Key: Char); override;
    function CreateCheck: TCheckLimit; virtual;
    procedure SetValueBy(d: double); overload; virtual;
    procedure SetValueBy(const s: string); overload; virtual;
    function GetValue : double;    virtual;
    procedure SetValue(d:double);  virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Desim : integer read FDesim write FDesim default -1;
    property Value : double read FValue write SetValue;
    //stored false;
    property Check : TCheckLegal read FCheck write FCheck;
    property Align;
  end;

procedure Register;

implementation

uses kdouble,
{$ifdef CLX}
   QGraphics;
{$else}
   graphics;
{$endif}

procedure Register;
begin
  RegisterComponents('KaveOptions', [TEditDouble]);
end;

{ TEditDouble }


function TEditDouble.GetValue : double;
begin
//  FValue := StrToDoubleDef(Text,FValue);
  Result := FValue;
end;

procedure TEditDouble.SetValueBy(d: double);
begin
  FValue := d;
  Check.DoCheck;
end;

procedure TEditDouble.SetValueBy(const s: string);
begin
  SetValueBy(StrToDoubleDef(s,FValue));
end;

procedure TEditDouble.SetValue(d:double);
begin
  if ( d <> 0 ) and ( FValue <> 0 ) and ( abs(d-FValue)/abs(d) < 0.00001 ) then exit;
  if ( FDesim >=0 ) then begin
    Text := FloatToStrF(d,ffFixed,18,FDesim);
  end else begin
    Text := FloatToStr(d);
  end;
  SetValueBy(d);
end;

function TEditDouble.CreateCheck : TCheckLimit;
var ch : TCheckLimit;
begin
  ch := TCheckLimit.Create(self);
  ch.WarningColor := clRed;
  ch.ShowHint := true;
  ch.OnGetValue := GetValue;
  Result := ch;
end;

constructor TEditDouble.Create(AOwner: TComponent);
begin
  inherited;
  Check := CreateCheck;
  Value := 0;
  FDesim := -1;
  FPrecision := 18;
end;

destructor TEditDouble.Destroy;
begin
  Check.Free;
  inherited;
end;

const setSeparators = [',','.'];
const setNumbers    = ['0'..'9'];
const setEdit       = [#09,^V,^X,^C,^H];
const setExponent   = ['e','E'];
const setLegal      = setSeparators + setNumbers + ['-','e','E'];

function CheckDoubleChar(c:char; const s:string;posForNewChar:integer) : char;
  function MinusLeagal:boolean;
  begin
    Result := true;
    if ( posForNewChar = 1 ) then exit;
    if ( s[posForNewChar-1] in setExponent ) then exit;
    Result := false;
  end;
begin
  Result := #0;
  if not (c in setLegal + setEdit ) then exit;
  if ( c in setSeparators ) then c := DecimalSeparator;
  if ( c = DecimalSeparator ) and ( Pos(DecimalSeparator,s) > 0 ) then exit;
  if ( c in setExponent ) and ( ( Pos('e',s) > 0 ) or ( Pos('E',s) > 0 ) ) then exit;
  if ( c = '-' ) and ( not MinusLeagal  ) then exit;
  Result := c;
end;

procedure TEditDouble.KeyPress(var Key: Char);
begin
  inherited;
  Key := CheckDoubleChar(Key,Text,SelStart+1);
end;

procedure TEditDouble.Change;
// Checks in this method is only for Paste.
// Other checks are allready made in KeyPress
var i:integer; c : char; s : string; os,ol : integer;
begin
  s := '';
  for i := 1 to Length(Text) do begin
    c := CheckDoubleChar(Char(Text[i]),s,i);
    if ( c <> #0 ) then s := s + c;
  end;
  if ( s <> Text ) then begin
    os := SelStart; ol := SelLength;
    Text := s;
    SelStart := os;  SelLength := ol;
    exit;
  end;
  SetValueBy(Text);
  inherited;
end;



end.