home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / multtsk / cpm25d / quetest.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-04-28  |  2.6 KB  |  113 lines
  1. {$I cpmswitc.inc}
  2.  
  3. {--------------------------------------------------------------------------
  4.  
  5. QUETEST.PAS  (Test program for the Queue unit)
  6.  
  7. This program requires the CPMULTI Multitasking Toolkit and Turbo Pascal
  8. 5.0 or later.
  9.  
  10. January 1994
  11.  
  12. Copyright (C) 1994 (USA)        Copyright (C) 1989-1994
  13. Hypermetrics                    Christian Philipps Software-Technik
  14. PO Box 9700 Suite 363           Duesseldorfer Str. 316
  15. Austin, TX  78758-9700          D-47447 Moers
  16.                                 Germany
  17.  
  18. This is a demo of the Queue unit; it allows the user to enter
  19. a list of strings into a queue and then delete selected elements
  20. from the queue.
  21.  
  22. ---------------------------------------------------------------------------}
  23.  
  24. program QueueTest;
  25.         
  26. uses Queue;
  27.      
  28. type  MyRecType   = record
  29.                       Num  : Byte;
  30.                       T    : string;
  31.                     end;
  32.       MyPtrType   = ^MyRecType;
  33.                         
  34. var   MyQueue : QueueType;
  35.       MyPtr   : MyPtrType;
  36.       Work    : string;
  37.       Count   : Byte;
  38.       N       : Byte;
  39.  
  40. {$F+}
  41. function Compare(V,D:Pointer):Boolean;
  42. var BPtr : ^Byte     absolute V;
  43.     MPtr : MyPtrType absolute D;
  44. begin
  45.   Compare := (MPtr^.Num = BPtr^);
  46. end;
  47. {$F-}
  48.  
  49. {$F+}
  50. function Compare1(V,D:Pointer):Boolean;
  51. var SPtr : ^String   absolute V;
  52.     MPtr : MyPtrType absolute D;
  53. begin {Compare1}
  54.   Compare1 := (MPtr^.T = SPtr^);
  55. end;
  56. {$F-}
  57.  
  58. procedure DisplayQueue;
  59. var  N : Byte;
  60.      Z : MyPtrType;
  61. begin
  62.   for n := 1 TO Count do
  63.   begin
  64.     Z := MyPtrType(FindRec(MyQueue,@n,Compare));
  65.     if Z <> nil then 
  66.       Writeln(Z^.Num:3,' ',Z^.T);
  67.   end;
  68. end;
  69.  
  70. begin
  71.   Count := 0;
  72.   CreQueue(MyQueue);
  73.   repeat
  74.     Write('Please enter text: ');
  75.     Readln(Work);
  76.     if Byte(Work[0]) > 0 then 
  77.     begin
  78.       New(MyPtr);
  79.       Inc(Count);
  80.       with MyPtr^ do
  81.       begin
  82.         T := Work;
  83.         Num := Count;
  84.       end;
  85.       AppendRec(MyQueue,MyPtr);
  86.     end;
  87.   until Byte(Work[0]) = 0;
  88.  
  89.   Writeln('You have entered',Count,' elements!');
  90.   Writeln('Here they are...');
  91.   DisplayQueue;
  92.   Writeln;
  93.   Writeln('Remove individual elements...');
  94.   repeat
  95.     Write('Remove element with text: ');
  96.     Readln(Work);
  97.     if Byte(Work[0]) > 0 then 
  98.     begin
  99.       MyPtr := MyPtrType(FindRec(MyQueue,@Work,Compare1));
  100.       if MyPtr = nil then 
  101.         Writeln('Element not found!')
  102.       else 
  103.       begin
  104.         if RemoveRec(MyQueue,MyPtr) = nil then
  105.           { Do nothing } ;
  106.         Dispose(MyPtr);
  107.         DisplayQueue;
  108.         Writeln;
  109.       end;
  110.     end;
  111.   until Byte(Work[0]) = 0;
  112. end.
  113.