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