i m lost pls help

Please support our Pascal and Delphi advertiser: Programming Forums - DaniWeb Sister Site
Reply

Join Date: Dec 2006
Posts: 7
Reputation: Berniceazzopard is an unknown quantity at this point 
Solved Threads: 0
Berniceazzopard Berniceazzopard is offline Offline
Newbie Poster

i m lost pls help

 
0
  #1
Jan 3rd, 2007
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;
Reply With Quote Quick reply to this message  
Join Date: Dec 2006
Posts: 171
Reputation: radu84 is an unknown quantity at this point 
Solved Threads: 16
radu84 radu84 is offline Offline
Junior Poster

Re: i m lost pls help

 
0
  #2
Jan 4th, 2007
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.
Reply With Quote Quick reply to this message  
Reply

This thread is more than three months old.
Perhaps start a new thread instead?
Message:


Thread Tools Search this Thread



About Us | Contact Us | Advertise | DaniWeb | Acceptable Use Policy | RSS Feed

©2003 - 2009 DaniWeb® LLC