944,054 Members | Top Members by Rank

Ad:
Jan 3rd, 2007
0

i m lost pls help

Expand Post »
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;
Similar Threads
Reputation Points: 10
Solved Threads: 0
Newbie Poster
Berniceazzopard is offline Offline
7 posts
since Dec 2006
Jan 4th, 2007
0

Re: i m lost pls help

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

Pascal and Delphi Syntax (Toggle Plain Text)
  1. procedure Date(var Yr, dy, WDay : word; var mnth : string);
  2. Begin
  3. Repeat
  4. gotoxy(1,16);
  5. Write('Enter year : ');
  6. gotoxy(14,16);
  7. Read(yr);
  8. GetDate(Year,Month,Day,WeekDay);
  9. Until (year = yr) Or (yr= (year + 2));
  10. Repeat
  11. gotoxy(1,17);
  12. Writeln('Enter month : ');
  13. gotoxy(15,17);
  14. Readln(mnth);
  15. until mnth in monthstr;
  16. if ((mnth='jan') OR (mnth='mar') Or (mnth = 'may') OR (mnth = 'jul') or (mnth = 'aug') or
  17. (mnth = 'oct') or (mnth = 'dec')) then
  18. mnthdays := 31;
  19. if mnth='february' then
  20. begin
  21. if (yr mod 4)=0 then
  22. mnthdays:=28
  23. else mnthdays:=29;
  24. end;
  25. if ((mnth='apr') or (mnth='jun') or (mnth='sep') or (mnth='nov')) then
  26. mnthdays:=30;
  27. repeat
  28. writeln('Enter day :');
  29. read(dy);
  30. until ((dy >= 1) and (dy <= (mnthdays)));
  31. 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,
Last edited by radu84; Jan 4th, 2007 at 1:55 am.
Reputation Points: 14
Solved Threads: 16
Junior Poster
radu84 is offline Offline
171 posts
since Dec 2006

This thread is more than three months old

No one has posted to this discussion for at least three months. Please let old threads die and do not reply to them unless you feel you have something new and valuable to contribute that absolutely must be added to make the discussion complete. Otherwise, please start a new thread in this forum instead.
Message:
Previous Thread in Pascal and Delphi Forum Timeline: validate days in a month
Next Thread in Pascal and Delphi Forum Timeline: how can i print a list of records





About Us | Contact Us | Advertise | Acceptable Use Policy
Forum Index | Build Custom RSS Feed


Follow us on Twitter


© 2011 DaniWeb® LLC