home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / PASTUT34 / RECORDS.PAS < prev    next >
Pascal/Delphi Source File  |  1993-07-07  |  14KB  |  406 lines
  1. {$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,R-,S+,V+,X-}
  2. {$M 16384,0,200000}
  3.  
  4. Program Records;
  5.  
  6. {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
  7. { This program allows the user to input data to a sales record.          }
  8. { The data for the record are Name, Item, Quantity, Unit Price and VAT   }
  9. { Rate and this data can be entered into memory by the user response to  }
  10. { screen prompts. The input is checked for correctness of type and form. }
  11. { An initial menu allows the user to make a record file on disk or to    }
  12. { open an existing record file and, once open, the user can append to,   }
  13. { change data on or read from this record file. Because of the           }
  14. { sequential storage of the records on disk, it is not easy to remove a  }
  15. { record and pack the disk file. For simplicity, deletion is achieved by }
  16. { changing the record fields for name and item to spaces and the numeric }
  17. { fields to zeros, effectively giving an empty record.                   }
  18. { Finally when the user selects Quit, the program automatically closes   }
  19. { the record file before returning to DOS.                               }
  20. {                                                                        }
  21. { RECORDS.PAS  ->  RECORDS.EXE       R. Shaw       14.12.92              }
  22. {________________________________________________________________________}
  23.  
  24. uses Crt,Dos;
  25.  
  26. Type
  27.    SaleType = Record                  { A record of sales containing two }
  28.      Name       : string[50];         { string fields and three numeric  }
  29.      Item       : string[20];         { fields. For display of the data, }
  30.      Quantity   : integer;            { the total price is calculated as }
  31.      UnitPrice  : real;               { Quantity * UnitPrice*(1+VAT/100) }
  32.      VAT        : real;               { where VAT is entered as a        }
  33.    end;                               { percentage value (i.e. 17.5)     }
  34.  
  35. Const              { A set of constant strings used to display the Menu. }
  36.    i1 = 'M';
  37.    s1 = 'ake a record file - existing names will be listed.';
  38.    i2 = 'O';
  39.    s2 = 'pen an existing file - select from given list.';
  40.    i3 = 'I';
  41.    s3 = 'nput new record data - field names shown in window.';
  42.    i4 = 'A';
  43.    s4 = 'ppend new record to file - must have input in window.';
  44.    i5 = 'C';
  45.    s5 = 'hange a record on file - must have input in window.';
  46.    i6 = 'R';
  47.    s6 = 'ead a record from file - range of record numbers shown.';
  48.    i7 = 'Q';
  49.    s7 = 'uit and close any open file.';
  50.    i8 = '';
  51.    s8 = 'Please make choice by typing the initial letter: ';
  52.    i9 = '';
  53.    s9 = 'Options to input data and append, change and read ';
  54.    i10 = '';
  55.    s10 = 'records will be available, once a file is opened.';
  56.  
  57. Var
  58.   Sale          : SaleType;             { An instance of the SaleType record.}
  59.   SalesFile     : File of SaleType;     { A file of such records.            }
  60.   reply,c       : char;
  61.   Name          : string[50];
  62.   Position      : longint;
  63.   TempFile      : Text;       { Temporary file holding directory information.}
  64.   Line          : string[80];
  65.   Ch            : Char;
  66.   FName         : string[12];
  67.   Fle           : array [1..6] of string[8];
  68.   b,i, code     : integer;
  69.   rpos          : longint;
  70.   TotalCost     : real;       { Calculated as Quantity*UnitPrice*(1+VAT/100) }
  71.   Open          : Boolean;    { True if file open, false if not open.        }
  72.   IOR           : word;
  73.   QuantityStr   : string;     { These three string variables are used to     }
  74.   PriceStr      : string;     { ensure that at least one character is entered}
  75.   VATStr        : string;     { and hence ensure integrity of input.         }
  76.  
  77. Procedure Init;               { To initialise variables, window size and     }
  78. Begin                         { colour and clear the screen.                 }
  79.    name := ' ';
  80.    Sale.Name := ' ';
  81.    Sale.Item := ' ';
  82.    Sale.Quantity := 0;
  83.    Sale.UnitPrice := 0;
  84.    Sale.VAT  := 0;
  85.    reply := ' ';
  86.    Window(1,1,80,25);
  87.    TextBackGround(Black);
  88.    ClrScr;
  89.    Open := False;
  90. End;      {Proc Init}
  91.  
  92. Procedure Display(x,y : integer; I,S : string);
  93. Begin
  94.    GoToXY(x,y);               { To display two strings in different colours }
  95.    TextColor(red);            { at a specified x,y location.                }
  96.    write(I);
  97.    TextColor(Black);
  98.    write(S);
  99. End;
  100.  
  101. procedure CreateFile(Filename : string);    { To create a new file on disk, }
  102. begin                                       { open it by rewriting it, so   }
  103.    Assign(SalesFile,Filename);              { that there are no records     }
  104.    Rewrite(SalesFile);                      { preserved from a possible     }
  105.    Open := True;                            { previous file with same name. }
  106. end;        {Proc CreateFile}
  107.  
  108. procedure OpenFile(Filename : string);    { To open an existing file on disk,}
  109. begin                                     { and reset it, so that existing   }
  110.    Assign(SalesFile,Filename);            { records are preserved.           }
  111.    Reset(SalesFile);
  112.    Open := True;
  113. end;        {Proc OpenFile}
  114.  
  115.  
  116. Procedure Choices;            { To display appropriate Menu options,   }
  117. Begin                         { initially to open a file and then      }
  118.    Window(11,2,69,12);        { once open, to allow input of data, or  }
  119.    TextColor(red);            { to append, change or read a record.    }
  120.    TextBackGround(white);     { The initial letter for each option is  }
  121.    ClrScr;                    { shown in red and is used for selection.}
  122.    GoToXY(24,1);
  123.    write('MENU');
  124.    TextColor(black);
  125.    GoToXY(1,2);
  126.    write(' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~');
  127.  
  128.    If Open = True then
  129.          Begin
  130.            GoToXY(2,3);
  131.            write('File ');
  132.            TextColor(red);
  133.            write(FName);
  134.            TextColor(black);
  135.            write(' now open, please make additional choice.');
  136.            Display(2,5,i3,s3);
  137.            Display(2,6,i4,s4);
  138.            Display(2,7,i5,s5);
  139.            Display(2,8,i6,s6);
  140.            Display(2,9,i7,s7);
  141.            Display(2,11,i8,s8);
  142.          End
  143.        else
  144.          Begin
  145.            Display(2,3,i1,s1);
  146.            Display(2,4,i2,s2);
  147.            Display(2,6,i9,s9);
  148.            Display(2,7,i10,s10);
  149.            Display(2,9,i7,s7);
  150.            Display(2,11,i8,s8);
  151.          End;
  152. end;
  153.  
  154. Procedure DosDir;           { To obtain a directory listing of all record  }
  155.                             { files with extension names .REC and place    }
  156. begin                       { the list in a file RECFILE.LST, which is then}
  157.   window(15,15,60,18);      { read and the list displayed in a window below}
  158.   GoToXY(2,2);                                          { the Menu window. }
  159.   write('Please wait whilst disk is accessed... ');
  160.   TextColor(LightGray);     
  161.   SwapVectors;                                          
  162.   Exec(GetEnv('COMSPEC'),'/C DIR *.REC/W>RECFILE.LST');
  163.   If DosError <> 0 then writeln('Dos error # ',DosError);
  164.   SwapVectors;
  165.   Assign(TempFile,'RECFILE.LST');
  166.   Reset(TempFile);
  167.   Readln(TempFile,Line);
  168.   Readln(TempFile,Line);
  169.   Readln(TempFile,Line);
  170.   Readln(TempFile,Line);
  171.   window(9,15,71,20);
  172.   TextColor(Black);
  173.   TextBackGround(cyan);
  174.   ClrScr;
  175.   GoToXY(1,1);
  176.   writeln('List of existing record files: ');
  177.   Readln(TempFile,Line);
  178.   Fle[1] := Copy(Line,1,8);
  179.   Fle[2] := Copy(Line,14,8);
  180.   Fle[3] := Copy(Line,27,8);
  181.   Fle[4] := Copy(Line,40,8);
  182.   Fle[5] := Copy(Line,53,8);
  183.   Fle[6] := Copy(Line,66,8);
  184.   For i := 1 to 6 do write('  ',Fle[i],' ');
  185.   repeat
  186.       writeln;
  187.       Readln(TempFile,Line);
  188.       Ch := Line[1];
  189.       If Ch <> ' ' then
  190.          begin
  191.            Fle[1] := Copy(Line,1,8);
  192.            Fle[2] := Copy(Line,14,8);
  193.            Fle[3] := Copy(Line,27,8);
  194.            Fle[4] := Copy(Line,40,8);
  195.            Fle[5] := Copy(Line,53,8);
  196.            Fle[6] := Copy(Line,66,8);
  197.            For i := 1 to 6 do write('  ',Fle[i],' ');
  198.          end;
  199.   until Ch = ' ';
  200.   Close(TempFile);
  201.   Window(10,22,70,24);
  202.   TextColor(Yellow);
  203.   TextBackGround(Blue);
  204.   ClrScr;
  205.   GoToXY(2,2);
  206.   Write('Please enter the filename and press ENTER key: ');
  207.   Readln(FName);
  208.   b := Pos('.',FName);
  209.   If b = 0 then b := length(FName) else b := b - 1;
  210.   FName := Copy(FName,1,b);
  211.   For i := 1 to b do FName[i] := UpCase(FName[i]);
  212.   FName := FName + '.REC';
  213.   If UpCase(reply) = 'M' then CreateFile(Fname);
  214.   If UpCase(reply) = 'O' then OpenFile(Fname);
  215.   Window(1,1,80,25);
  216.   TextBackGround(black);
  217.   ClrScr;
  218.   Choices;
  219. end;         { Proc DosDIR }
  220.  
  221. Procedure RecordWindow;        { To create a window for entry of the data   }
  222.                                { for each field of the new or revised record}
  223. Begin
  224.    Window(1,13,80,25);
  225.    TextBackGround(Black);
  226.    ClrScr;
  227.    Window(2,14,78,22);
  228.    TextBackGround(White);
  229.    TextColor(Blue);
  230.    ClrScr;
  231.    GoToXY(3,3);
  232.    write('Name  (<50 characters) : ');
  233.    GoToXY(3,4);
  234.    write('Item  (<20 characters) : ');
  235.    GoToXY(3,5);
  236.    write('Quantity  (<10000)     : ');
  237.    GoToXY(3,6);
  238.    write('UnitPrice (<1 million) : ');
  239.    GoToXY(3,7);
  240.    write('VAT per cent (<100.00) : ');
  241.    GoToXY(3,8);
  242.    write('Total Cost             : ');
  243.    GoToXY(26,3);
  244. End;            { Proc RecordWindow }
  245.  
  246.  
  247. Procedure InputData;       { To input data with check of data type and form. }
  248.                            { All the data is entered in string format, to    }
  249. Begin                      { ensure that at least a space is entered. The    }
  250.   RecordWindow;            { numeric data is then converted using the VAL    }
  251.   GoToXY(2,1);             { procedure and then checked for range.           }
  252.   write('Please supply the data for this record: ');
  253.   With Sale do
  254.      Begin
  255.         {$I-}
  256.         {$R-}
  257.         Repeat
  258.            IOR:= 1;
  259.            GoToXY(28,3);
  260.            ClrEol;
  261.            Readln(Name);
  262.            IOR := IOResult;
  263.         Until (IOR = 0) and (Sale.Name <> '') and (Sale.Name[0] < #50);
  264.         IOR := 1;
  265.         Repeat
  266.            GoToXY(28,4);
  267.            ClrEol;
  268.            Readln(Item);
  269.            IOR := IOResult;
  270.         Until (IOR = 0) and (Sale.Item <> '') and (Sale.Item[0] < #20);
  271.         Repeat
  272.            GoToXY(28,5);
  273.            ClrEol;
  274.            readln(QuantityStr);
  275.            val(QuantityStr,Quantity,code);
  276.            until (QuantityStr[0] < #5) and (QuantityStr <> '') and
  277.                  (Quantity >= 0) and (code = 0);
  278.         Repeat
  279.            GoToXY(28,6);
  280.            ClrEol;
  281.            Readln(PriceStr);
  282.            val(PriceStr,UnitPrice,code);
  283.         Until (PriceStr[0] < #10) and (PriceStr <> '') and
  284.               (UnitPrice >= 0)  and (code = 0);
  285.         Repeat
  286.            GoToXY(28,7);
  287.            ClrEol;
  288.            Readln(VATStr);
  289.            val(VATStr,VAT,code);
  290.         Until (VATStr[0] < #6) and (VATStr <> '') and (VAT >= 0) and
  291.               (VAT < 100) and (code = 0);
  292.         {$I+}
  293.         {$R+}
  294.         GoToXY(28,8);
  295.         TotalCost := Quantity * UnitPrice * ( 1 + VAT/100 );
  296.         write(TotalCost:10:2);
  297.      End;
  298. End;       {Proc InputData}
  299.  
  300.  
  301. procedure AppendRecord(Filename : string);     { To append new data to the}
  302. begin                                          { currently open disk file.}
  303.    Seek(SalesFile,FileSize(SalesFile));
  304.    Write(SalesFile,Sale);
  305.    Window(1,13,80,25);
  306.    TextBackGround(black);
  307.    ClrScr;
  308. end;
  309.  
  310. procedure ChangeRecord(Filename : string; Recpos : longint);
  311. begin                                          { To change an existing record}
  312.    If Recpos > (FileSize(SalesFile) - 1) then  { on the currently open file. }
  313.      Begin
  314.        GoToXY(10,25);
  315.        write('Beyond the end of file of records. Press any key to continue.');
  316.        c := readkey;
  317.        exit;
  318.      End;
  319.    Seek(SalesFile,Recpos);
  320.    write(SalesFile,Sale);
  321.    Window(1,13,80,25);
  322.    TextBackGround(black);
  323.    ClrScr;
  324. end;
  325.  
  326. procedure ReadRecord(Filename : string; Recpos : longint);
  327. begin
  328.    If RecPos > (FileSize(SalesFile) - 1) then     { To read a specific record}
  329.      Begin                                     { from the currently open file}
  330.        GoToXY(10,25);                          { and display the information.}
  331.        write('Beyond the end of file of records. Press any key to continue.');
  332.        c := readkey;
  333.        exit;
  334.      End;
  335.    Seek(SalesFile,RecPos);
  336.    Read(SalesFile,Sale);
  337.    RecordWindow;
  338.    With Sale do
  339.    begin
  340.      GoToXY(3,1);
  341.      ClrEol;
  342.      write('Record number: ',RecPos);
  343.      GoToXY(28,3);
  344.      ClrEol;
  345.      write(Name);
  346.      GoToXY(28,4);
  347.      ClrEol;
  348.      write(Item);
  349.      GoToXY(28,5);
  350.      ClrEol;
  351.      write(Quantity:7);
  352.      GoToXY(28,6);
  353.      ClrEol;
  354.      write(UnitPrice:10:2);
  355.      GoToXY(28,7);
  356.      ClrEol;
  357.      write(VAT:10:2);
  358.      GoToXY(28,8);
  359.      TotalCost := Quantity * UnitPrice * ( 1 + VAT/100 );
  360.      write(TotalCost:10:2);
  361.    end;
  362. end;
  363.  
  364. {Main program starts here}
  365.  
  366. Begin
  367.    ClrScr;
  368.    Init;
  369.    Assign(TempFile,'RECFILE.LST');
  370.    Rewrite(TempFile);
  371.    Close(TempFile);
  372.    repeat
  373.      Choices;
  374.      reply := readkey;
  375.      write(UpCase(reply));
  376.      If (UpCase(reply) = 'C') or (UpCase(reply) = 'R') then
  377.         begin
  378.            window(10,24,70,25);
  379.            TextColor(Black);
  380.            TextBackGround(cyan);
  381.            ClrScr;
  382.            GoToXY(3,1);
  383.            writeln('Record numbers range from 0 to ',FileSize(SalesFile) - 1);
  384.            write('Please type the record number required and press ENTER: ');
  385.            readln(rpos);
  386.         end;
  387.      Case UpCase(reply) of
  388.       'M' : DosDir;
  389.       'O' : DosDir;
  390.       'I' : InputData;
  391.       'A' : AppendRecord(FName);
  392.       'C' : ChangeRecord(FName, rpos);
  393.       'R' : ReadRecord(FName, rpos);
  394.       'Q' : If Open = True then Close(SalesFile);
  395.      end;
  396.    Until UpCase(reply) = 'Q';
  397.    Window(1,1,80,25);
  398.    TextBackGround(Black);
  399.    TextColor(LightGray);
  400.    ClrScr;
  401.  end.
  402.  
  403.  
  404.  
  405.  
  406.