home *** CD-ROM | disk | FTP | other *** search
/ Power Programming / powerprogramming1994.iso / progtool / turbopas / qwik55.arc / QWIKDEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1989-08-24  |  24KB  |  713 lines
  1. { =========================================================================== }
  2. { QwikDemo.pas - Demo program for QWIK screen utilities.    ver 5.5, 08-24-89 }
  3. { Demo has been programmed best for color cards in 25-line mode.              }
  4. { =========================================================================== }
  5.  
  6. program QwikDemo;
  7.  
  8. { R-,S-,I-,D-,T-,F-,V-,B-,N-,L+ }       { TP4 directives }
  9. {$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}  { TP5 directives }
  10. {$M 12000, 0, 0}
  11.  
  12. uses
  13.   Crt,Qwik,Strs;
  14.  
  15. type
  16.   BrdrRec =
  17.     record                 { For Qbox procedure }
  18.       TL,TH,TR,LV,RV,BL,BH,BR: char;
  19.     end;
  20.  
  21. var
  22.   Row,Rows,Col,Cols,Step,ColMax: byte;
  23.   i,Count,
  24.   Fgrnd,Bgrnd:         word;
  25.   BrdrAttr, WndwAttr:  integer;
  26.   SavedBlock, PopUpBlock: array [1..4000] of byte;
  27.   BlkRow,BlkCol,V:               byte;
  28.   ColL,ColR: array [1..3] of byte;
  29.   Strng,Strng2:          string[75];
  30.   Data: array [1..9 ] of string[40];
  31.   PC:   array [1..14] of string[40];
  32.   Init: array [1..10] of string[40];
  33.   Other:array [1..12] of string[40];
  34.   Crsr: array [1..13] of string[40];
  35.   Eoss: array [1.. 4] of string[40];
  36.   Rnum:                  Real;
  37.   Ch:                    char;
  38.   LastVideoMode:         byte;
  39.  
  40. const
  41.   Wait: word = 400;      { One unit of wait in milliseconds for demo. }
  42.   { These are double lines for Qbox }
  43.   Border: BrdrRec =  (TL:'╔';TH:'═';TR:'╗';
  44.                       LV:'║';       RV:'║';
  45.                       BL:'╚';BH:'═';BR:'╝');
  46.   BWcolors: array[0..3] of byte = (
  47.               Black,        { Black     on Black }
  48.               LightGray,    { LightGray on Black }
  49.               White,        { White     on Black }
  50.               LightGrayBG); { Black     on LightGray }
  51.  
  52. { Since Zenith doesn't have snow on any CGAs, turn off snow checking }
  53. procedure CheckZenith;
  54. var  ZdsRom: array[1..8] of char absolute $F000:$800C;
  55. begin
  56.   if Qsnow and (ZdsRom='ZDS CORP') then
  57.     begin
  58.       Qsnow    := false;
  59.       CardSnow := false;
  60.     end;
  61. end;
  62.  
  63. { Qbox is an application of QWIK screen utilities.  It can make fast
  64.   pop-up menus.  See WNDWxx.ARC for more applications. }
  65. procedure Qbox (Row,Col,Rows,Cols: byte; WndwAttr,BrdrAttr: integer;
  66.                                                       Brdr: BrdrRec);
  67. begin
  68.   if (Rows>=2) and (Cols>=2) then
  69.   begin
  70.     with Brdr do
  71.     begin
  72.       Qwrite    (Row       ,Col                     ,BrdrAttr,TL);
  73.       QfillEos  (                           1,Cols-2,BrdrAttr,TH);
  74.       QwriteEos (                                    BrdrAttr,TR);
  75.       Qfill     (Row+1     ,Col       ,Rows-2,1     ,BrdrAttr,LV);
  76.       Qfill     (Row+1     ,Col+Cols-1,Rows-2,1     ,BrdrAttr,RV);
  77.       Qwrite    (Row+Rows-1,Col                     ,BrdrAttr,BL);
  78.       QfillEos  (                           1,Cols-2,BrdrAttr,BH);
  79.       QwriteEos (                                    BrdrAttr,BR);
  80.       Qfill     (Row+1     ,Col+1     ,Rows-2,Cols-2,WndwAttr,' ')
  81.     end
  82.   end
  83. end;
  84.  
  85. procedure CloseDemo;
  86. begin
  87.   if QVideoMode<=CO40 then
  88.     begin
  89.       if LastVideoMode>CO40 then
  90.         delay (Wait*4);
  91.       TextMode (LastVideoMode+hi(LastMode));
  92.     end;
  93.   GotoRC (23, 1);
  94.   SetCursor (CursorInitial);
  95. end;
  96.  
  97. procedure PromptKey;
  98. begin
  99.   Qwrite (25,CRTcols-19,SameAttr,'press any key ...');
  100.   Ch := ReadKey;
  101.   if Ch=#27 then
  102.     begin
  103.       CloseDemo;
  104.       Halt;
  105.     end;
  106. end;
  107.  
  108. procedure ClearScreen (Attr: integer);
  109. begin
  110.   Qfill ( 1, 1,CRTrows,CRTcols,Attr,' ');
  111. end;
  112.  
  113. procedure ExplodeBoxes;
  114. var
  115.   TopRow,BottomRow,MaxRows,MaxCols,DeltaCols,LeftCol,RightCol: byte;
  116.   CenterCol:    byte;
  117.   ClockReading: word absolute $0040:$006C; { low memory clock }
  118.   StartTime:    word;
  119.  
  120. {}procedure ScatterBoxes;
  121. {}begin
  122. {}  Rows:= succ(random(MaxRows));
  123. {}  if QVideoMode<=CO40 then              { Keep aspect 1:1 }
  124. {}       Cols:= Rows + Rows shr 2         { 1.2 cols/row }
  125. {}  else Cols:= Rows shl 1 + Rows shr 1;  { 2.4 cols/row }
  126. {}  Col := LeftCol + random (RightCol-LeftCol-Cols+2);
  127. {}  Row := TopRow  + random (BottomRow-TopRow-Rows+2);
  128. {}  if QVideoMode=Mono then
  129. {}  TextAttr:=BWcolors[(random(4))]
  130. {}  else
  131. {}    begin
  132. {}      Fgrnd:= random (16);
  133. {}      Bgrnd:= random (8);
  134. {}      if Bgrnd=Fgrnd then inc(Fgrnd);
  135. {}      TextAttr:=Fgrnd + Bgrnd shl 4;
  136. {}    end;
  137. {}  Qfill (Row,Col,Rows,Cols,TextAttr,#178);
  138. {}end;
  139.  
  140. begin
  141.   CenterCol:=CRTcols shr 1;
  142.   randomize;
  143.   StartTime:=ClockReading;
  144.   for Step:=1 to 12 do
  145.     begin
  146.       { Set boundaries }
  147.       TopRow:=13-Step;
  148.       BottomRow:=13+Step;
  149.       MaxRows:=Step;
  150.       if QVideoMode<=CO40 then                      { Keep aspect 1:1 }
  151.         begin
  152.           MaxCols:= MaxRows + MaxRows shr 2;        { 1.2 cols/row }
  153.           DeltaCols:=(Step*5 div 3);
  154.         end
  155.       else
  156.         begin
  157.           MaxCols:= MaxRows shl 1 + MaxRows shr 1;  { 2.4 cols/row }
  158.           DeltaCols:=(Step*10 div 3);
  159.         end;
  160.       LeftCol  :=succ(CenterCol)-DeltaCols;
  161.       RightCol :=CenterCol+DeltaCols;
  162.       if Step<12 then
  163.         begin
  164.           for Count:=1 to 40 do ScatterBoxes;
  165.         end
  166.       else
  167.         repeat
  168.           ScatterBoxes;
  169.         until ClockReading-StartTime>=60;  { about 60/18.2 seconds }
  170.     end;
  171. end;
  172.  
  173. procedure InitDemo;
  174. begin
  175. { --- Set up data --- }
  176. { If you set a mode, do it first before Qinit! }
  177. { Please!  Test a mode first to see if it is different than what you want; }
  178. { then change if necessary.  Otherwise, the screen jumps. }
  179.  
  180.   CheckBreak := false;
  181.   CheckZenith;
  182.   SetMultiTask;
  183.   LastVideoMode := QVideoMode;
  184.   if (QVideoMode<>Mono) and not Have3270 then
  185.     begin
  186.       ClearScreen (LightGray+BlackBG);
  187.       QwriteC (11,1,CRTcols,SameAttr,'(1) 40 column mode');
  188.       QwriteC (12,1,CRTcols,SameAttr,'(2) 80 column mode');
  189.       QwriteC (14,1,CRTcols,SameAttr,'Which mode [1,2]? ');
  190.       GotoEos;
  191.       repeat
  192.         Ch:=ReadKey;
  193.       until ch in ['1','2'];
  194.       V := QVideoMode;
  195.       case ch of
  196.         '1': case V of
  197.                BW80: V:=BW40;
  198.                CO80: V:=CO40;
  199.              end;
  200.         '2': case V of
  201.                BW40: V:=BW80;
  202.                CO40: V:=CO80;
  203.              end;
  204.       end;
  205.       if V<>QVideoMode then
  206.         begin
  207.           TextMode (V+hi(LastMode));
  208.           Qinit;           { << Do Qinit again after change of mode!! }
  209.           CheckZenith;
  210.           SetMultiTask;
  211.         end;
  212.     end;
  213.   ModCursor (CursorOff);
  214.   Strng:=   ' Q Screen Utilities ';
  215.   Strng2:=  ' QWIK Screen Utilities  ';
  216.   Data[1]:= '1';
  217.   Data[2]:= '22';
  218.   Data[3]:= '333';
  219.   Data[4]:= Strng;
  220.   Data[5]:= 'Odd  Length';
  221.   Data[6]:= 'Even  Length';
  222.   Data[7]:= '18 characters wide';
  223.   Data[8]:= '19 characters width';
  224.   Data[9]:= 'Margin to Margin width';
  225.   PC[1]:=  'COMPUTERS:           ADAPTERS:';
  226.   PC[2]:=  '------------------   ----------';
  227.   PC[3]:=  'IBM PC               MDA';
  228.   PC[4]:=  'IBM XT               CGA';
  229.   PC[5]:=  'IBM AT               EGA';
  230.   PC[6]:=  'IBM PCjr             MCGA';
  231.   PC[7]:=  'IBM PC Convertible   VGA';
  232.   PC[8]:=  'IBM PS/2 Model 25    8514/A';
  233.   PC[9]:=  'IBM PS/2 Model 30    Hercules:';
  234.   PC[10]:= 'IBM PS/2 Model 50      HGC';
  235.   PC[11]:= 'IBM PS/2 Model 60      HGC Plus';
  236.   PC[12]:= 'IBM PS/2 Model 70      InColor';
  237.   PC[13]:= 'IBM PS/2 Model 80';
  238.   PC[14]:= 'IBM 3270 PC';
  239.   Other[ 1]:='QscrollUp  - Qwik scroll up';
  240.   Other[ 2]:='QscrollDown- Qwik scroll down';
  241.   Other[ 3]:='QscrToVscr - block to virtual screen';
  242.   Other[ 4]:='QVscrToScr - virtual screen to block';
  243.   Other[ 5]:='QreadStr   - reads string from screen';
  244.   Other[ 6]:='QreadChar  - reads char   from screen';
  245.   Other[ 7]:='QreadAttr  - reads attr   from screen';
  246.   Other[ 8]:='QviewPage  - view any video page';
  247.   Other[ 9]:='QwritePage - write to any video page';
  248.   Other[10]:='QwriteA    - for arrays/partial strings';
  249.   Other[11]:='QfillC     - a self-centering Qfill';
  250.   Other[12]:='QattrC     - a self-centering Qattr';
  251.   Crsr[ 1]:='GotoRC        - absolute cursor position';
  252.   Crsr[ 2]:='WhereR        - absolute cursor row';
  253.   Crsr[ 3]:='WhereC        - absolute cursor column';
  254.   Crsr[ 4]:='SetCursor     - sets cursor mode';
  255.   Crsr[ 5]:='GetCursor     - gets cursor mode';
  256.   Crsr[ 6]:='ModCursor     - modifies cursor mode';
  257.   Crsr[ 7]:='CursorInitial   - cursor at startup';
  258.   Crsr[ 8]:='CursorUnderline - normal cursor';
  259.   Crsr[ 9]:='CursorHalfBlock - for insert editing';
  260.   Crsr[10]:='CursorBlock     - for the nearsighted';
  261.   Crsr[11]:='A total of 40 utilities';
  262.   Crsr[12]:='optimizing in just 2.5k bytes or less!';
  263.   Init[1]:='∙ Detects dual monitor/adapters for all';
  264.   Init[2]:='   systems listed on the previous page';
  265.   Init[3]:='∙ Identifies each system by name';
  266.   Init[4]:='∙ Gets System ID and Submodel ID';
  267.   Init[5]:='∙ Gets CPU ID';
  268.   Init[6]:='∙ Sets FAR pointer for virtual screens';
  269.   Init[7]:='∙ Determines need for wait-for-retrace';
  270.   Init[8]:='∙ Gets screen dimensions: Rows by Cols';
  271.   Init[9]:='∙ Determines the number of video pages';
  272.   Init[10]:='∙ Sets 4 standard cursor shapes';
  273.   Eoss[1]:=' ∙ QwriteEos  - just like Qwrite  ';
  274.   Eoss[2]:=' ∙ QwriteEosA - just like QwriteA ';
  275.   Eoss[3]:=' ∙ QfillEos   - just like Qfill   ';
  276.   Eoss[4]:=' ∙ QattrEos   - just like Qattr   ';
  277. end;
  278.  
  279. procedure ExplodeScreen;
  280. begin
  281.   { --- Initial screen --- }
  282.   ClearScreen (White+BlueBG);
  283.   QwriteC (11, 1,CRTcols,Yellow+BlueBG,Strng2);
  284.   QwriteC (13, 1,CRTcols,SameAttr,'Your screen is about to explode.');
  285.   QwriteC (14, 1,CRTcols,SameAttr,'Hold on to your seat ...');
  286.   Delay   (Wait*5);
  287.  
  288.   { --- Explosion of Boxes --- }
  289.   ClearScreen (Black+LightGrayBG);
  290.   ExplodeBoxes;
  291.  
  292.   QfillC  (10, 1,CRTcols, 6,34,RedBG  ,' ');
  293.   QfillC  (11, 1,CRTcols, 4,30,BrownBG,' ');
  294.   TextAttr:= Yellow+RedBG;
  295.   QwriteC (12, 1,CRTcols,TextAttr,Strng2);
  296.   QwriteC (13, 1,CRTcols,TextAttr,'      Version  5.5      ');
  297. end;
  298.  
  299. procedure SaveScreen;
  300. begin
  301.   { --- Save Screen for Page Demo --- }
  302.   if MaxPage>0 then
  303.     begin
  304.       QstoreToMem ( 1, 1,25,CRTcols,SavedBlock);
  305.       QwritePage  (1);
  306.       QstoreToScr ( 1, 1,25,CRTcols,SavedBlock);
  307.       QwritePage  (0);
  308.     end;
  309.   { --- End of Save Screen --- }
  310.   Delay   (Wait*4);
  311.   TextAttr:= White+BlueBG;
  312.   QwriteC ( 6, 1,CRTcols,TextAttr,' Qwrite will write with new attributes  ');
  313.   QwriteC ( 7, 1,CRTcols,TextAttr,' that you specify direct to the screen. ');
  314.   Delay   (Wait*6);
  315.   QwriteC (18, 1,CRTcols,SameAttr,'Qwrite will also use existing attributes');
  316.   QwriteC (19, 1,CRTcols,SameAttr,'   when you do not even know or care.   ');
  317.                         { highlight the word 'existing' }
  318.   QattrC  (18, 6,CRTcols+5,1,10,White+RedBG+Blink);
  319.   Delay   (wait*10);
  320.   QwriteC (21, 1,CRTcols,TextAttr,' Say Goodbye to this screen. ');
  321.  
  322.   Delay   (wait*3);
  323.   { --- Disintigrate Screen --- }
  324.   for i:=1 to 5000 do
  325.     begin
  326.       Row:=random(25)+1;
  327.       Col:=random(CRTcols)+1;
  328.       Qfill (row,col, 1, 1,Black,' ');
  329.     end;
  330. end;
  331.  
  332. procedure ListCompatibles;
  333. begin
  334.   { --- Compatible computer and adapter list --- }
  335.   ClearScreen (LightGrayBG);
  336.   QwriteC ( 4, 1,CRTcols,SameAttr,'QWIK Screen Utilities detects these IBM');
  337.   QwriteC ( 5, 1,CRTcols,SameAttr,'or compatible computers and adapters:');
  338.   delay   (wait*5);
  339.   Col:=(CRTcols-30) shr 1;
  340.   for Row:=7 to 20 do
  341.     Qwrite (Row,Col,SameAttr,PC[Row-6]);
  342.   QwriteC (23, 1,CRTcols,SameAttr,'Working text modes 0,1,2,3, or 7!');
  343.   PromptKey;
  344. end;
  345.  
  346. procedure ListDetection;
  347. begin
  348.   { --- Qinit detection --- }
  349.   ClearScreen (LightGrayBG);
  350.   QwriteC ( 4, 1,CRTcols,SameAttr,'To configure QWIK, Qinit not only');
  351.   QwriteC ( 5, 1,CRTcols,SameAttr,'detects computers/adapters, it:');
  352.   delay   (wait*5);
  353.   Col:=(CRTcols-36) shr 1;
  354.   for Row:=10 to 19 do
  355.     Qwrite (Row,Col,SameAttr,Init[Row-9]);
  356.   PromptKey;
  357. end;
  358.  
  359. procedure UsingStr;
  360. begin
  361.   { --- Qwrite with Str on Reals Demo --- }
  362.   ClearScreen (Yellow+BlackBG);
  363.   QwriteC ( 2, 1,CRTcols,SameAttr,'Qwrite with the Strs unit will write');
  364.   QwriteC ( 3, 1,CRTcols,SameAttr,'reals and integers faster:');
  365.   Delay   (wait*7);
  366.   Rnum:=1.23E+05;
  367.   for col:=0 to CRTcols div 20 -1 do
  368.   for row:=5 to 24 do
  369.   begin
  370.     Rnum:=Rnum+1;
  371.     Qwrite (row,col*20+4,SameAttr,StrRF(Rnum,12));
  372.   end;
  373.   PromptKey;
  374. end;
  375.  
  376. procedure Centering;
  377. begin
  378.   { --- Centering Demo --- }
  379.   ClearScreen (LightGrayBG);
  380.   QwriteC ( 2, 1,CRTcols,SameAttr,'QwriteC will automatically');
  381.   QwriteC ( 3, 1,CRTcols,SameAttr,'center your data ...');
  382.   QwriteC ( 4, 1,CRTcols,SameAttr,'(Odd breaks are shifted to the left.)');
  383.   Delay   (wait*6);
  384.  
  385.   { - Set up columns for varying column modes - }
  386.   ColL[2]:=1; ColR[2]:=CRTcols;
  387.   if CRTcols<80 then
  388.     begin
  389.       ColL[1]:=ColL[2]; ColL[3]:=CRTcols div 2;
  390.       ColR[1]:=ColR[2]; ColR[3]:=CRTcols div 2;
  391.     end
  392.   else
  393.     begin
  394.       ColL[1]:=3; ColR[1]:=26; ColL[3]:=CRTcols-14; ColR[3]:=CRTcols-14;
  395.     end;
  396.  
  397.   QwriteC ( 7,ColL[1],ColR[1],SameAttr,'between margins ...');
  398.   Qbox    ( 8,(ColL[1]+ColR[1]) shr 1 -12,15,26,white,LightGray,Border);
  399.   Delay   (wait*3);
  400.   for row:=11 to 19 do
  401.     QwriteC (row,ColL[1],ColR[1],SameAttr, Data[row-10]);
  402.   Delay   (wait*5);
  403.  
  404.   QwriteC ( 7,ColL[2],ColR[2],SameAttr,'between two columns ...');
  405.   QfillC  ( 9,ColL[2],ColR[2],13,24,Yellow,' ');     {  Clear window }
  406.   for row:= 9 to 21 do
  407.     QwriteC  (row,ColL[2],ColR[2],SameAttr,'><');     {  Show two columns  }
  408.   Delay   (wait*3);
  409.   for row:=11 to 19 do
  410.     QwriteC (row,ColL[2],ColR[2],LightRed, Data[row-10]);
  411.   Delay   (wait*5);
  412.  
  413.   QwriteC ( 7,ColL[3],ColR[3],SameAttr,'or on a center line ...');
  414.   QfillC  ( 8,ColL[3],ColR[3],15,27,Black+LightGrayBG,' ');  {Clear window}
  415.   for row:=09 to 21 do                 {  Show center line  }
  416.     QwriteC  (row,ColL[3],ColR[3],Black+LightGrayBG,'|');
  417.   Delay   (wait*3);
  418.   for row:=11 to 19 do
  419.     QwriteC (row,ColL[3],ColR[3],SameAttr, Data[row-10]);
  420.   PromptKey;
  421. end;
  422.  
  423. procedure QwikFilling;
  424. begin
  425.   { --- Qfill Demo --- }
  426.   ClearScreen (White+BlackBG);
  427.   QwriteC ( 2, 1,CRTcols,SameAttr,'Qfill as well as Qattr can fill');
  428.   QwriteC ( 3, 1,CRTcols,SameAttr,'your screen in several ways.');
  429.   Delay   (wait*7);
  430.  
  431.   QwriteC ( 7, 1,CRTcols,SameAttr,'by rows ...');
  432.   Delay   (wait*3);
  433.   for row:= 9 to 24 do
  434.     Qfill (row, 2, 1,CRTcols-2,9+row,Chr(row+56));
  435.   Delay   (wait*5);
  436.  
  437.   Qfill   ( 7, 1,19,CRTcols,white,' ');       {  Clear Lines }
  438.   QwriteC ( 7, 1,CRTcols,SameAttr,'by columns ...');
  439.   Delay   (wait*3);
  440.   for col:=2 to CRTcols-2 do
  441.     Qfill ( 9,col,16,1,16+col,chr(col+63));
  442.   Delay   (wait*5);
  443.  
  444.   Qfill   ( 7, 1,19,CRTcols,white,' ');       {  Clear Lines }
  445.   QwriteC ( 7, 1,CRTcols,SameAttr,'or by row-by-column blocks ...');
  446.   Delay   (wait*3);
  447.     Qfill ( 9,2,16,CRTcols-2,Yellow+BlueBG,'!');
  448.   Delay   (wait*5);
  449. end;
  450.  
  451. procedure QboxDemo;
  452. begin
  453.   { --- Qbox demo --- }
  454.   ClearScreen (LightGrayBG);
  455.   QwriteC ( 2, 1,CRTcols,SameAttr,'Qbox is an application procedure made');
  456.   QwriteC ( 3, 1,CRTcols,SameAttr,'from Qwrite and Qfill.  Together they');
  457.   QwriteC ( 4, 1,CRTcols,SameAttr,'can make windows with borders easy.');
  458.   Delay   (wait*9);
  459.   QwriteC (14, 1,CRTcols,SameAttr,'How about 100 of them? ... ');
  460.   Delay   (wait*4);
  461.   ColMax:=CRTcols-21;
  462.   for i:=1 to 100 do
  463.     begin
  464.       row:=random (10)+6;
  465.       col:=random (ColMax)+2;
  466.       if QVideoMode=Mono then
  467.         begin
  468.           BrdrAttr:=BWcolors[random(4)];
  469.           WndwAttr:=BWcolors[random(4)];
  470.         end
  471.       else
  472.         begin
  473.           BrdrAttr:=random (128);
  474.           WndwAttr:=random (128);
  475.         end;
  476.       Qbox (row,col,10,20,BrdrAttr,WndwAttr,Border);
  477.     end;
  478.   Delay   (wait*10);
  479. end;
  480.  
  481. procedure PopUpDemo;
  482. begin
  483.   { --- Block Transfer and PopUp Demo --- }
  484.   Qfill   ( 1, 1,25,CRTcols,yellow,'?');       {  Clear Screen }
  485.   QfillC  (10, 1,CRTcols, 6,40,BrownBG,' ');   {  Clear Block }
  486.   QwriteC (11, 1,CRTcols,SameAttr,'Qstore will save and restore');
  487.   QwriteC (12, 1,CRTcols,SameAttr,'Row-by-Column blocks on your display.');
  488.   QwriteC (13, 1,CRTcols,SameAttr,'It is so fast, I have to slow it down');
  489.   QwriteC (14, 1,CRTcols,SameAttr,'so you can see it.');
  490.     Delay (wait*11);
  491.     BlkRow:=8;
  492.     BlkCol:=CRTcols div 2 - 9;
  493.   QstoreToMem(BlkRow,BlkCol,10,20,SavedBlock);
  494.   { --- Make a Pop Up Menu --- }
  495.   Qbox (BlkRow,BlkCol,10,20,Yellow+BlueBG,Brown+BlueBG,Border);
  496.   QwriteC (BlkRow+4,BlkCol,BlkCol+20,SameAttr,'Pop Up');
  497.   QwriteC (BlkRow+5,BlkCol,BlkCol+20,SameAttr,'Menu');
  498.   { --- End of Pop Up Menu --- }
  499.   QstoreToMem (BlkRow,BlkCol,10,20,PopUpBlock);
  500.     Delay (wait*4);
  501.   ColMax:=CRTcols-20;
  502.   for i:=1 to 30 do
  503.     begin
  504.       Delay (Wait div 2);
  505.       QstoreToScr (BlkRow,BlkCol,10,20,SavedBlock);
  506.       BlkRow:=random(15)+1;
  507.       BlkCol:=random(ColMax)+1;
  508.       QstoreToMem (BlkRow,BlkCol,10,20,SavedBlock);
  509.       QstoreToScr (BlkRow,BlkCol,10,20,PopUpBlock);
  510.     end;
  511. end;
  512.  
  513. procedure PageDemo;
  514. begin
  515.   { --- Page Demo --- }
  516.   if (MaxPage>0) and not InMultiTask then
  517.     begin
  518.       QviewPage  (1);
  519.       QwritePage (1);
  520.       TextAttr:= Yellow+BlueBG;
  521.       QfillC  (20, 1,CRTcols, 3,35,TextAttr,' ');
  522.       QwriteC (20, 1,CRTcols,SameAttr,' Remember this page?  ');
  523.       QwriteC (21, 1,CRTcols,SameAttr,' It wasn''t lost, but saved using ');
  524.       QwriteC (22, 1,CRTcols,SameAttr,' Qstores and placed on a new page. ');
  525.       Delay (wait*14);
  526.       QwritePage (0);
  527.       QviewPage  (0);
  528.     end;
  529. end;
  530.  
  531. procedure EosMarker;
  532. var Row: byte;
  533. begin
  534.   { -- EOS marker -- }
  535.   ClearScreen (LightGreen+BlackBG);
  536.   QwriteC ( 3, 1,CRTcols,White,'EOS Marker:');
  537.   Col := EosC;
  538.   QwriteEos (Blink+Yellow,#07);
  539.   Qwrite  ( 4,Col,Yellow,#24' right here');
  540.   QwriteC ( 7, 1,CRTcols,SameAttr,'The TP Write procedure locates your next');
  541.   QwriteC ( 8, 1,CRTcols,SameAttr,'string by placing the cursor at the EOS ');
  542.   QwriteC ( 9, 1,CRTcols,SameAttr,'(End-Of-String).  Qwik procedures can do');
  543.   QwriteC (10, 1,CRTcols,SameAttr,'the same thing, but without moving the  ');
  544.   QwriteC (11, 1,CRTcols,SameAttr,'cursor!  It''s done with an offset called');
  545.   QwriteC (12, 1,CRTcols,SameAttr,'QEosOfs.  It''s updated after every Qwik ');
  546.   QwriteC (13, 1,CRTcols,SameAttr,'procedure.                              ');
  547.   QwriteC (16, 1,CRTcols,SameAttr,'Now you can have the convenience of a TP');
  548.   QwriteC (17, 1,CRTcols,SameAttr,'write but the speed of Qwik!  Check out ');
  549.   QwriteC (18, 1,CRTcols,SameAttr,'the following Q*Eos procedures.         ');
  550.   PromptKey;
  551. end;
  552.  
  553. procedure QEosDemo;
  554. begin
  555.   { --- Q*Eos Utilities Demo --- }
  556.   ClearScreen (Black+LightGrayBG);
  557.   QwriteC ( 3, 1,CRTcols,SameAttr,'The Q*Eos procedures:');
  558.   for Row:=5 to 8 do
  559.     QwriteC (Row, 1,CRTcols,Yellow+BlackBG,Eoss[Row-4]);
  560.   QwriteC (10, 1,CRTcols,SameAttr,'Take advantage of the EOS marker to');
  561.   QwriteC (11, 1,CRTcols,SameAttr,'chain the next string - with an    ');
  562.   QwriteC (12, 1,CRTcols,SameAttr,'optional change of attribute!      ');
  563.   delay   (wait*5);
  564.   Col := (CRTcols-38) shr 1;
  565.   Qwrite (14,Col,Black+BrownBG,' Yellow ');
  566.     for Count:=1 to 2 do
  567.       begin
  568.         delay      (wait);
  569.         QwriteEos (White+BlueBG ,'  Blue  ');
  570.         delay      (wait);
  571.         QwriteEos (Black+BrownBG,' Yellow ');
  572.       end;
  573.   delay   (wait);
  574.   QwriteC (16, 1,CRTcols,SameAttr,'Starts where the last Qwik');
  575.   QwriteC (17, 1,CRTcols,SameAttr,'procedure left off!');
  576.   QwriteC (18, 1,CRTcols,SameAttr,'Like TP Write ... but at Qwik speeds!');
  577.   delay   (wait*2);
  578.   Qwrite (21,Col,Black+BrownBG,' Yellow ');
  579.     for Count:=1 to 2 do
  580.       begin
  581.         QwriteEos (White+BlueBG ,'  Blue  ');
  582.         QwriteEos (Black+BrownBG,' Yellow ');
  583.       end;
  584.   PromptKey;
  585. end;
  586.  
  587. procedure UsingEos;
  588. begin
  589.   { -- Using Eos marker -- }
  590.   ClearScreen (Black+LightGrayBG);
  591.   Col:=succ((CRTcols-40) shr 1);
  592.   QwriteC ( 2, 1,CRTcols,White,' Using the EOS marker: ');
  593.   Qwrite ( 4,Col,SameAttr,'Now you have two marker utilities -');
  594.   Qwrite ( 5,Col,SameAttr,'(1) EOS, and (2) the cursor.  Both can');
  595.   Qwrite ( 6,Col,SameAttr,'be used interchangeably:');
  596.   Qwrite ( 8,Col,SameAttr,'GotoEos   - cursor to End-Of-String');
  597.   Qwrite ( 9,Col,SameAttr,'EosR      - End-Of-String row');
  598.   Qwrite (10,Col,SameAttr,'EosC      - End-Of-String column');
  599.   Qwrite (12,Col,SameAttr,'You can also manually alter EOS with the');
  600.   Qwrite (13,Col,SameAttr,'following procedures:');
  601.   Qwrite (15,Col,SameAttr,'EosToRC     - Sets EOS to a given row');
  602.   Qwrite (16,Col,SameAttr,'              and column.');
  603.   Qwrite (17,Col,SameAttr,'EosToRCrel  - Relatively shifts EOS by');
  604.   Qwrite (18,Col,SameAttr,'              row and column.');
  605.   Qwrite (19,Col,SameAttr,'EosToCursor - Matches Eos to the cursor');
  606.   Qwrite (20,Col,SameAttr,'              position.');
  607.   Qwrite (21,Col,SameAttr,'EosLn       - Sets EOS to next row');
  608.   Qwrite (22,Col,SameAttr,'QEosLn      - Like EosLn, but scrolls up');
  609.   Qwrite (23,Col,SameAttr,'              if on last row.');
  610.   PromptKey;
  611. end;
  612.  
  613. procedure MoreUtilities;
  614. begin
  615.   { --- Other Screen Utilities Demo --- }
  616.   ClearScreen (Black+LightGrayBG);
  617.   QwriteC ( 3, 1,CRTcols,SameAttr,'Here are more powerful');
  618.   QwriteC ( 4, 1,CRTcols,SameAttr,'QWIK Screen Utilities');
  619.   QwriteC ( 5, 1,CRTcols,SameAttr,'(for standard and virtual):');
  620.   delay   (wait*5);
  621.   Col:=(CRTcols-38) shr 1;
  622.   for Row:=8 to 19 do
  623.     Qwrite (Row,Col,SameAttr,Other[Row-7]);
  624.   PromptKey;
  625. end;
  626.  
  627. procedure CursorUtilities;
  628. begin
  629.   { --- Cursor Utilities Demo --- }
  630.   ClearScreen (Black+BrownBG);
  631.   QwriteC ( 1, 1,CRTcols,SameAttr,'And of course there are complete');
  632.   QwriteC ( 2, 1,CRTcols,SameAttr,'set of CURSOR location and mode ');
  633.   QwriteC ( 3, 1,CRTcols,SameAttr,'routines for all video pages and');
  634.   QwriteC ( 4, 1,CRTcols,SameAttr,'video cards:                    ');
  635.   delay   (wait*5);
  636.   Col:=(CRTcols-38) shr 1;
  637.   for Row:= 6 to 11 do
  638.     Qwrite (Row,Col,SameAttr,Crsr[Row-5]);
  639.   QwriteC (13, 1,CRTcols,SameAttr,'For universal cursor sizes, four');
  640.   QwriteC (14, 1,CRTcols,SameAttr,'standard shapes are initialized ');
  641.   QwriteC (15, 1,CRTcols,SameAttr,'by detecting each video card:   ');
  642.   for Row:=17 to 20 do
  643.     Qwrite (Row,Col,SameAttr,Crsr[Row-10]);
  644.   for Row:=22 to 23 do
  645.     QwriteC (Row,1,CRTcols,SameAttr,Crsr[Row-11]);
  646.   PromptKey;
  647. end;
  648.  
  649. procedure AttrDemo;
  650. begin
  651.   { --- Attribute Demo --- }
  652.   ClearScreen (Green+GreenBG);
  653.   TextAttr:= White+GreenBG;
  654.   QwriteC ( 2, 1,CRTcols,TextAttr,'QWIK Screen Utilities are hiding data');
  655.   QwriteC ( 3, 1,CRTcols,TextAttr,'on your screen ...');
  656.   Cols:=CRTcols div 20;
  657.   if QVideoMode=Mono then
  658.        TextAttr:=Black+BlackBG
  659.   else TextAttr:=Green+GreenBG;
  660.   for col:=0 to Cols-1 do
  661.     for row:=5 to 20 do
  662.       Qwrite (row,20*col+1,TextAttr,Strng);
  663.   Delay (wait*8);
  664.  
  665.   Qfill   ( 2, 1, 2,CRTcols,SameAttr,' ');        {  Clear Lines }
  666.   TextAttr:= White+GreenBG;
  667.   QwriteC ( 2, 1,CRTcols,TextAttr,'Qattr can show them -');
  668.   QwriteC ( 3, 1,CRTcols,TextAttr,'by merely changing the attribute!');
  669.   Delay   (wait*6);
  670.  
  671.   { --- Try using Turbo's color procedures this time --- }
  672.   TextColor (Black); TextBackground (Green);
  673.   Qattr   ( 5, 1,16,CRTcols,TextAttr);         {  Reveal Data }
  674.   Delay   (wait*5);
  675.  
  676.   Qfill   ( 2, 1, 2,CRTcols,SameAttr,' ');        {  Clear Lines }
  677.   TextColor (yellow); TextBackground (Green);
  678.   QwriteC ( 2, 1,CRTcols,TextAttr,'Or even just emphasize what''s seen ...');
  679.   for i:=1 to 500 do
  680.     begin
  681.       Row:= random(16) + 5;
  682.       Col:= random(Cols)*20+1;
  683.       Qattr (Row,Col, 1,20,46);
  684.       Delay (3);
  685.       Qattr (Row,Col, 1,20,32);
  686.     end;
  687.   for i:=1 to Cols do     {  Emphasize Data }
  688.     Qattr ( 5*i,(i-1)*20+1, 1,20,Yellow+GreenBG+Blink);
  689.   Qattr   (21, 1, 5,CRTcols,TextAttr);
  690.   QwriteC (22, 1,CRTcols,TextAttr,'Copyright (c) 1986-1989 James H. LeMay');
  691. end;
  692.  
  693. begin
  694.   InitDemo;
  695.   ExplodeScreen;
  696.   SaveScreen;
  697.   ListCompatibles;
  698.   ListDetection;
  699.   UsingStr;
  700.   Centering;
  701.   QwikFilling;
  702.   QboxDemo;
  703.   PopUpDemo;
  704.   PageDemo;
  705.   EosMarker;
  706.   QEosDemo;
  707.   UsingEos;
  708.   MoreUtilities;
  709.   CursorUtilities;
  710.   AttrDemo;
  711.   CloseDemo;
  712. end.
  713.