
{*******************************************************}
{                                                       }
{       Graphics Vision Unit                            }
{                                                       }
{       Copyright (c) 1994 Stefan Milius                }
{                                                       }
{*******************************************************}

Unit GVValid;

{$ifndef FPK}
{$A+,B-,D+,F+,G+,O+,P-,R-,S-,V+,X+,I-}
{$endif}

interface

{$IFNDEF VER60}

uses Objects, Validate;

const
{ TValidator Status constants
}
  vsOk     =  0;
  vsSyntax =  1;

{ TValidator option flags
}
  voFill     =  $0001;
  voTransfer =  $0002;
  voOnAppend =  $0004;
  voReserved =  $00F8;

type
{ TVTransfer constants
}
{  TVTransfer = Validate.TVTransfer;
}
{ Abstract TValidator object
}
{  TValidator = Validate.TValidator;
  PValidator = ^TValidator;
}
{ TPXPictureValidator result type
}
{  TPicResult = (prComplete, prIncomplete, prEmpty, prError, prSyntax,
    prAmbiguous, prIncompNoFill);
}
{ TGPXPictureValidator object
}
  PGPXPictureValidator = ^TGPXPictureValidator;
  TGPXPictureValidator = object(TPXPictureValidator)
    procedure Error; virtual;
  end;

  TPXPictureValidator = TGPXPictureValidator;
  PPXPictureValidator = ^TPXPictureValidator;

{ TGFilterValidator object
}
  PGFilterValidator = ^TGFilterValidator;
  TGFilterValidator = object(TFilterValidator)
    procedure Error; virtual;
  end;

  TFilterValidator = TGFilterValidator;
  PFilterValidator = ^TFilterValidator;

{ TGRangeValidator object
}
  PGRangeValidator = ^TGRangeValidator;
  TGRangeValidator = object(TRangeValidator)
    procedure Error; virtual;
  end;

  TRangeValidator = TGRangeValidator;
  PRangeValidator = ^TRangeValidator;

{ TLookupValidator object
}
  TLookupValidator = Validate.TLookupValidator;
  PLookupValidator = ^TLookupValidator;

{ TGStringLookupValidator object
}
  PGStringLookupValidator = ^TGStringLookupValidator;
  TGStringLookupValidator = object(TStringLookupValidator)
    procedure Error; virtual;
  end;

  TStringLookupValidator = TGStringLookupValidator;
  PStringLookupValidator = ^TStringLookupValidator;

{ TIntRangeValidator object, using Integer data instead of LongInt
}
  PIntRangeValidator = ^TIntRangeValidator;
  TIntRangeValidator = object(TGRangeValidator)
    function Transfer(var S: String; Buffer: Pointer;
      Flag: TVTransfer): Word; virtual;
  end;

{ TRealValidator object
}
  TRealValidator = object(TGPXPictureValidator)
    Decimals: Integer;
    constructor Init(ADecimals: Integer);
    procedure Error; virtual;
    function Transfer(var S: String; Buffer: Pointer;
      Flag: TVTransfer): Word; virtual;
  end;
  PRealValidator = ^TRealValidator;

{ Stream registration procedure
}
procedure RegisterGVValid;

const
{ Stream registration records
}
  RGPXPictureValidator: TStreamRec = (
    ObjType: 195;
    VmtLink: Ofs(TypeOf(TGPXPictureValidator)^);
    Load: @TGPXPictureValidator.Load;
    Store: @TGPXPictureValidator.Store);

  RGFilterValidator: TStreamRec = (
    ObjType: 196;
    VmtLink: Ofs(TypeOf(TGFilterValidator)^);
    Load: @TGFilterValidator.Load;
    Store: @TGFilterValidator.Store);

  RGRangeValidator: TStreamRec = (
    ObjType: 197;
    VmtLink: Ofs(TypeOf(TGRangeValidator)^);
    Load: @TGRangeValidator.Load;
    Store: @TGRangeValidator.Store);

  RGStringLookupValidator: TStreamRec = (
    ObjType: 198;
    VmtLink: Ofs(TypeOf(TGStringLookupValidator)^);
    Load: @TGStringLookupValidator.Load;
    Store: @TGStringLookupValidator.Store);

  RRealValidator: TStreamRec = (
    ObjType: 240;
    VmtLink: Ofs(TypeOf(TRealValidator)^);
    Load:    @TRealValidator.Load;
    Store:   @TRealValidator.Store);

  RIntRangeValidator: TStreamRec = (
    ObjType: 241;
    VmtLink: Ofs(TypeOf(TIntRangeValidator)^);
    Load: @TIntRangeValidator.Load;
    Store: @TIntRangeValidator.Store);

{$ENDIF}

implementation

{$IFNDEF VER60}

uses GVApp, GVMsgBox, GVTexts;

{ TGPXPictureValidator object }

procedure TGPXPictureValidator.Error;
Begin
  MessageBox(GetStr(3), @Pic, mfError + mfOKButton);
End;

{ TGFilterValidator object }

procedure TGFilterValidator.Error;
Begin
  MessageBox(GetStr(4), nil, mfError + mfOKButton);
End;

{ TGRangeValidator object }

procedure TGRangeValidator.Error;
var Params: array[0..1] of Longint;
Begin
  Params[0] := Min;
  Params[1] := Max;
  MessageBox(GetStr(5), @Params, mfError + mfOKButton);
End;

{ TGStringLookupValidator object }

procedure TGStringLookupValidator.Error;
Begin
  MessageBox(GetStr(6), nil, mfError + mfOKButton);
End;

{ TIntRangeValidator
}

function TIntRangeValidator.Transfer(var S: String; Buffer: Pointer;
  Flag: TVTransfer): Word;
var
  Data: LongInt;
begin
  if Buffer <> nil
  then Data := Integer(Buffer^);
  {Transfer :=} inherited Transfer(S, @Data, Flag);
  if Buffer <> nil
  then Integer(Buffer^) := Data;
  Transfer := SizeOf(Integer);
end;

{ TRealValidator
}

constructor TRealValidator.Init(ADecimals: Integer);
Begin
  inherited Init('[{+,-}]#*#[{;,,.}#*#][{e,E}[{+,-}]#*#]', false);
  Decimals := ADecimals
End;

procedure TRealValidator.Error;
Begin
  MessageBox(GetStr(280), nil, mfError + mfOKButton)
End;

type
  PReal	= ^Real;

function TRealValidator.Transfer(var S: String; Buffer: Pointer;
  Flag: TVTransfer): Word;
var
  Code: Integer;
begin
  if Options and voTransfer <> 0 then
  begin
    Transfer := SizeOf(Real);
    case Flag of
     vtGetData:
       begin
	 Code := Pos(',', S);
	 If Code <> 0 then S[Code] := '.';
	 Val(S, PReal(Buffer)^, Code);
       end;
     vtSetData:
       If Decimals < 1
       then begin
	 Str(PReal(Buffer)^:0:10, S);
	 while (Length(S) > 0) and (S[Length(S)] = '0') do
	   Dec(S[0])
       end
       else
	 Str(PReal(Buffer)^:0:Decimals, S);
    end
  end
  else
    Transfer := 0
end;

{ Stream registration procedure }

procedure RegisterGVValid;
Begin
  RegisterType(RGPXPictureValidator);
  RegisterType(RGFilterValidator);
  RegisterType(RGRangeValidator);
  RegisterType(RGStringLookupValidator);
  RegisterType(RRealValidator);
  RegisterType(RIntRangeValidator);
End;

{$ENDIF}

End.