home *** CD-ROM | disk | FTP | other *** search
/ Power Programming / powerprogramming1994.iso / progtool / turbopas / qwik42.arc / QWIKDEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1988-10-01  |  24KB  |  712 lines
  1. { =========================================================================== }
  2. { QwikDemo.pas - Demo program for QWIK screen utilities.    ver 4.2, 10-01-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;
  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,NumStr:   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.2      ');
  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.     Str(Rnum:12,NumStr);
  359.     Qwrite (row,col*20+4,SameAttr,NumStr);
  360.   end;
  361.   PromptKey;
  362. end;
  363.  
  364. procedure Centering;
  365. begin
  366.   { --- Centering Demo --- }
  367.   ClearScreen (LightGrayBG);
  368.   QwriteC ( 2, 1,CRTcols,SameAttr,'QwriteC will automatically');
  369.   QwriteC ( 3, 1,CRTcols,SameAttr,'center your data ...');
  370.   QwriteC ( 4, 1,CRTcols,SameAttr,'(Odd breaks are shifted to the left.)');
  371.   Delay   (wait*6);
  372.  
  373.   { - Set up columns for varying column modes - }
  374.   ColL[2]:=1; ColR[2]:=CRTcols;
  375.   if CRTcols<80 then
  376.   begin
  377.     ColL[1]:=ColL[2]; ColL[3]:=CRTcols div 2;
  378.     ColR[1]:=ColR[2]; ColR[3]:=CRTcols div 2;
  379.   end
  380.   else
  381.   begin
  382.     ColL[1]:=3; ColR[1]:=26; ColL[3]:=CRTcols-14; ColR[3]:=CRTcols-14;
  383.   end;
  384.  
  385.   QwriteC ( 7,ColL[1],ColR[1],SameAttr,'between margins ...');
  386.   Qbox    ( 8,(ColL[1]+ColR[1]) shr 1 -12,15,26,white,LightGray,Border);
  387.   Delay   (wait*3);
  388.   for row:=11 to 19 do
  389.     QwriteC (row,ColL[1],ColR[1],SameAttr, Data[row-10]);
  390.   Delay   (wait*5);
  391.  
  392.   QwriteC ( 7,ColL[2],ColR[2],SameAttr,'between two columns ...');
  393.   QfillC  ( 9,ColL[2],ColR[2],13,24,Yellow,' ');     {  Clear window }
  394.   for row:= 9 to 21 do
  395.     QwriteC  (row,ColL[2],ColR[2],SameAttr,'><');     {  Show two columns  }
  396.   Delay   (wait*3);
  397.   for row:=11 to 19 do
  398.     QwriteC (row,ColL[2],ColR[2],LightRed, Data[row-10]);
  399.   Delay   (wait*5);
  400.  
  401.   QwriteC ( 7,ColL[3],ColR[3],SameAttr,'or on a center line ...');
  402.   QfillC  ( 8,ColL[3],ColR[3],15,27,Black+LightGrayBG,' ');  {Clear window}
  403.   for row:=09 to 21 do                 {  Show center line  }
  404.     QwriteC  (row,ColL[3],ColR[3],Black+LightGrayBG,'|');
  405.   Delay   (wait*3);
  406.   for row:=11 to 19 do
  407.     QwriteC (row,ColL[3],ColR[3],SameAttr, Data[row-10]);
  408.   PromptKey;
  409. end;
  410.  
  411. procedure QwikFilling;
  412. begin
  413.   { --- Qfill Demo --- }
  414.   ClearScreen (White+BlackBG);
  415.   QwriteC ( 2, 1,CRTcols,SameAttr,'Qfill as well as Qattr can fill');
  416.   QwriteC ( 3, 1,CRTcols,SameAttr,'your screen in several ways.');
  417.   Delay   (wait*7);
  418.  
  419.   QwriteC ( 7, 1,CRTcols,SameAttr,'by rows ...');
  420.   Delay   (wait*3);
  421.   for row:= 9 to 24 do
  422.     Qfill (row, 2, 1,CRTcols-2,9+row,Chr(row+56));
  423.   Delay   (wait*5);
  424.  
  425.   Qfill   ( 7, 1,19,CRTcols,white,' ');       {  Clear Lines }
  426.   QwriteC ( 7, 1,CRTcols,SameAttr,'by columns ...');
  427.   Delay   (wait*3);
  428.   for col:=2 to CRTcols-2 do
  429.     Qfill ( 9,col,16,1,16+col,chr(col+63));
  430.   Delay   (wait*5);
  431.  
  432.   Qfill   ( 7, 1,19,CRTcols,white,' ');       {  Clear Lines }
  433.   QwriteC ( 7, 1,CRTcols,SameAttr,'or by row-by-column blocks ...');
  434.   Delay   (wait*3);
  435.     Qfill ( 9,2,16,CRTcols-2,Yellow+BlueBG,'!');
  436.   Delay   (wait*5);
  437. end;
  438.  
  439. procedure QboxDemo;
  440. begin
  441.   { --- Qbox demo --- }
  442.   ClearScreen (LightGrayBG);
  443.   QwriteC ( 2, 1,CRTcols,SameAttr,'Qbox is an application procedure made');
  444.   QwriteC ( 3, 1,CRTcols,SameAttr,'from Qwrite and Qfill.  Together they');
  445.   QwriteC ( 4, 1,CRTcols,SameAttr,'can make windows with borders easy.');
  446.   Delay   (wait*9);
  447.   QwriteC (14, 1,CRTcols,SameAttr,'How about 100 of them? ... ');
  448.   Delay   (wait*4);
  449.   ColMax:=CRTcols-21;
  450.   for i:=1 to 100 do
  451.   begin
  452.     row:=random (10)+6;
  453.     col:=random (ColMax)+2;
  454.     if QVideoMode=Mono then
  455.       begin
  456.         BrdrAttr:=BWcolors[random(4)];
  457.         WndwAttr:=BWcolors[random(4)];
  458.       end
  459.     else
  460.       begin
  461.         BrdrAttr:=random (128);
  462.         WndwAttr:=random (128);
  463.       end;
  464.     Qbox (row,col,10,20,BrdrAttr,WndwAttr,Border);
  465.   end;
  466.   Delay   (wait*10);
  467. end;
  468.  
  469. procedure PopUpDemo;
  470. begin
  471.   { --- Block Transfer and PopUp Demo --- }
  472.   Qfill   ( 1, 1,25,CRTcols,yellow,'?');       {  Clear Screen }
  473.   QfillC  (10, 1,CRTcols, 6,40,BrownBG,' ');   {  Clear Block }
  474.   QwriteC (11, 1,CRTcols,SameAttr,'Qstore will save and restore');
  475.   QwriteC (12, 1,CRTcols,SameAttr,'Row-by-Column blocks on your display.');
  476.   QwriteC (13, 1,CRTcols,SameAttr,'It is so fast, I have to slow it down');
  477.   QwriteC (14, 1,CRTcols,SameAttr,'so you can see it.');
  478.     Delay (wait*11);
  479.     BlkRow:=8;
  480.     BlkCol:=CRTcols div 2 - 9;
  481.   QstoreToMem(BlkRow,BlkCol,10,20,SavedBlock);
  482.   { --- Make a Pop Up Menu --- }
  483.   Qbox (BlkRow,BlkCol,10,20,Yellow+BlueBG,Brown+BlueBG,Border);
  484.   QwriteC (BlkRow+4,BlkCol,BlkCol+20,SameAttr,'Pop Up');
  485.   QwriteC (BlkRow+5,BlkCol,BlkCol+20,SameAttr,'Menu');
  486.   { --- End of Pop Up Menu --- }
  487.   QstoreToMem (BlkRow,BlkCol,10,20,PopUpBlock);
  488.     Delay (wait*4);
  489.   ColMax:=CRTcols-20;
  490.   for i:=1 to 30 do
  491.   begin
  492.     Delay (Wait div 2);
  493.     QstoreToScr (BlkRow,BlkCol,10,20,SavedBlock);
  494.     BlkRow:=random(15)+1;
  495.     BlkCol:=random(ColMax)+1;
  496.     QstoreToMem (BlkRow,BlkCol,10,20,SavedBlock);
  497.     QstoreToScr (BlkRow,BlkCol,10,20,PopUpBlock);
  498.   end;
  499. end;
  500.  
  501. procedure PageDemo;
  502. begin
  503.   { --- Page Demo --- }
  504.   if MaxPage>0 then
  505.   begin
  506.     QviewPage  (1);
  507.     QwritePage (1);
  508.     TextAttr:= Yellow+BlueBG;
  509.     QfillC  (20, 1,CRTcols, 3,40,TextAttr,' ');
  510.     QwriteC (20, 1,CRTcols,SameAttr,' Remember this page?  ');
  511.     QwriteC (21, 1,CRTcols,SameAttr,' It wasn''t destroyed, but saved using ');
  512.     QwriteC (22, 1,CRTcols,SameAttr,' Qstores and placed on a new page. ');
  513.     Delay (wait*14);
  514.     QwritePage (0);
  515.     QviewPage  (0);
  516.   end;
  517. end;
  518.  
  519. procedure EosMarker;
  520. var Row: byte;
  521. begin
  522.   { -- EOS marker -- }
  523.   ClearScreen (LightGreen+BlackBG);
  524.   QwriteC ( 3, 1,CRTcols,White,'EOS Marker:');
  525.   Col := EosC;
  526.   QwriteEos (Blink+Yellow,#07);
  527.   Qwrite  ( 4,Col,Yellow,#24' right here');
  528.   QwriteC ( 7, 1,CRTcols,SameAttr,'The TP Write procedure locates your next');
  529.   QwriteC ( 8, 1,CRTcols,SameAttr,'string by placing the cursor at the EOS ');
  530.   QwriteC ( 9, 1,CRTcols,SameAttr,'(End-Of-String).  Qwik procedures can do');
  531.   QwriteC (10, 1,CRTcols,SameAttr,'the same thing, but without moving the  ');
  532.   QwriteC (11, 1,CRTcols,SameAttr,'cursor!  It''s done with an offset called');
  533.   QwriteC (12, 1,CRTcols,SameAttr,'QEosOfs.  It''s updated after every Qwik ');
  534.   QwriteC (13, 1,CRTcols,SameAttr,'procedure.                              ');
  535.   QwriteC (16, 1,CRTcols,SameAttr,'Now you can have the convenience of a TP');
  536.   QwriteC (17, 1,CRTcols,SameAttr,'write but the speed of Qwik!  Check out ');
  537.   QwriteC (18, 1,CRTcols,SameAttr,'the following Q*Eos procedures.         ');
  538.   PromptKey;
  539. end;
  540.  
  541. procedure QEosDemo;
  542. begin
  543.   { --- Q*Eos Utilities Demo --- }
  544.   ClearScreen (Black+LightGrayBG);
  545.   QwriteC ( 3, 1,CRTcols,SameAttr,'The Q*Eos procedures:');
  546.   for Row:=5 to 8 do
  547.     QwriteC (Row, 1,CRTcols,Yellow+BlackBG,Eoss[Row-4]);
  548.   QwriteC (10, 1,CRTcols,SameAttr,'Take advantage of the EOS marker to');
  549.   QwriteC (11, 1,CRTcols,SameAttr,'chain the next string - with an    ');
  550.   QwriteC (12, 1,CRTcols,SameAttr,'optional change of attribute!      ');
  551.   delay   (wait*5);
  552.   Col := (CRTcols-38) shr 1;
  553.     Qwrite (14,Col,Black+BrownBG,' Yellow ');
  554.     for Count:=1 to 2 do
  555.       begin
  556.         delay      (wait);
  557.         QwriteEos (White+BlueBG ,'  Blue  ');
  558.         delay      (wait);
  559.         QwriteEos (Black+BrownBG,' Yellow ');
  560.       end;
  561.   delay   (wait);
  562.   QwriteC (16, 1,CRTcols,SameAttr,'Starts where the last Qwik');
  563.   QwriteC (17, 1,CRTcols,SameAttr,'procedure left off!');
  564.   QwriteC (18, 1,CRTcols,SameAttr,'Like TP Write ... but at Qwik speeds!');
  565.   delay   (wait*2);
  566.     Qwrite (21,Col,Black+BrownBG,' Yellow ');
  567.     for Count:=1 to 2 do
  568.       begin
  569.         QwriteEos (White+BlueBG ,'  Blue  ');
  570.         QwriteEos (Black+BrownBG,' Yellow ');
  571.       end;
  572.   PromptKey;
  573. end;
  574.  
  575. procedure UsingEos;
  576. begin
  577.   { -- Using Eos marker -- }
  578.   ClearScreen (Black+LightGrayBG);
  579.   Col:=succ((CRTcols-40) shr 1);
  580.   QwriteC ( 2, 1,CRTcols,White,' Using the EOS marker: ');
  581.   Qwrite ( 4,Col,SameAttr,'Now you have two marker utilities -');
  582.   Qwrite ( 5,Col,SameAttr,'(1) EOS, and (2) the cursor.  Both can');
  583.   Qwrite ( 6,Col,SameAttr,'be used interchangeably:');
  584.   Qwrite ( 8,Col,SameAttr,'GotoEos   - cursor to End-Of-String');
  585.   Qwrite ( 9,Col,SameAttr,'EosR      - End-Of-String row');
  586.   Qwrite (10,Col,SameAttr,'EosC      - End-Of-String column');
  587.   Qwrite (12,Col,SameAttr,'You can also manually alter EOS with the');
  588.   Qwrite (13,Col,SameAttr,'following procedures:');
  589.   Qwrite (15,Col,SameAttr,'EosToRC     - Sets EOS to a given row');
  590.   Qwrite (16,Col,SameAttr,'              and column.');
  591.   Qwrite (17,Col,SameAttr,'EosToRCrel  - Relatively shifts EOS by');
  592.   Qwrite (18,Col,SameAttr,'              row and column.');
  593.   Qwrite (19,Col,SameAttr,'EosToCursor - Matches Eos to the cursor');
  594.   Qwrite (20,Col,SameAttr,'              position.');
  595.   Qwrite (21,Col,SameAttr,'EosLn       - Sets EOS to next row');
  596.   Qwrite (22,Col,SameAttr,'QEosLn      - Like EosLn, but scrolls up');
  597.   Qwrite (23,Col,SameAttr,'              if on last row.');
  598.   PromptKey;
  599. end;
  600.  
  601. procedure MoreUtilities;
  602. begin
  603.   { --- Other Screen Utilities Demo --- }
  604.   ClearScreen (Black+LightGrayBG);
  605.   QwriteC ( 3, 1,CRTcols,SameAttr,'Here are more powerful');
  606.   QwriteC ( 4, 1,CRTcols,SameAttr,'QWIK Screen Utilities');
  607.   QwriteC ( 5, 1,CRTcols,SameAttr,'(for standard and virtual):');
  608.   delay   (wait*5);
  609.   Col:=(CRTcols-38) shr 1;
  610.   for Row:=8 to 19 do
  611.     Qwrite (Row,Col,SameAttr,Other[Row-7]);
  612.   PromptKey;
  613. end;
  614.  
  615. procedure CursorUtilities;
  616. begin
  617.   { --- Cursor Utilities Demo --- }
  618.   ClearScreen (Black+BrownBG);
  619.   QwriteC ( 1, 1,CRTcols,SameAttr,'And of course there are complete');
  620.   QwriteC ( 2, 1,CRTcols,SameAttr,'set of CURSOR location and mode ');
  621.   QwriteC ( 3, 1,CRTcols,SameAttr,'routines for all video pages and');
  622.   QwriteC ( 4, 1,CRTcols,SameAttr,'video cards:                    ');
  623.   delay   (wait*5);
  624.   Col:=(CRTcols-38) shr 1;
  625.   for Row:= 6 to 11 do
  626.     Qwrite (Row,Col,SameAttr,Crsr[Row-5]);
  627.   QwriteC (13, 1,CRTcols,SameAttr,'For universal cursor sizes, four');
  628.   QwriteC (14, 1,CRTcols,SameAttr,'standard shapes are initialized ');
  629.   QwriteC (15, 1,CRTcols,SameAttr,'by detecting each video card:   ');
  630.   for Row:=17 to 20 do
  631.     Qwrite (Row,Col,SameAttr,Crsr[Row-10]);
  632.   for Row:=22 to 23 do
  633.     QwriteC (Row,1,CRTcols,SameAttr,Crsr[Row-11]);
  634.   PromptKey;
  635. end;
  636.  
  637. procedure AttrDemo;
  638. begin
  639.   { --- Attribute Demo --- }
  640.   ClearScreen (Green+GreenBG);
  641.   TextAttr:= White+GreenBG;
  642.   QwriteC ( 2, 1,CRTcols,TextAttr,'QWIK Screen Utilities are hiding data');
  643.   QwriteC ( 3, 1,CRTcols,TextAttr,'on your screen ...');
  644.   Cols:=CRTcols div 20;
  645.   if QVideoMode=Mono then
  646.        TextAttr:=Black+BlackBG
  647.   else TextAttr:=Green+GreenBG;
  648.   for col:=0 to Cols-1 do
  649.     for row:=5 to 20 do
  650.       Qwrite (row,20*col+1,TextAttr,Strng);
  651.   Delay (wait*8);
  652.  
  653.   Qfill   ( 2, 1, 2,CRTcols,SameAttr,' ');        {  Clear Lines }
  654.   TextAttr:= White+GreenBG;
  655.   QwriteC ( 2, 1,CRTcols,TextAttr,'Qattr can show them -');
  656.   QwriteC ( 3, 1,CRTcols,TextAttr,'by merely changing the attribute!');
  657.   Delay   (wait*6);
  658.  
  659.   { --- Try using Turbo's color procedures this time --- }
  660.   TextColor (Black); TextBackground (Green);
  661.   Qattr   ( 5, 1,16,CRTcols,TextAttr);         {  Reveal Data }
  662.   Delay   (wait*5);
  663.  
  664.   Qfill   ( 2, 1, 2,CRTcols,SameAttr,' ');        {  Clear Lines }
  665.   TextColor (yellow); TextBackground (Green);
  666.   QwriteC ( 2, 1,CRTcols,TextAttr,'Or even just emphasize what''s seen ...');
  667.   for i:=1 to 500 do
  668.   begin
  669.     Row:= random(16) + 5;
  670.     Col:= random(Cols)*20+1;
  671.     Qattr (Row,Col, 1,20,46);
  672.     Delay (3);
  673.     Qattr (Row,Col, 1,20,32);
  674.   end;
  675.   for i:=1 to Cols do     {  Emphasize Data }
  676.     Qattr ( 5*i,(i-1)*20+1, 1,20,Yellow+GreenBG+Blink);
  677.   Qattr   (21, 1, 5,CRTcols,TextAttr);
  678.   QwriteC (22, 1,CRTcols,TextAttr,' (c) 1986-1988 James H. LeMay ');
  679. end;
  680.  
  681. procedure CloseDemo;
  682. begin
  683.   if QVideoMode<=CO40 then
  684.     begin
  685.       delay (Wait*4);
  686.       TextMode (LastVideoMode+hi(LastMode));
  687.     end;
  688.   GotoRC (23, 1);
  689.   SetCursor (CursorInitial);
  690. end;
  691.  
  692. begin
  693.   InitDemo;
  694.   ExplodeScreen;
  695.   SaveScreen;
  696.   ListCompatibles;
  697.   ListDetection;
  698.   UsingStr;
  699.   Centering;
  700.   QwikFilling;
  701.   QboxDemo;
  702.   PopUpDemo;
  703.   PageDemo;
  704.   EosMarker;
  705.   QEosDemo;
  706.   UsingEos;
  707.   MoreUtilities;
  708.   CursorUtilities;
  709.   AttrDemo;
  710.   CloseDemo;
  711. end.
  712.