home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / multtsk / cpm25d / taskwin.pas < prev   
Pascal/Delphi Source File  |  1994-04-28  |  3KB  |  128 lines
  1. {$I cpmswitc.inc}
  2.  
  3. {--------------------------------------------------------------------------
  4.  
  5. TASKWIN.PAS  (Demo: Code sharing)
  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 demo program illustrates how code sharing between tasks 
  19. can be achieved very simply.
  20.  
  21. ---------------------------------------------------------------------------}
  22.  
  23. program TaskWindows;
  24.  
  25. uses CRT, CPMulti;
  26.      
  27. type WinType = record
  28.                  Top,
  29.                  Left,
  30.                  Bottom,
  31.                  Right  : word;
  32.                end;
  33.                    
  34. const NoWin   = 8;
  35.       TaskWin : array[1..8] of WinType =
  36.                 ((Top:2;Left:5;Bottom:9;Right:15),
  37.                  (Top:2;Left:25;Bottom:9;Right:35),
  38.                  (Top:2;Left:45;Bottom:9;Right:55),
  39.                  (Top:2;Left:65;Bottom:9;Right:75),
  40.                  (Top:12;Left:5;Bottom:19;Right:15),
  41.                  (Top:12;Left:25;Bottom:19;Right:35),
  42.                  (Top:12;Left:45;Bottom:19;Right:55),
  43.                  (Top:12;Left:65;Bottom:19;Right:75));
  44.                                
  45. var   Screen : Pointer;
  46.       TaskNo : Word;
  47.  
  48. {---------------------------------------------------------------------------}
  49.       
  50. procedure Frame (X1,Y1,X2,Y2:Byte);
  51. var N : Byte;
  52. begin
  53.   SemWait(Screen);
  54.   Window(1,1,80,25);
  55.   GotoXY(X1,Y1);
  56.   Write('╔');
  57.   for N := 1 TO X2-X1-1 do
  58.     Write('═');
  59.   Write('╗');
  60.   for N := 1 TO Y2-Y1-1 do
  61.   begin
  62.     GotoXY(X1,Y1+N);
  63.     Write('║');
  64.     GotoXY(X2,Y1+N);
  65.     Write('║');
  66.   end;
  67.   GotoXY(X1,Y2);
  68.   Write('╚');
  69.   for N := 1 TO X2-X1-1 do
  70.     Write('═');
  71.   Write('╝');
  72.   SemSignal(Screen);
  73. end;
  74.  
  75. {---------------------------------------------------------------------------}
  76.  
  77. {$F+}
  78. procedure SubTask(TaskNo:Pointer);
  79. var  MyNo : Word;
  80.      Pass : Word;
  81. begin
  82.   MyNo := Word(TaskNo);
  83.   Pass := 1;
  84.   with TaskWin[MyNo] do
  85.     Frame(Left-1,Top-1,Right+1,Bottom+1);
  86.   repeat
  87.     SemWait(Screen);
  88.     with TaskWin[MyNo] do
  89.     begin
  90.       Window(Left,Top,Right,Bottom);
  91.       GotoXY(2,8);
  92.       Writeln('--',Pass:4,' --');
  93.       Inc(Pass);
  94.     end;
  95.     SemSignal(Screen);
  96.     Sleep(Random(Seconds(1)));
  97.   until False;
  98. end;
  99. {$F-}
  100.  
  101. {---------------------------------------------------------------------------}
  102.  
  103. begin
  104.   ClrScr;
  105.   GotoXY(20,23);
  106.   Writeln('Press any key to exit...');
  107.   if (CreateSem(Screen) <> Sem_OK) then 
  108.   begin
  109.     Writeln('Error in creating semaphore!');
  110.     Halt(1);
  111.   end;
  112.  
  113.   SemClear(Screen);
  114.   for TaskNo := 1 to NoWin do
  115.     if CreateTask(SubTask,Pointer(TaskNo),Pri_User,500) < 0 then 
  116.     begin
  117.       Writeln(^G'Error in creating task ',TaskNo);
  118.       Halt(1);
  119.     end;
  120.   SemSignal(Screen);
  121.   repeat
  122.     Sleep(Seconds(1));
  123.   until Keypressed;
  124.   SemWait(Screen);
  125.   Window(1,1,80,25);
  126.   GotoXY(1,23);
  127. end.
  128.