home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PROG_GEN / DATEVAL.ZIP / DATEVAL.PAS < prev    next >
Pascal/Delphi Source File  |  1994-01-22  |  8KB  |  266 lines
  1. PROGRAM DateVal;
  2.  
  3. USES App, MsgBox, Dialogs, Menus, Views, Drivers, Objects, Validate;
  4.  
  5.  
  6. TYPE
  7.   TMyApp = OBJECT(TApplication)
  8.     CONSTRUCTOR Init;
  9.     procedure DoAboutBox;
  10.     procedure DoDateDialog;
  11.     procedure InitMenuBar; virtual;
  12.     procedure HandleEvent(var Event: TEvent); virtual;
  13.   END;
  14.  
  15.   PDateValidator = ^TDateValidator;
  16.   TDateValidator = OBJECT(TPXPictureValidator)
  17.     CONSTRUCTOR Init(Autofill : Boolean);
  18.     PROCEDURE Error; VIRTUAL;
  19.     FUNCTION IsValid(CONST s : String) : Boolean; VIRTUAL;
  20.     FUNCTION Transfer(VAR S: String; Buffer: Pointer;
  21.       Flag: TVTransfer): Word; VIRTUAL;
  22.     FUNCTION CheckDate(CONST S : String) :Boolean;
  23.   END;
  24.  
  25.   TDate = ARRAY[1..3] OF word;  (* Date in the form : Month, Day, Year *)
  26.  
  27.   DateModeType = (American,ANSI,British,Italian,French,German);
  28.     (* This type designates the appearance of the date for I/O usage:
  29.  
  30.            American:    'MM/DD/YYYY'
  31.            ANSI:        'YYYY.MM.DD'
  32.            British:     'DD/MM/YYYY'
  33.            Italian:     'DD-MM-YYYY'
  34.            French:      'DD/MM/YYYY'
  35.            German:      'DD.MM.YYYY'
  36.     *)
  37.  
  38. CONST
  39.   Datemode : DateModeType = American;
  40.   Separator : char = '/';
  41.     (* Theses variables denotes the current mode for date I/O and the
  42.        separator  used for this mode.
  43.        Default it is set to American dates
  44.     *)
  45.  
  46. CONST
  47.   cmAbout = 1000;
  48.   cmTestDate = 1001;
  49.  
  50. VAR
  51.   MyApp : TMyApp;
  52.   Event : TEvent;
  53.  
  54.  
  55. (* Global date routines to be used through the whole system *)
  56.  
  57. (* Set Date mode for all date operations *)
  58.  
  59. PROCEDURE SetDateMode(Mode : DateModeType);
  60. BEGIN
  61.   DateMode:=Mode;
  62.   CASE DateMode OF
  63.     American, British, French: Separator:='/';
  64.     Italian:                   Separator:='-';
  65.     ANSI,German:               Separator:='.';
  66.   END;
  67. END;
  68.  
  69.  
  70. (* Convert a string representing a date to its components according to
  71.    the current DateMode.
  72.    If the date is not valid then the result is false and a zero date is
  73.    returned *)
  74.  
  75. FUNCTION StringToDate(CONST S : STRING; VAR Month, Day, Year : word) : boolean;
  76. VAR p1, p2: Word; fc : integer;
  77. BEGIN
  78.   Month:=0; Day:=0; Year:=0; fc:=0;
  79.   StringToDate:=False;
  80.   IF S='' THEN EXIT;  (* Empty dates not accepted *)
  81.   p1:=pos(Separator,S); IF p1=0 THEN EXIT;
  82.   p2:=pos(Separator,copy(S,p1+1,255)); IF p2=0 THEN EXIT;
  83.   VAL(copy(S,1,p1-1),Day,fc); IF fc<>0 THEN EXIT;
  84.   VAL(copy(S,p1+1,p2-1),Month,fc); IF fc<>0 THEN EXIT;
  85.   VAL(copy(S,p1+p2+1,255),Year,fc); IF fc<>0 THEN EXIT;
  86.   (* Correct for date mode *)
  87.   CASE DateMode OF
  88.     American: BEGIN p1:=Day; Day:=Month; Month:=p1; END;
  89.     ANSI:     BEGIN p1:=Day; Day:=Year; Year:=p1; END;
  90.   END;
  91.   IF Year<80 THEN Year:=Year+1900;
  92.   IF (Day>31) OR (Month>12) OR (Day<1) OR (Month<1) OR
  93.      ((Day>30) AND (Month IN [4,6,9,11])) OR
  94.      ((Month=2) AND ((Day>29) OR (Day>28) AND ((Year MOD 4<>0)
  95.       OR (Year MOD 100=0) AND (Year MOD 400<>0))))
  96.   THEN EXIT
  97.   ELSE StringToDate:=True;
  98. END; (* StringToDate *)
  99.  
  100.  
  101. (* Convert a date to a string according to the current DateMode *)
  102.  
  103. PROCEDURE DateToString(VAR Month, Day, Year : Word; VAR S : STRING);
  104. BEGIN
  105.   IF (Month=0) OR (Day=0) THEN BEGIN S:=''; EXIT; END;
  106.   Str(Year,S);
  107.   CASE DateMode OF
  108.     Ansi:    S:=S+Separator+CHR(48+Month DIV 10)+CHR(48+Month MOD 10)+
  109.                 Separator+CHR(48+Day DIV 10)+CHR(48+Day MOD 10);
  110.     American:S:=CHR(48+Month DIV 10)+CHR(48+Month MOD 10)+Separator+
  111.                 CHR(48+Day DIV 10)+CHR(48+Day MOD 10)+Separator+S;
  112.     ELSE     S:=CHR(48+Day DIV 10)+CHR(48+Day MOD 10)+Separator+
  113.                 CHR(48+Month DIV 10)+CHR(48+Month MOD 10)+Separator+S;
  114.   END;
  115. END; (* DateToString *)
  116.  
  117.  
  118.  
  119. CONSTRUCTOR TDateValidator.Init(Autofill : Boolean);
  120. VAR S : String;
  121. BEGIN
  122.   (* Construct picture mask using the current separator.
  123.      1/1/90, 1/12/90, 12/1/90, 01/01/90, 1/1/9, 1/1/1990 etc.
  124.      are all valid inputs for for a date.
  125.      The separators are put in automatically if autofill is set to true
  126.      and 2 digits are entered for the month and day *)
  127.   INHERITED Init('{#[#]}'+Separator+'{#[#]}'+Separator+'{#[###]}',AutoFill);
  128.   (* Set transfer flag to indicate validator handles transfer *)
  129.   Options:=Options or voTransfer;
  130. END;
  131.  
  132.  
  133. PROCEDURE TDateValidator.Error;
  134. BEGIN
  135.   MessageBox('Input is not a correct date',NIL,mfError+MfOKButton);
  136. END;
  137.  
  138.  
  139. FUNCTION TDateValidator.IsValid(CONST s : String) : Boolean;
  140. BEGIN
  141.   IsValid:=(Inherited IsValid(s)) and (Length(s)>0) AND CheckDate(s);
  142. END;
  143.  
  144. FUNCTION TDateValidator.CheckDate(CONST S : String) : Boolean;
  145. VAR Date : TDate;
  146. BEGIN
  147.   CheckDate:=StringToDate(S,Date[1],Date[2],Date[3]);
  148. END;
  149.  
  150. FUNCTION TDateValidator.Transfer(VAR S: String; Buffer: Pointer;
  151.   Flag: TVTransfer): Word;
  152. VAR
  153.   Date : TDate;  (* Array for month, day, year values *)
  154. BEGIN
  155.   (* Only if validator handles transfer then code is executed *)
  156.   IF Options AND voTransfer <> 0 THEN
  157.   BEGIN
  158.     Transfer := SizeOf(TDate);   (* Return non zero result to indicate ok *)
  159.     case Flag of
  160.      vtGetData: (* Get data from input line *)
  161.        begin
  162.          (* Extract month, day and year from string *)
  163.          StringToDate(S,Date[1],Date[2],Date[3]);
  164.          TDate(Buffer^):=Date; (* Use type cast to TDate *)
  165.        end;
  166.      vtSetData: (* Set data to input line *)
  167.        begin
  168.          (* Construct string from Date *)
  169.         Date:=TDate(Buffer^);     (* Use type cast to TDate type *)
  170.         DateToString(Date[1],Date[2],Date[3],S);
  171.        end;
  172.     end;
  173.   end
  174.   else
  175.     Transfer := 0;
  176. end;
  177.  
  178. procedure TMyApp.HandleEvent(var Event: TEvent);
  179. var
  180.   R: TRect;
  181. begin
  182.   inherited HandleEvent(Event);
  183.   if Event.What = evCommand then
  184.   begin
  185.     case Event.Command of
  186.       cmTestDate: BEGIN
  187.                    DoDateDialog;
  188.                    ClearEvent(Event);
  189.                   end;
  190.       cmAbout:    BEGIN
  191.                    DoAboutBox;
  192.                    ClearEvent(Event);
  193.                   end;
  194.     end;
  195.   end;
  196. end;
  197.  
  198. procedure TMyApp.InitMenuBar;
  199. var
  200.   R: TRect;
  201. begin
  202.   GetExtent(R);
  203.   R.B.Y := R.A.Y + 1;
  204.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  205.       NewItem('~D~ate Test', '', kbNoKey, cmTestDate, hcNoContext,
  206.       NewItem('~A~bout', '', kbNoKey, cmAbout, hcNoContext,
  207.       nil))
  208.   )));
  209. end;
  210.  
  211. procedure TMyApp.DoAboutBox;
  212. begin
  213.   MessageBox(#3'Date Validation Demo (c) 1994'#13 +
  214.     #3'VEROSYS Technical Automation'#13+
  215.     #3'PO-Box 663  5000 AR Tilburg'#13+#3'Netherlands',
  216.     nil, mfInformation or mfOKButton);
  217. end;
  218.  
  219. procedure TMyApp.DoDateDialog;
  220. VAR
  221.   R : TRect;
  222.   P : PView;
  223.   IP : PInputLine;
  224.   D : PDialog;
  225.   Date : TDate;
  226.   Params : Array[1..3] of LongInt;
  227. BEGIN
  228.   Date[1]:=1; Date[2]:=21; Date[3]:=1994;
  229.   R.Assign(0,0,40,7);
  230.   D:=New(PDialog,Init(R,'Test Date Validator'));
  231.   WITH D^ DO BEGIN
  232.     Options:=Options OR ofCentered;
  233.     R.Assign(20,2,35,3);
  234.     IP:=New(PInputLine,Init(R,15));
  235.     IP^.SetValidator(New(PDateValidator,Init(True)));
  236.     WITH IP^ DO Options:=OPtions or ofValidate;
  237.     Insert(IP);
  238.     R.Assign(2,2,20,3);
  239.     Insert(New(PLabel,Init(R,'~D~ate',IP)));
  240.     R.Assign(2,4,14,6);
  241.     Insert(New(PButton,Init(R,'O~k~',cmOK,bfDefault)));
  242.     Inc(R.A.X,12); Inc(R.B.X,12);
  243.     Insert(New(PButton,Init(R,'Cancel',cmCancel,bfNormal)));
  244.     SelectNext(False);
  245.   END;
  246.   IF ExecuteDialog(D,@Date)=cmOk THEN BEGIN
  247.     Params[1]:=Date[1]; Params[2]:=Date[2]; Params[3]:=Date[3];
  248.     MessageBox('Month: %d -  Day: %d - Year: %d',@Params,mfInformation+mfOkButton);
  249.   END;
  250. END;
  251.  
  252. CONSTRUCTOR TMyApp.Init;
  253. BEGIN
  254.   INHERITED Init;
  255.   Event.What := evCommand;
  256.   Event.Command := cmAbout;
  257.   PutEvent(Event);
  258. END;
  259.  
  260.  
  261.  
  262. BEGIN
  263.   MyApp.Init;
  264.   MyApp.Run;
  265.   MyApp.Done;
  266. END.