Solved

Videoshop

Posted on 2000-04-22
14
208 Views
Last Modified: 2010-04-16
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....
0
Comment
Question by:buttjep
  • 8
  • 6
14 Comments
 
LVL 47

Expert Comment

by:dbrunton
Comment Utility
Post code and point out where problems are . . .
0
 

Author Comment

by:buttjep
Comment Utility
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 Comment

by:buttjep
Comment Utility
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);
        readln(memno_temp);
        xystring(5,9,'Please enter the member''s name ',red,black);
        xystring(5,9,'***************',white,black);
        gotoxy(5,9);
        readln(name_temp);
        wanted_name:=memno_temp+name_temp;
        xystring(1,15,'Please enter the video number',white,black);
        xystring(5,16,'****',white,black);
        gotoxy(5,16);
        readln(vid_no_temp);
        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);
         read(member_file,vidmemrec);
         added:=false;
          if vidmemrec.vid1=' ' then vid1_loan;
          if (vidmemrec.vid2=' ') and (added=false) then vid2_loan;
          if (vidmemrec.vid3=' ') and (added=false) then vid3_loan;
          if added=true then
            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 Comment

by:buttjep
Comment Utility
Adjusted points from 100 to 200
0
 
LVL 47

Expert Comment

by:dbrunton
Comment Utility
begin
  searchmember(wanted_name,posn,found);   ** Why is this needed again?
  seek(member_file,posn-1);
  read(member_file,vidmemrec);
  added:=false;
                     
0
 

Author Comment

by:buttjep
Comment Utility
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
 
LVL 47

Expert Comment

by:dbrunton
Comment Utility
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
Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 

Author Comment

by:buttjep
Comment Utility
How do i convert to julian date?
0
 

Author Comment

by:buttjep
Comment Utility
{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.');
  readln(wanted_name);
  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);
      readln(change_key);
      posn:=0;
        begin
          repeat
            seek(member_file,posn);
            read(   member_file,one_member);
            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 :');
          readln(current_date);
           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');
         if not found then
           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
 
LVL 47

Expert Comment

by:dbrunton
Comment Utility
Procedure update;
var
  wanted_name:mem_no_Type;
  found:boolean;
  posn:integer;
begin
  clrscr;
  writeln('Enter Member Number.');
  readln(wanted_name);
  found:=false;
  searchmember(wanted_name,posn,found);
  if not found then
    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
 
LVL 47

Expert Comment

by:dbrunton
Comment Utility
email

db@kcbbs.gen.nz

Actually sent email message to your hotmail address.
0
 
LVL 47

Expert Comment

by:dbrunton
Comment Utility
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
 
LVL 47

Expert Comment

by:dbrunton
Comment Utility
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
 
LVL 47

Accepted Solution

by:
dbrunton earned 200 total points
Comment Utility
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
  readln(str1);
  readln(str2);
  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

Featured Post

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

HOW TO: Install and Configure VMware vSphere Hypervisor 6.5 (ESXi 6.5), Step by Step Tutorial with screenshots. From Download, Checking Media, to Completed Installation.
Restoring deleted objects in Active Directory has been a standard feature in Active Directory for many years, yet some admins may not know what is available.
This video discusses moving either the default database or any database to a new volume.
This video gives you a great overview about bandwidth monitoring with SNMP and WMI with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're looking for how to monitor bandwidth using netflow or packet s…

771 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now