[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 275
  • Last Modified:

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....
0
buttjep
Asked:
buttjep
  • 8
  • 6
1 Solution
 
dbruntonCommented:
Post code and point out where problems are . . .
0
 
buttjepAuthor 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
 
buttjepAuthor 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);
        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
Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

 
buttjepAuthor Commented:
Adjusted points from 100 to 200
0
 
dbruntonCommented:
begin
  searchmember(wanted_name,posn,found);   ** Why is this needed again?
  seek(member_file,posn-1);
  read(member_file,vidmemrec);
  added:=false;
                     
0
 
buttjepAuthor 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
 
dbruntonCommented:
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
 
buttjepAuthor Commented:
How do i convert to julian date?
0
 
buttjepAuthor 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.');
  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
 
dbruntonCommented:
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
 
dbruntonCommented:
email

db@kcbbs.gen.nz

Actually sent email message to your hotmail address.
0
 
dbruntonCommented:
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
 
dbruntonCommented:
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
 
dbruntonCommented:
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

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

  • 8
  • 6
Tackle projects and never again get stuck behind a technical roadblock.
Join Now