UNIT Real_RV;

(****************************************************************************

RealRangeValidator for TP 7.0

  concept by:  Steve Schafer (TeamB), see below
 modified by:  Ludger Weigel, 10041,1764

 example: for a RRV, which accepts real-input like this:  0 < x <= 10.5
 call:  RRV:=New(PRealRangeValidator, Init(RRV_higher, 0, RRV_equal, 10.5));

*****************************************************************************)

INTERFACE

uses Objects, Validate;

const RRV_equal  = 0;
      RRV_higher = 1;
      RRV_lower  = 2;

type
   PRealRangeValidator = ^TRealRangeValidator;
   TRealRangeValidator = object (TRangeValidator)
     MaxReal, MinReal : Real;
     MaxType, MinType : Byte;
     constructor Init (AMinType:byte; AMin:Real; AMaxType:byte; AMax:Real);
     constructor Load (var S: TStream);
     procedure Error; virtual;
     function IsValid (const S: String): Boolean; virtual;
     procedure Store (var S: TStream);
     function Transfer (var S: String; Buffer: Pointer; Flag: TVTransfer): Word; virtual;
   end;


IMPLEMENTATION

uses MsgBox;

constructor TRealRangeValidator.Init (AMinType:byte; AMin:Real; AMaxType:byte; AMax:Real);
begin
inherited Init (0,1);
ValidChars := ValidChars + ['-','.']; { "." -> "," for german notation ! }
MinReal := AMin;
MaxReal := AMax;
MinType := AMinType;
MaxType := AMaxType;
end;

constructor TRealRangeValidator.Load (var S: TStream);
begin
inherited Load (S);
S.Read (MinReal,SizeOf (MinReal));
S.Read (MaxReal,SizeOf (MaxReal));
S.Read (MinType,SizeOf (MinType));
S.Read (MaxType,SizeOf (MaxType));
end;


procedure TRealRangeValidator.Error;
const RRV_MinType : array[0..2] of string=('higher or equal ',
                                           'higher          ','?-ERROR!        ');
const RRV_MaxType : array[0..2] of string=('lower or equal  ','?-ERROR!        ',
                                           'lower           ');
var MinStr, MaxStr : String;
    i : integer;
begin
if (Trunc(MinReal)<>MinReal) OR (Trunc(MaxReal)<>MaxReal) then i:=2
else i:=0;
Str(MinReal:10:i, MinStr);
Str(MaxReal:10:i, MaxStr);
while (MinStr[1]=' ') AND (1<=Length(MinStr))  do Delete(MinStr,1,1);
while (MaxStr[1]=' ') AND (1<=Length(MaxStr))  do Delete(MaxStr,1,1);
while Length(MinStr)<Length(MaxStr)  do Insert(' ',MinStr,1);
while Length(MinStr)>Length(MaxStr)  do Insert(' ',MaxStr,1);
if (MinReal=MaxReal)  then
  MessageBox(#13+^C'Value must be '+ MinStr + '.',nil,mfError + mfOKButton)
else
  MessageBox('Value must be '+#13+
            + RRV_MinType[MinType] + MinStr + ' and '+#13+
            + RRV_MaxType[MaxType] + MaxStr + '.',nil,mfError + mfOKButton);
end;


function TRealRangeValidator.IsValid (const S: String): Boolean;
var Value : real;
    Code  : integer;
    Data  : string;
begin
Data:=S; { do not modify displayed string !!! }
{ "," -> "."  for german notation...!!! }
(*while Pos(',', Data) > 0  do Data[Pos(',', Data)] := '.';*)
Val(Data, Value, Code);
if Code<>0  then IsValid:=False
else begin
  if (MinReal=MaxReal) AND (Value<>MinReal)  then IsValid:=False
  else begin
    IsValid:=True;
    case MinType of
      RRV_equal  : if Value< MinReal  then IsValid:=False;
      RRV_higher : if Value<=MinReal  then IsValid:=False;
      RRV_lower  : IsValid:=False; { (debug only)  Spock:"Most illogical." }
    end;
    case MaxType of
      RRV_equal  : if Value> MaxReal  then IsValid:=False;
      RRV_lower  : if Value>=MaxReal  then IsValid:=False;
      RRV_higher : IsValid:=False; { (debug only)  Spock:"Most illogical." }
    end;
  end;
end
end;

procedure TRealRangeValidator.Store (var S: TStream);
begin
inherited Store (S);
S.Write (MinReal,SizeOf (MinReal));
S.Write (MaxReal,SizeOf (MaxReal));
S.Write (MinType,SizeOf (MinType));
S.Write (MaxType,SizeOf (MaxType));
end;

function TRealRangeValidator.Transfer (var S: String; Buffer: Pointer;
                                       Flag: TVTransfer): Word;
var
   Value: Real;
   Code: Integer;
begin
if Options and voTransfer <> 0 then
  begin
  Transfer := SizeOf (Value);
  case Flag of
    vtGetData: begin
      Val (S,Value,Code);
      Real (Buffer^) := Value;
      end;
    vtSetData: Str (Real (Buffer^),S);
    end;
  end
else Transfer := 0;
end;

END.  { of UNIT }

(* template taken from:

#: 199603 S1/Turbo Vision
    13-Mar-93  03:44:06
Sb: #199584-#TVal for real no.
Fm: Steve Schafer (TeamB) 76711,522

Here's a unit which defines a validator for the single type. You can easily
modify it to accomodate other floating-point types. You'll probably want to
modify the Error method, too.