0

First of all happy new year and sorry to disturb u again but i'm really lost. Im trying to enter to validate a date. Can u pls check this code and tell me why in the procedure date the program is not letting me enter the month.:rolleyes:

Unit appointments;
interface
uses crt,dos,client,trtment;
Type
app = record
ID             : string[9];
Code         : string[5];
Date           : string[10];
Time           : string[5];
Comments   : string[50];
end;


const
DayStr:array[0..6] of string[3]=('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
MonthStr:array[1..12] of string[3]=('Jan','Feb','Mar','Apr','May','Jun',
'Jul','Aug','Sep','Oct','Nov','Dec');


var
A : file of app;
opt : char;
rec : app;
found : boolean;
num, err: integer;
Year,Month,Day,WeekDay : word;
Yr,Dy,WDay : word;
mnth : string;
Mnthdays : integer;



Procedure create_app;
Procedure add_app;
Function L0(w:word):string;
Procedure Time(var Hr, Min : string);
Procedure Date(var Yr, dy, WDay: word; var mnth: string);


Implementation
{---------------------------------------------------------------------------}


Procedure create_app; {app}
begin
Assign(A,'a:\project\app.doc');
{$I-};            {compiler directives I : i/o, - : off}
Reset(A);
{$I+};            {+ : on}
If ( ioresult<>0) then
rewrite(A);
end;


{----------------------------------------------------------------------------}


Function L0(w:word):string;
var
s : string;
begin
Str(w,s);
if w<10 then
L0:='0'+s
else
L0:=s;
end;


{----------------------------------------------------------------------------}


Procedure Date(var Yr, dy, WDay  : word; var mnth : string);


Procedure Date(var Yr, dy, WDay  : word; var mnth : string);
Begin
Repeat
gotoxy(1,16);
Write('Enter year :               ');
gotoxy(14,16);
Read(yr);
GetDate(Year,Month,Day,WeekDay);
Until (year = yr) Or (yr= (year + 2));
{Repeat   }
gotoxy(1,17);
Writeln('Enter month :                   ');
gotoxy(15,17);
Readln(mnth);
if ((mnth='jan')  OR (mnth='mar') Or (mnth = 'may') OR (mnth = 'jul') or (mnth = 'aug') or
(mnth = 'oct') or (mnth = 'dec')) then
mnthdays := 31;
repeat
writeln('Enter day :');
read(dy);
until ((dy >= 1) and (dy <= (mnthdays)));
if mnth='february' then
begin
if (yr mod 4)=0 then
mnthdays:=28
else mnthdays:=29;
end;
if ((mnth='apr')  or (mnth='jun') or (mnth='sep') or (mnth='nov')) then
mnthdays:=30;
end;
{------------------------------------------------------------------------------}
Procedure add_app; {App}


var
tempid : string;
code : string;
pos, pos1 : integer;
r : clients;
r1 : treatments;
Year, Month, Day, WeekDay : word;
Hr, Min: string;
Hour,Mins,Sec,HSec : word;


begin
Clrscr;
textcolor(green);
writeln('-------------Add a record-------------');
textcolor(white);
writeln;
create_app;
GetDate(Year,Month,Day,WeekDay);
Gotoxy(32,2);
WriteLn('Current date & time : ');
Gotoxy(54,2);
GetTime(Hour,Mins,Sec,HSec);
WriteLn(DayStr[WeekDay],', ',Day,' ',MonthStr[Month],' ',Year,'  ',(L0(Hour)),':',L0(Mins));
writeln('Enter clients ID Card No.');
Writeln('ID :       ( )');
Val_id(6,4,tempId);
writeln;
pos := SearchRec_client(tempID,r);
If (pos = -1) then
begin
textcolor(green + blink);
writeln('-------------Record not found-------------');
textcolor(white);
end
Else
begin
writeln;
seek(C,pos);
Read(C,r);
writeln('ID of client is......',r.id);
writeln('Name of client.......',r.name);
writeln('Surname of client....',r.surname);
writeln;
Close(C);
writeln('Enter Code No.');
Writeln('Code :       ');
Val_code(9,11,code);
writeln;
pos1 := SearchRec(code,r1);
If (pos1 = -1) then
begin
textcolor(green + blink);
writeln('-------------Record not found-------------');
textcolor(white);
end
Else
begin
writeln;
seek(T,pos1);
Read(T,r1);
writeln('Code of treatment......',r1.code);
writeln('Name of treatment.......',r1.name);
readln;
Close(T);
Date(Yr,dy,wday,mnth);
Time(Hr,Min);
Seek(A, filesize(A));
Write(A,rec);
Close(A);
end;
end;
end;

Edited by happygeek: fixed formatting

2
Contributors
1
Reply
2
Views
10 Years
Discussion Span
Last Post by radu84
0

i'm not sure what you want to acomplish with that procedure DATE.
you have a Repeat cycle for reading an valid year(current year or year+2 ).
after the year is valid then you try to get an valid month only ONCE. You make only ONE attemp to get the month.
after you have a repeat cycle for getting a correct day.

i think this should work

procedure Date(var Yr, dy, WDay : word; var mnth : string);
Begin
 Repeat
   gotoxy(1,16);
     Write('Enter year : ');
     gotoxy(14,16);
    Read(yr);
   GetDate(Year,Month,Day,WeekDay);
 Until (year = yr) Or (yr= (year + 2));
 Repeat
    gotoxy(1,17);
    Writeln('Enter month : ');
    gotoxy(15,17);
    Readln(mnth);
 until mnth in monthstr;
if ((mnth='jan') OR (mnth='mar') Or (mnth = 'may') OR (mnth = 'jul') or (mnth = 'aug') or
   (mnth = 'oct') or (mnth = 'dec')) then
  mnthdays := 31;
if mnth='february' then
begin
 if (yr mod 4)=0 then
  mnthdays:=28
 else mnthdays:=29;
 end;
if ((mnth='apr') or (mnth='jun') or (mnth='sep') or (mnth='nov')) then
mnthdays:=30;
 repeat
   writeln('Enter day :');
   read(dy);
 until ((dy >= 1) and (dy <= (mnthdays)));
end;

if something is not correct, please excuse i only tried to modify it in delphi without checking the syntax:cheesy:.if there is a problem please run it step by step.

best regards,

This topic has been dead for over six months. Start a new discussion instead.
Have something to contribute to this discussion? Please be thoughtful, detailed and courteous, and be sure to adhere to our posting rules.