home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 17
/
CD_ASCQ_17_101194.iso
/
vrac
/
ptgenr2.zip
/
BBVALIDA.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-08-01
|
6KB
|
129 lines
(* This file was mangled by Mangler 1.32 (c) Copyright 1993-1994 by Berend de Boer *)
{ Created : 1993-03-30
Validator objects, overriding the error method of the Validate unit.
This validators use string resources in stead of hardwired messages.
It reserves the string resource identifier 1950..1969 for its own use.
This unit is almost a plug and play replacement for Validate. Sometimes
you need Validate too, but ALWAYS place Validate BEFORE BBValidate in the
uses clause.
Last changes :
93-12-04 Validators now store their ResStrID too
94-05-13 Added field Decimal to TRealValidator which controls how many
decimals to display when transering data to an inputline. If
Decimals = 0 it is disabled.
TRealValidator's Load and Store methods are also changed and
break existing resources!
}
{$IFDEF DPMI}
{$S-}
{$ELSE}
{$F+,O+}
{$ENDIF}
{$X+,R-}
unit BBValidate;
interface
uses Objects, Validate;
type
PFilterValidator = ^TFilterValidator;
TFilterValidator = object(Validate.TFilterValidator)
ResStrID : word;
constructor Init(AValidChars: TCharSet);
constructor Load(var S : TStream);
procedure Error; virtual;
procedure Store(var S : TStream);
end;
PRangeValidator = ^TRangeValidator;
TRangeValidator = object(Validate.TRangeValidator)
ResStrID : word;
constructor Init(AMin, AMax : longint);
constructor Load(var S : TStream);
procedure Error; virtual;
procedure Store(var S : TStream);
end;
PPXPictureValidator = ^TPXPictureValidator;
TPXPictureValidator = object(Validate.TPXPictureValidator)
ResStrID : word;
constructor Init(const APic : string; AutoFill : Boolean);
constructor Load(var S : TStream);
procedure Error; virtual;
procedure Store(var S : TStream);
end;
PRealValidator = ^TRealValidator;
TRealValidator = object(TPXPictureValidator)
Min, Max : real;
Decimals : shortint;
constructor Init(AMin, 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;
{ Validate registration procedure }
procedure RegisterBBValidate;
{ Stream registration records }
const
RFilterValidator: TStreamRec = (
ObjType: 81;
VmtLink: Ofs(TypeOf(TFilterValidator)^);
Load: @TFilterValidator.Load;
Store: @TFilterValidator.Store
);
const
RRangeValidator: TStreamRec = (
ObjType: 82;
VmtLink: Ofs(TypeOf(TRangeValidator)^);
Load: @TRangeValidator.Load;
Store: @TRangeValidator.Store
);
IMPLEMENTATION USES BBCONST , BBGUI , BBSTRRES , BBUTIL ;CONSTRUCTOR TFILTERVALIDATOR.INIT (AVALIDCHARS:TCHARSET);
BEGIN INHERITED INIT(AVALIDCHARS );RESSTRID := SFILTERERROR ;END ;CONSTRUCTOR TFILTERVALIDATOR.LOAD (VAR S:TSTREAM);
BEGIN INHERITED LOAD(S );S.READ (RESSTRID , SIZEOF (RESSTRID ));END ;PROCEDURE TFILTERVALIDATOR.ERROR ;BEGIN PRINTERROR
(RSGET (RESSTRID ), 0 );END ;PROCEDURE TFILTERVALIDATOR.STORE (VAR S:TSTREAM);BEGIN INHERITED STORE(S );S.WRITE (RESSTRID
, SIZEOF (RESSTRID ));END ;CONSTRUCTOR TRANGEVALIDATOR.INIT (AMIN,AMAX:LONGINT);BEGIN INHERITED INIT(AMIN , AMAX );
RESSTRID := SRANGEERROR ;END ;CONSTRUCTOR TRANGEVALIDATOR.LOAD (VAR S:TSTREAM);BEGIN INHERITED LOAD(S );S.READ (RESSTRID
, SIZEOF (RESSTRID ));END ;PROCEDURE TRANGEVALIDATOR.ERROR ;BEGIN PRINTERROR (RSGET2 (SRANGEERROR , MIN , MAX ), 0 );
END ;PROCEDURE TRANGEVALIDATOR.STORE (VAR S:TSTREAM);BEGIN INHERITED STORE(S );S.WRITE (RESSTRID , SIZEOF (RESSTRID ));
END ;CONSTRUCTOR TPXPICTUREVALIDATOR.INIT (CONST APIC:STRING ;AUTOFILL:BOOLEAN);BEGIN INHERITED INIT(APIC , AUTOFILL );
RESSTRID := SPICTUREERROR ;END ;CONSTRUCTOR TPXPICTUREVALIDATOR.LOAD (VAR S:TSTREAM);BEGIN INHERITED LOAD(S );S.READ
(RESSTRID , SIZEOF (RESSTRID ));END ;PROCEDURE TPXPICTUREVALIDATOR.ERROR ;BEGIN PRINTERROR (RSGET1 (RESSTRID , LONGINT
(PIC )), 0 );END ;PROCEDURE TPXPICTUREVALIDATOR.STORE (VAR S:TSTREAM);BEGIN INHERITED STORE(S );S.WRITE (RESSTRID ,
SIZEOF (RESSTRID ));END ;CONSTRUCTOR TREALVALIDATOR.INIT (AMIN,AMAX:REAL);
BEGIN INHERITED INIT('[-]#[*#][.#[*#]][E[{-,+}]#[*#]]', FALSE );MIN := AMIN ;MAX := AMAX ;RESSTRID := SREALERROR ;
DECIMALS := 4 ;END ;CONSTRUCTOR TREALVALIDATOR.LOAD (VAR S:TSTREAM);BEGIN INHERITED LOAD(S );S.READ (RESSTRID , SIZEOF
(RESSTRID ));S.READ (MIN , SIZEOF (MIN ));S.READ (MIN , SIZEOF (MAX ));S.READ (DECIMALS , SIZEOF (DECIMALS ));END ;
PROCEDURE TREALVALIDATOR.ERROR ;VAR Ol0100I,Ol0O01O:STRING ;BEGIN Ol0100I := STRIPSPC (STRR (MIN , 7 , 2 ));Ol0O01O :=
STRIPSPC (STRR (MAX , 7 , 2 ));PRINTERROR (RSGET2 (RESSTRID , LONGINT (@ Ol0100I ), LONGINT (@ Ol0O01O )), 0 );END ;
FUNCTION TREALVALIDATOR.ISVALID (CONST S:STRING ):BOOLEAN ;VAR OI1IO1O100Ol:REAL;OI0ll01lOOOl:INTEGER;BEGIN ISVALID :=
FALSE ;IF INHERITED ISVALID(S )THEN BEGIN VAL (S , OI1IO1O100Ol , OI0ll01lOOOl );IF (OI0ll01lOOOl =0 )AND (OI1IO1O100Ol
>= MIN )AND (OI1IO1O100Ol <= MAX )THEN ISVALID := TRUE ;END ;END ;PROCEDURE TREALVALIDATOR.STORE (VAR S:TSTREAM);
BEGIN INHERITED STORE(S );S.WRITE (RESSTRID , SIZEOF (RESSTRID ));S.WRITE (MIN , SIZEOF (MIN ));S.WRITE (MAX , SIZEOF
(MAX ));S.WRITE (DECIMALS , SIZEOF (DECIMALS ));END ;FUNCTION TREALVALIDATOR.TRANSFER (VAR S:STRING ;BUFFER:POINTER;
FLAG:TVTRANSFER):WORD ;VAR OI1IO1O100Ol:REAL;OI0ll01lOOOl:INTEGER;BEGIN IF OPTIONS AND VOTRANSFER <> 0 THEN
BEGIN TRANSFER := SIZEOF (OI1IO1O100Ol );CASE FLAG OF VTGETDATA :BEGIN VAL (S , OI1IO1O100Ol , OI0ll01lOOOl );REAL
(BUFFER ^):= OI1IO1O100Ol ;END ;VTSETDATA :BEGIN IF DECIMALS =0 THEN STR (REAL (BUFFER ^), S )ELSE STR (REAL (BUFFER
^):DECIMALS , S );IF S [ 1 ] =' 'THEN DELETE (S , 1 , 1 );END ;END ;END ELSE TRANSFER := 0 ;END ;
PROCEDURE REGISTERBBVALIDATE ;BEGIN REGISTERTYPE (RFILTERVALIDATOR );REGISTERTYPE (RRANGEVALIDATOR );END ;END .