# Videoshop

I am currently designing a video shop program and am having real problems with the rent/return and loans and getting it all interacting with the member and video file! Any help would be much appreciated and quickly would also be nice....
###### Who is Participating?

x

Commented:
Works OK.  Minor changes here to accommodate your date format of 6 letters and no hyphens eg dates are now 030190 and not 03-01-90

type
string80=string[80];

var
_retval:integer;
str1, str2 : string80;

procedure check_date(stream1,stream2:string80);
var
internal1,internal2:longint;
JNUM:real;
cd, month, day, year: integer;
out:string[25];

function Jul( mo, da, yr: integer): real;
var
i, j, k, j2, ju: real;
begin
i := yr;     j := mo;     k := da;
j2 := int( (j - 14)/12 );
ju := k - 32075 + int(1461 * ( i + 4800 + j2 ) / 4 );
ju := ju + int( 367 * (j - 2 - j2 * 12) / 12);
ju := ju - int(3 * int( (i + 4900 + j2) / 100) / 4);
Jul := ju;
end;

begin
out:=copy(stream1,1,2);
if copy(out,1,1)='0' then delete(out,1,1);
val(out,month,cd);
out:=copy(stream1,3,2);
if copy(out,1,1)='0' then delete(out,1,1);
val(out,day,cd);
out:=copy(stream1,5,2);
if copy(out,1,1)='0' then delete(out,1,1);
val(out,year,cd);
jnum:=jul(month,day,year);
str(jnum:10:0,out);
val(out,internal1,cd);
out:=copy(stream2,1,2);
if copy(out,1,1)='0' then delete(out,1,1);
val(out,month,cd);
out:=copy(stream2,3,2);
if copy(out,1,1)='0' then delete(out,1,1);
val(out,day,cd);
out:=copy(stream2,5,2);
if copy(out,1,1)='0' then delete(out,1,1);
val(out,year,cd);
jnum:=jul(month,day,year);
str(jnum:10:0,out);
val(out,internal2,cd);
_retval:=internal1-internal2;
end;

begin
check_date(str1, str2);
writeln('The # of days inbetween is = ',_retval);
if _retval = 0 then
writeln('The two values are equal')
else if _retval > 0 then
writeln('Str1 was bigger than str2')
else
writeln('Str2 was bigger than str1');
end.
0

Commented:
Post code and point out where problems are . . .
0

Author Commented:
Well i have written all the procedures out and basically the program compiles and the procedures run, though when say to put a video on loan, i enter members number and name, then i enter video number that member is going to loan then i get the error message {member not on file}, but it is as i go to member menu and search for that member and the details come up and the video also exists... any ideas? I can send you the program if you wish too look at it? My e-mail is derbymanager@hotmail.com if you would like to get in direct contact
0

Author Commented:
Procedure borrow;
var mem_temp:memrectype;
begin
clrscr;
verf_memb(recexist);
if recexist=true then
begin
xystring(1,5 ,'Please enter the member''s no',white,black);
xystring(5,6,'*******',white,black);
gotoxy(5,6);
xystring(5,9,'Please enter the member''s name ',red,black);
xystring(5,9,'***************',white,black);
gotoxy(5,9);
wanted_name:=memno_temp+name_temp;
xystring(5,16,'****',white,black);
gotoxy(5,16);
searchmember(wanted_name,posn,found);
if found=false then
clrscr;
xystring(20,11,' Member Does Not Exist ',red,8);
else
begin
searchmember(wanted_name,posn,found);
seek(member_file,posn-1);
if vidmemrec.vid1=' ' then vid1_loan;
if (vidmemrec.vid2=' ') and (added=false) then vid2_loan;
if (vidmemrec.vid3=' ') and (added=false) then vid3_loan;
begin
wanted:=vidmemrec.mem_no;
mem_temp:=vidmemrec;
searchmember(wanted_name,posn,found);
vidmemrec:=mem_temp;
seek(member_file,posn-1);
write(member_file,vidmemrec);
end
else
begin
clrscr;
xystring(20,11,' You already have 3 videos on hire',red,8);
repeat until keypressed;
end;
end;
end;
end;

This is my borrow/loan procedure can u see any probs?
0

Author Commented:
Adjusted points from 100 to 200
0

Commented:
begin
searchmember(wanted_name,posn,found);   ** Why is this needed again?
seek(member_file,posn-1);

0

Author Commented:
I've got most of it sorted now, only problems are how do i call up and input screen, say change a field and keep it updated. Like writing over the previous file with the new data. Also how do i search for overdue, i have tried typing in current date and comparing to the return date but it always says film is overdue even when it is not.. any ideas?
0

Commented:
How have you stored the date?  You may need to convert your dates into Julian days for the comparison.

To change just a field in the file use the seek procedure.

seek(member_file, posn - 1);
write(member_file, data_rec);

where data_rec is the record containing the fields that have changed and not changed.  You will have to have opened the file in read/write mode.

For an input screen you will need something like the following.  Assume your records have three fields.  You would need the following

type
fieldrecord : record
x : integer;     { x position on screen }
y : integer;     { y position on screen }
s : string ;      { data to hold string   }
next : integer  { next field on screen }
previous : integer { previous field on screen }
end;

datatype : array[1..3] of fieldrecord;

var
data : datatype;

When you initialise this array it will go something like this

data[1].x := 12;
data[1].y := 5;
data[1].next := 2;     { next record }
data[1].previous := 3;   { last record }

Assume your records in the files have 3 fields as well.  Then to copy them to the screen you would use

data[1].s := member_record.name;
data[2].s := member_record.date;
data[3].s := member_record.age;

for i := 1 to 3 do
begin
gotoxy(data[i].x, data[i].y);
write(data[i].s;
end;

To edit the screen - assume we are using data[1] - use the readkey procedure and edit (add letters, delete letters, insert letters) data[1].s in memoryand then write the edited version of data[1].s back to the screen.  Check if the Tab or SHFT-Tab key is pressed.  If Tab then go to the next field - data[2].  If SHFT-Tab then go to the previous field  data[3]

If I find some code I'll post to you.
0

Author Commented:
How do i convert to julian date?
0

Author Commented:
{This is my update procedure, i enter the no, it finds member and brings inputscreen data on them up, I can edit fields, so i edit a field, though when i finish and go to find member and look at the details the change i have  made is not existent.}
Procedure update;
var wanted_name:mem_no_Type;
found:boolean;
posn:integer;
begin
clrscr;
writeln('Enter Member Number.');
found:=false;
searchmember(wanted_name,posn,found);
defineinputscreen;
transferrecorddetailstoscreen;
getinputscreendata(ismember^);
seek(member_file,posn);
transferscreendetailstorecord;
write(member_file,one_member);
end;
{This is my overude procedure, so all i need to do is convert  my dates to julian dates, that would be current_date,vid1_rdate etc. vid1_rdate is entered on the input screen and is stored say as 030300 and i am comparing to this, so you reckon all i need to do is convert to julian dates?}

Procedure overdue;
var current_date:string[6];
Begin
clrscr;
if iocode_memfile <>0 then
begin
writeln(' No Such Member ');
repeat until keypressed
end
else
begin
elements:=filesize(member_file);
found:=false;
write(' Enter Member Number : ');
gotoxy(44,1);
for i:=1 to 19 do
write(chr(176));
gotoxy(44,1);
posn:=0;
begin
repeat
seek(member_file,posn);
if change_key=one_member.mem_no then
found:=true
else
inc(posn);
until found;
end;
if found then
write(' Please enter the date today :');
if current_date>one_member.vid1_rdate then
writeln('Video 1 Is Due Back Today')
else
writeln('Video 1 is not overdue');
if current_date>one_member.vid2_rdate then
writeln('Video 2 Is Overdue')
else
writeln('Video 2 is not overdue');
if current_date>one_member.vid3_rdate then
writeln('Video 3 Is Due Back Today')
else
writeln('Video 3 is not overdue');
writeln('No such file');
repeat until keypressed;
end
end;

{Is there any way i can get in direct contact with you via e-mail or icq as i really have to get the program all running tonight?}
0

Commented:
Procedure update;
var
wanted_name:mem_no_Type;
found:boolean;
posn:integer;
begin
clrscr;
writeln('Enter Member Number.');
found:=false;
searchmember(wanted_name,posn,found);
begin
defineinputscreen;
transferrecorddetailstoscreen;
getinputscreendata(ismember^);
seek(member_file,posn);
transferscreendetailstorecord;
{* Here you need to write code that identifies if one_member has the correct details for testing purposes eg.
writeln(onemember.name);
writeln(onemember.age);

You also need to check procedure transferrecorddettailstoscreen, getinputscreendata, transferscreendetailstorecord in a similar manner working your way thru the procedures.*}

write(member_file,one_member);
end;
end;
0

Commented:
email

db@kcbbs.gen.nz

0

Commented:
This ain't my code.  Comes from the SWAG archive.

{
Allright... I checked around a lot of DATE and TIME routines, and came up
with this, taken from about three different routines. This routine works,
as far as I know, and I've implemented it successfully into my own code.
If anyone knows that this routine has a bug in it, please let me know.

This procedure uses the Julian calander mathmatical equasions to convert
two dates and give the # of days inbetween. If anyone knows a faster way
of writing this procedure, please let me know.
}

type
string80=string[80];

var
_retval:integer;

procedure check_date(stream1,stream2:string80);
var
internal1,internal2:longint;
JNUM:real;
cd,month,day,year: integer;
out:string[25];

function Jul( mo, da, yr: integer): real;
var
i, j, k, j2, ju: real;
begin
i := yr;     j := mo;     k := da;
j2 := int( (j - 14)/12 );
ju := k - 32075 + int(1461 * ( i + 4800 + j2 ) / 4 );
ju := ju + int( 367 * (j - 2 - j2 * 12) / 12);
ju := ju - int(3 * int( (i + 4900 + j2) / 100) / 4);
Jul := ju;
end;

begin
out:=copy(stream1,1,2);
if copy(out,1,1)='0' then delete(out,1,1);
val(out,month,cd);
out:=copy(stream1,4,2);
if copy(out,1,1)='0' then delete(out,1,1);
val(out,day,cd);
out:=copy(stream1,7,2);
if copy(out,1,1)='0' then delete(out,1,1);
val(out,year,cd);
jnum:=jul(month,day,year);
str(jnum:10:0,out);
val(out,internal1,cd);
out:=copy(stream2,1,2);
if copy(out,1,1)='0' then delete(out,1,1);
val(out,month,cd);
out:=copy(stream2,4,2);
if copy(out,1,1)='0' then delete(out,1,1);
val(out,day,cd);
out:=copy(stream2,7,2);
if copy(out,1,1)='0' then delete(out,1,1);
val(out,year,cd);
jnum:=jul(month,day,year);
str(jnum:10:0,out);
val(out,internal2,cd);
_retval:=internal1-internal2;
end;

begin
check_date('01-01-95','01-01-94');
writeln('The # of days inbetween is = ',_retval);
end.

0

Commented:
Back on line in 6 hours from the time posted for this message.  Going to test the SWAG code but it looks OK from here.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.