home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1994 #1
/
monster.zip
/
monster
/
PROG_GEN
/
DATEVAL.ZIP
/
DATEVAL.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-01-22
|
8KB
|
266 lines
PROGRAM DateVal;
USES App, MsgBox, Dialogs, Menus, Views, Drivers, Objects, Validate;
TYPE
TMyApp = OBJECT(TApplication)
CONSTRUCTOR Init;
procedure DoAboutBox;
procedure DoDateDialog;
procedure InitMenuBar; virtual;
procedure HandleEvent(var Event: TEvent); virtual;
END;
PDateValidator = ^TDateValidator;
TDateValidator = OBJECT(TPXPictureValidator)
CONSTRUCTOR Init(Autofill : Boolean);
PROCEDURE Error; VIRTUAL;
FUNCTION IsValid(CONST s : String) : Boolean; VIRTUAL;
FUNCTION Transfer(VAR S: String; Buffer: Pointer;
Flag: TVTransfer): Word; VIRTUAL;
FUNCTION CheckDate(CONST S : String) :Boolean;
END;
TDate = ARRAY[1..3] OF word; (* Date in the form : Month, Day, Year *)
DateModeType = (American,ANSI,British,Italian,French,German);
(* This type designates the appearance of the date for I/O usage:
American: 'MM/DD/YYYY'
ANSI: 'YYYY.MM.DD'
British: 'DD/MM/YYYY'
Italian: 'DD-MM-YYYY'
French: 'DD/MM/YYYY'
German: 'DD.MM.YYYY'
*)
CONST
Datemode : DateModeType = American;
Separator : char = '/';
(* Theses variables denotes the current mode for date I/O and the
separator used for this mode.
Default it is set to American dates
*)
CONST
cmAbout = 1000;
cmTestDate = 1001;
VAR
MyApp : TMyApp;
Event : TEvent;
(* Global date routines to be used through the whole system *)
(* Set Date mode for all date operations *)
PROCEDURE SetDateMode(Mode : DateModeType);
BEGIN
DateMode:=Mode;
CASE DateMode OF
American, British, French: Separator:='/';
Italian: Separator:='-';
ANSI,German: Separator:='.';
END;
END;
(* Convert a string representing a date to its components according to
the current DateMode.
If the date is not valid then the result is false and a zero date is
returned *)
FUNCTION StringToDate(CONST S : STRING; VAR Month, Day, Year : word) : boolean;
VAR p1, p2: Word; fc : integer;
BEGIN
Month:=0; Day:=0; Year:=0; fc:=0;
StringToDate:=False;
IF S='' THEN EXIT; (* Empty dates not accepted *)
p1:=pos(Separator,S); IF p1=0 THEN EXIT;
p2:=pos(Separator,copy(S,p1+1,255)); IF p2=0 THEN EXIT;
VAL(copy(S,1,p1-1),Day,fc); IF fc<>0 THEN EXIT;
VAL(copy(S,p1+1,p2-1),Month,fc); IF fc<>0 THEN EXIT;
VAL(copy(S,p1+p2+1,255),Year,fc); IF fc<>0 THEN EXIT;
(* Correct for date mode *)
CASE DateMode OF
American: BEGIN p1:=Day; Day:=Month; Month:=p1; END;
ANSI: BEGIN p1:=Day; Day:=Year; Year:=p1; END;
END;
IF Year<80 THEN Year:=Year+1900;
IF (Day>31) OR (Month>12) OR (Day<1) OR (Month<1) OR
((Day>30) AND (Month IN [4,6,9,11])) OR
((Month=2) AND ((Day>29) OR (Day>28) AND ((Year MOD 4<>0)
OR (Year MOD 100=0) AND (Year MOD 400<>0))))
THEN EXIT
ELSE StringToDate:=True;
END; (* StringToDate *)
(* Convert a date to a string according to the current DateMode *)
PROCEDURE DateToString(VAR Month, Day, Year : Word; VAR S : STRING);
BEGIN
IF (Month=0) OR (Day=0) THEN BEGIN S:=''; EXIT; END;
Str(Year,S);
CASE DateMode OF
Ansi: S:=S+Separator+CHR(48+Month DIV 10)+CHR(48+Month MOD 10)+
Separator+CHR(48+Day DIV 10)+CHR(48+Day MOD 10);
American:S:=CHR(48+Month DIV 10)+CHR(48+Month MOD 10)+Separator+
CHR(48+Day DIV 10)+CHR(48+Day MOD 10)+Separator+S;
ELSE S:=CHR(48+Day DIV 10)+CHR(48+Day MOD 10)+Separator+
CHR(48+Month DIV 10)+CHR(48+Month MOD 10)+Separator+S;
END;
END; (* DateToString *)
CONSTRUCTOR TDateValidator.Init(Autofill : Boolean);
VAR S : String;
BEGIN
(* Construct picture mask using the current separator.
1/1/90, 1/12/90, 12/1/90, 01/01/90, 1/1/9, 1/1/1990 etc.
are all valid inputs for for a date.
The separators are put in automatically if autofill is set to true
and 2 digits are entered for the month and day *)
INHERITED Init('{#[#]}'+Separator+'{#[#]}'+Separator+'{#[###]}',AutoFill);
(* Set transfer flag to indicate validator handles transfer *)
Options:=Options or voTransfer;
END;
PROCEDURE TDateValidator.Error;
BEGIN
MessageBox('Input is not a correct date',NIL,mfError+MfOKButton);
END;
FUNCTION TDateValidator.IsValid(CONST s : String) : Boolean;
BEGIN
IsValid:=(Inherited IsValid(s)) and (Length(s)>0) AND CheckDate(s);
END;
FUNCTION TDateValidator.CheckDate(CONST S : String) : Boolean;
VAR Date : TDate;
BEGIN
CheckDate:=StringToDate(S,Date[1],Date[2],Date[3]);
END;
FUNCTION TDateValidator.Transfer(VAR S: String; Buffer: Pointer;
Flag: TVTransfer): Word;
VAR
Date : TDate; (* Array for month, day, year values *)
BEGIN
(* Only if validator handles transfer then code is executed *)
IF Options AND voTransfer <> 0 THEN
BEGIN
Transfer := SizeOf(TDate); (* Return non zero result to indicate ok *)
case Flag of
vtGetData: (* Get data from input line *)
begin
(* Extract month, day and year from string *)
StringToDate(S,Date[1],Date[2],Date[3]);
TDate(Buffer^):=Date; (* Use type cast to TDate *)
end;
vtSetData: (* Set data to input line *)
begin
(* Construct string from Date *)
Date:=TDate(Buffer^); (* Use type cast to TDate type *)
DateToString(Date[1],Date[2],Date[3],S);
end;
end;
end
else
Transfer := 0;
end;
procedure TMyApp.HandleEvent(var Event: TEvent);
var
R: TRect;
begin
inherited HandleEvent(Event);
if Event.What = evCommand then
begin
case Event.Command of
cmTestDate: BEGIN
DoDateDialog;
ClearEvent(Event);
end;
cmAbout: BEGIN
DoAboutBox;
ClearEvent(Event);
end;
end;
end;
end;
procedure TMyApp.InitMenuBar;
var
R: TRect;
begin
GetExtent(R);
R.B.Y := R.A.Y + 1;
MenuBar := New(PMenuBar, Init(R, NewMenu(
NewItem('~D~ate Test', '', kbNoKey, cmTestDate, hcNoContext,
NewItem('~A~bout', '', kbNoKey, cmAbout, hcNoContext,
nil))
)));
end;
procedure TMyApp.DoAboutBox;
begin
MessageBox(#3'Date Validation Demo (c) 1994'#13 +
#3'VEROSYS Technical Automation'#13+
#3'PO-Box 663 5000 AR Tilburg'#13+#3'Netherlands',
nil, mfInformation or mfOKButton);
end;
procedure TMyApp.DoDateDialog;
VAR
R : TRect;
P : PView;
IP : PInputLine;
D : PDialog;
Date : TDate;
Params : Array[1..3] of LongInt;
BEGIN
Date[1]:=1; Date[2]:=21; Date[3]:=1994;
R.Assign(0,0,40,7);
D:=New(PDialog,Init(R,'Test Date Validator'));
WITH D^ DO BEGIN
Options:=Options OR ofCentered;
R.Assign(20,2,35,3);
IP:=New(PInputLine,Init(R,15));
IP^.SetValidator(New(PDateValidator,Init(True)));
WITH IP^ DO Options:=OPtions or ofValidate;
Insert(IP);
R.Assign(2,2,20,3);
Insert(New(PLabel,Init(R,'~D~ate',IP)));
R.Assign(2,4,14,6);
Insert(New(PButton,Init(R,'O~k~',cmOK,bfDefault)));
Inc(R.A.X,12); Inc(R.B.X,12);
Insert(New(PButton,Init(R,'Cancel',cmCancel,bfNormal)));
SelectNext(False);
END;
IF ExecuteDialog(D,@Date)=cmOk THEN BEGIN
Params[1]:=Date[1]; Params[2]:=Date[2]; Params[3]:=Date[3];
MessageBox('Month: %d - Day: %d - Year: %d',@Params,mfInformation+mfOkButton);
END;
END;
CONSTRUCTOR TMyApp.Init;
BEGIN
INHERITED Init;
Event.What := evCommand;
Event.Command := cmAbout;
PutEvent(Event);
END;
BEGIN
MyApp.Init;
MyApp.Run;
MyApp.Done;
END.