home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 June / SIMTEL_0692.cdr / msdos / turbopas / window34.arc / WTUTOR34.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1987-08-31  |  17.5 KB  |  535 lines
  1. { WTUTOR34.PAS - demonstration program for WINDOW34.INC     ver 3.4, 08-31-87 }
  2.  
  3. program WindowTutor;
  4.  
  5. {$i Qwik30.inc}
  6.  
  7. Const MaxWndw = 30;      { Define storage area for Max number of window stats }
  8. {$I Window34.inc}
  9.  
  10. var i,j,k,m: integer;
  11.     Battr,Step,OldCursor: integer;
  12.     ExtKey: boolean;
  13.     Key:    char;
  14.  
  15. const
  16.     RetKey = #13;
  17.     EscKey = #27;
  18.     StrA : array [1..16] of str80 = (
  19.       '',
  20.       'The windowing procedures in the file  WINDOW34.INC',
  21.       'are  a set of ShareWare routines that allow  Turbo',
  22.       'PASCAL  to  create  incredibly  fast   multi-level',
  23.       'windows.   WINDOW34.INC  makes use  of  the  quick',
  24.       'screen writing procedures of QWIK30.INC.',
  25.       '',
  26.       'The windows may be of any size (from 2x2 to screen',
  27.       'limits)  and  color, and may have one  of  several',
  28.       'different  border styles and colors  including  no',
  29.       'border.   They  also  work  in  any  column   mode',
  30.       '40/80/etc.  Once inside a window, the normal Turbo',
  31.       'PASCAL procedures "TextColor" and "TextBackground"',
  32.       'may be used to change character attributes.  These',
  33.       'routines  automatically  configure to  your  video',
  34.       'card and mode.');
  35.  
  36.     StrB : array [1..11] of str80 = (
  37.       'The window procedures package',
  38.       'consists of five procedures:',
  39.       '',
  40.       '        InitWindow',
  41.       '        MakeWindow',
  42.       '        ScrollWindow',
  43.       '        RemoveWindow',
  44.       '        TitleWindow',
  45.       '',
  46.       'The procedures are described',
  47.       'in the following windows:');
  48.  
  49.     StrC : array [1..8] of str80 = (
  50.       'InitWindow',
  51.       '',
  52.       'FORMAT:   InitWindow (WindowAttribute: byte);',
  53.       '',
  54.       'InitWindow initializes  several variables required  by  the',
  55.       'windowing package,  as well as selecting the foreground and',
  56.       'background colors of the initial screen display. InitWindow',
  57.       'must be called before using any of the other procedures.');
  58.  
  59.     StrD : array [1..17] of str80 = (
  60.       'MakeWindow',
  61.       '',
  62.       'FORMAT:  MakeWindow (Row,Col,Rows,Cols,Wattr,Battr: byte;',
  63.       '                                           BrdrSel: borders);',
  64.       '',
  65.       'MakeWindow puts a new blank window on the display.  The window starts',
  66.       'at the upper left corner (row,col)  and extends for a number of  rows',
  67.       'and columns (rows,cols).   If a border exists, the actual  dimensions',
  68.       'of the  Turbo window will be  2 less than indicated in the MakeWindow',
  69.       'statement.  The border can be one of the following:',
  70.       '',
  71.       '   NoBrdr     - just window       EvenSolidBrdr - evenly solid',
  72.       '   BlankBrdr  - blank spaces      ThinSolidBrdr - thin solid line',
  73.       '   SingleBrdr - single line       LhatchBrdr - light hatch',
  74.       '   DoubleBrdr - double line       MhatchBrdr - medium hatch',
  75.       '   MixedBrdr  - single/double     HhatchBrdr - heavy hatch',
  76.       '   SolidBrdr  - solid             UserBrdr   - user defined border');
  77.  
  78.     StrE : array [1..6] of str80 = (
  79.       'RemoveWindow',
  80.       'FORMAT:   RemoveWindow;',
  81.       '',
  82.       'RemoveWindow removes the last window',
  83.       'remaining  on  the screen  from  the',
  84.       'MakeWindow procedure.');
  85.  
  86.     StrF : array [1..2] of str80 = (
  87.       'See if your BIOS gives you flicker',
  88.       'when your screen rolls down next ...');
  89.  
  90.     StrG : array [1..19] of str80 = (
  91.       '',
  92.       '    ScrollWindow',
  93.       '',
  94.       '',
  95.       'FORMAT:  ScrollWindow (RowBegin,RowEnd: byte; Dir: DirType);',
  96.       '',
  97.       'Turbo''s standard procedures  InsLine and DelLine may have worked just',
  98.       'fine this window.  However, if  your screen just had some bad flicker',
  99.       'as it was scrolling down, your BIOS is not flicker-free.  To keep the',
  100.       'display flicker-free, to work on other video pages, VGA, or EGA, then',
  101.       'you will need this procedure.   The upward  scroll used ScrollWindow,',
  102.       'so no flicker was seen then.  It also scrolls partial windows.',
  103.       '',
  104.       'The direction of scroll can be either of the following:',
  105.       '',
  106.       '    ''Up''   - to scroll up',
  107.       '    ''Down'' - to scroll down',
  108.       '',
  109.       '');
  110.  
  111.     StrH : array [1..6] of str80 = (
  112.       'TitleWindow',
  113.       'FORMAT:   TitleWindow (Justify, Title);',
  114.       '',
  115.       'TitleWindow  places a title in the top border',
  116.       'of the current window.  Justify permits Left,',
  117.       'Center or Right justification of the title.');
  118.  
  119.     StrI : array [1..18] of str80 = (
  120.       'There are now two special effects that can',
  121.       'enhance the window display:',
  122.       '   ZoomEffect   - emulates the Macintosh.',
  123.       '   ShadowEffect - places a left or right',
  124.       '              shadow underneath the menu.',
  125.       'These global variables can be placed anywhere',
  126.       'in your program.  ZoomEffect is boolean while',
  127.       'ShadowEffect is of DirType.',
  128.       '                             press RETURN ...',
  129.       'CGA:',
  130.       'The CGA is self-regulating and controls the',
  131.       'zoom rate.',
  132.       'MDA, EGA, MCGA, and VGA:',
  133.       'These video cards are quite fast and need a',
  134.       'delay for the effect.  A default value of 11',
  135.       'milliseconds is used in a typed constant',
  136.       'named ''ZoomDelay'' and shouldn''t need any',
  137.       'adjustment.');
  138.  
  139.     StrJ : array [1..5] of str80 = (
  140.       ' The maximum  number  of windows that',
  141.       ' may be on the screen at any one time',
  142.       ' is   specified   by   the   constant',
  143.       ' "MaxWndw". Assign it in your program',
  144.       ' before including $I WINDOW34.INC.');
  145.  
  146.     StrK : array [1..10] of str80 = (
  147.       ' In addition to windows, there are 17 powerful',
  148.       ' QWIK screen write procedures you can use:',
  149.       '      QwriteLV   QfillC     QstoreToMem',
  150.       '      QwriteV    Qfill      QstoreToScr',
  151.       '      Qwrite     Qattr      QviewPage',
  152.       '      QwriteC    QattrC     QwritePage',
  153.       '      QwriteCV   CursorOff  CursorChange',
  154.       '                 CursorOn   GotoRC',
  155.       ' In QWIK30.ARC, compile and run QDEMO.PAS to see',
  156.       ' all of the features.');
  157.  
  158.     StrL : array [1..20] of str80 = (
  159.       ' The procedures are used as follows:',
  160.       '',
  161.       '  program YourProgram;',
  162.       '  {$I Qwik30.inc}',
  163.       '  const MaxWndw = ???     { Max # of windows }',
  164.       '  {$I Window34.inc}',
  165.       '  ...Your variables and procedures...',
  166.       '  begin',
  167.       '    .',
  168.       '    InitWindow (WindowAttribute);',
  169.       '    .',
  170.       '    MakeWindow (Row,Col,Rows,Cols,Wattr,Battr,',
  171.       '                                     BrdrSel);',
  172.       '    TitleWindow (Justify,''the window title'');',
  173.       '    .',
  174.       '    RemoveWindow;',
  175.       '    .',
  176.       '  end.',
  177.       '',
  178.       ' { Use one RemoveWindow for each MakeWindow. }');
  179.  
  180.     StrM : array [1..15] of str80 = (
  181.       'WINDOW34.INC works these ...',
  182.       '',
  183.       'COMPUTERS:           ADAPTERS:',
  184.       '------------------   ---------',
  185.       'IBM PC               MDA',
  186.       'IBM XT               CGA',
  187.       'IBM AT               EGA',
  188.       'IBM PCjr             MCGA',
  189.       'IBM PC Convertible   VGA',
  190.       'IBM PS/2 Model 25    8514/A',
  191.       'IBM PS/2 Model 30',
  192.       'IBM PS/2 Model 50',
  193.       'IBM PS/2 Model 60',
  194.       'IBM PS/2 Model 80',
  195.       'IBM 3270');
  196.  
  197.     StrN : array [1..7] of str80 = (
  198.       'If you have any questions or comments,',
  199.       'please write to or call:',
  200.       '',
  201.       '   Jim H. LeMay  (CIS 76011,217)',
  202.       '   6341 Klamath Rd.',
  203.       '   Ft. Worth, TX  76116',
  204.       '   1-(817)-735-4833 (after 1730 CST)');
  205.  
  206.     Title: str160 = ' Turbo PASCAL Windows (Continued) ';
  207.  
  208. procedure Show30windows;
  209. begin
  210.    { -- Throw out 30 windows 4 times -- }
  211.    for m:=1 to 4 do
  212.    begin
  213.      for i:=1 to 30 do
  214.      begin
  215.        j := random (70);
  216.        k := random (21);
  217.        Tattr:=Attr(yellow,green);
  218.        MakeWindow (k+1,j+1,5,11,Attr(black,green),Tattr,DoubleBrdr);
  219.        Qwrite (k+3,j+3, -1,'WINDOWS');
  220.      end;
  221.      if m=4 then delay (1500) else delay (300);
  222.      for i:=LI downto 1 do RemoveWindow;
  223.    end
  224. end;
  225.  
  226. procedure ShowInitialScreen;
  227. begin
  228.    { -- Create initial screen -- }
  229.    QwriteC ( 1, 1,80, -1,'Turbo PASCAL Windows Tutorial');
  230.    QwriteC ( 2, 1,80, -1,'Version 3.4');
  231.    TextColor (black);
  232.    QwriteC ( 4, 1,80,Tattr,'For each of the following displays:');
  233.    Qwrite  ( 5,26   ,Tattr,'1. Press RETURN to continue.');
  234.    Qwrite  ( 6,26   ,Tattr,'2. Press ESC to back up.');
  235.    QwriteC (12, 1,80,Tattr,'This is the original screen without windows.');
  236.    Step:=0;
  237. end;
  238.  
  239. procedure ShowGeneral;
  240. begin
  241.    { -- General description -- }
  242.    ShadowEffect:=Right;
  243.    MakeWindow (3,15,19,52,Attr(black,green),Attr(black,green),MixedBrdr);
  244.    TitleWindow (Center,' Turbo PASCAL Windows ');
  245.    with WndwStat[LI] do
  246.      for j :=1 to 16 do QwriteV (WSrow+j,WScol+1,-1,StrA[j]);
  247.    ShadowEffect:=NoDir;
  248. end;
  249.  
  250. procedure ShowList;
  251. begin
  252.    { -- List of Procedures -- }
  253.    MakeWindow (5,2,15,33,Attr(black,cyan),Attr(white,blue),MhatchBrdr);
  254.    TitleWindow (Center,' Five Procedures ');
  255.    with WndwStat[LI] do
  256.    begin
  257.      for j:=1  to 2  do QwriteV (WSrow+1+j,WScol+2,              -1,StrB[j]);
  258.      for j:=3  to 9  do QwriteV (WSrow+1+j,WScol+2,Attr(white,cyan),StrB[j]);
  259.      for j:=10 to 11 do QwriteV (WSrow+1+j,WScol+2,              -1,StrB[j])
  260.    end;
  261. end;
  262.  
  263. procedure ShowInitWindow;
  264. begin
  265.    { -- InitWindow description -- }
  266.    MakeWindow (11,17,12,63,Attr(yellow,red),Attr(yellow,red),SingleBrdr);
  267.    TitleWindow (Left,Title);
  268.    with WndwStat[LI] do
  269.    begin
  270.                       QwriteV (WSrow+2  ,WScol+2,Attr(white,blue),StrC[1]);
  271.      for j:=2 to 4 do QwriteV (WSrow+1+j,WScol+2,Attr(cyan,red)  ,StrC[j]);
  272.      for j:=5 to 8 do QwriteV (WSrow+1+j,WScol+2,Attr(white,red) ,StrC[j]);
  273.    end;
  274. end;
  275.  
  276. procedure ShowMakeWindow;
  277. begin
  278.    { -- MakeWindow description -- }
  279.    MakeWindow (4,7,21,71,Attr(lightmagenta,blue),Attr(lightmagenta,blue),
  280.                                                               SolidBrdr);
  281.    TitleWindow (Left,Title);
  282.    with WndwStat[LI] do
  283.    begin
  284.                        QwriteV (WSrow+2  ,WScol+5,Attr(yellow,red)   ,StrD[1]);
  285.      for j:=2 to 4  do QwriteV (WSrow+1+j,WScol+1,Attr(lightred,blue),StrD[j]);
  286.      for j:=5 to 17 do QwriteV (WSrow+1+j,WScol+1,Attr(yellow,blue)  ,StrD[j]);
  287.    end;
  288. end;
  289.  
  290. procedure ShowBorders;
  291. begin
  292.    { -- Show different borders -- }
  293.    for i:=0 to 5 do
  294.    begin
  295.      if i=1 then Battr:=Attr(yellow,yellow) else Battr := Attr(yellow,green);
  296.      MakeWindow (2+2*i,13+3*i,5,10,Attr(yellow,green),Battr,Borders(i));
  297.    end;
  298.    with Brdr[UserBrdr] do
  299.    begin
  300.      TL := ^O;
  301.      TH := ^O;
  302.      TR := ^O;
  303.      LV := '▐';
  304.      RV := '▌';
  305.      BL := ^O;
  306.      BH := ^O;
  307.      BR := ^O
  308.    end;
  309.    for i:=6 to 11 do
  310.      MakeWindow (24-2*i,24+3*i,5,10,Attr(yellow,green),Battr,Borders(i));
  311. end;
  312.  
  313. procedure ShowRemoveWindow;
  314. begin
  315.    { -- RemoveWindow description -- }
  316.    MakeWindow (11,20,11,40,Attr(black,brown),Attr(black,brown),DoubleBrdr);
  317.    TitleWindow (Left,Title);
  318.    with WndwStat[LI] do
  319.    begin
  320.                       QwriteV (WSrow+2  ,WScol+5,Attr(white,magenta),StrE[1]);
  321.                       QwriteV (WSrow+4  ,WScol+2,Attr(yellow,brown) ,StrE[2]);
  322.      for j:=3 to 6 do QwriteV (WSrow+2+j,WScol+2,Attr(white,brown)  ,StrE[j]);
  323.    end;
  324. end;
  325.  
  326. procedure ShowFlicker;
  327. begin
  328.    { -- Flicker Note -- }
  329.    MakeWindow (11,22, 4,40,Attr(black,brown),Attr(black,brown),MixedBrdr);
  330.    with WndwStat[LI] do
  331.    begin
  332.      for j:=1 to 2 do QwriteV (WSrow+j,WScol+2,-1,StrF[j]);
  333.    end;
  334. end;
  335.  
  336. procedure ShowScrollWindow;
  337. begin
  338.    { -- ScrollWindow description -- }
  339.    with WndwStat[LI] do
  340.    begin
  341.      GotoRC (WSrow+1,WSCol+1);
  342.      for j :=1 to 19 do InsLine;
  343.      for j :=1 to 19 do
  344.        begin
  345.          ScrollWindow (1,19,up);
  346.          QwriteV (WSrow+19,WScol+1,-1,StrG[j])
  347.        end
  348.    end;
  349. end;
  350.  
  351. procedure ShowTitleWindow;
  352. begin
  353.    { -- TitleWindow description -- }
  354.    MakeWindow (12,16,11,49,Attr(red,lightgray),Attr(red,lightgray),
  355.                                                     EvenSolidBrdr);
  356.    TitleWindow (Left,Title);
  357.    with WndwStat[LI] do
  358.    begin
  359.                       QwriteV (WSrow+2  ,WScol+5,Attr(lightgreen,blue),StrH[1]);
  360.                       QwriteV (WSrow+4  ,WScol+2,Attr(black,lightgray),StrH[2]);
  361.      for j:=3 to 6 do QwriteV (WSrow+2+j,WScol+2,Attr(green,lightgray),StrH[j]);
  362.    end;
  363. end;
  364.  
  365. procedure ShowSpecialEffects;
  366. begin
  367.    { -- Special effects description -- }
  368.    if Vmode<>7 then ShadowEffect:=Right;
  369.    MakeWindow ( 6,25,14,49,Attr(black,green),Attr(white,green),DoubleBrdr);
  370.    TitleWindow (Center,' Special Effects ');
  371.    with WndwStat[LI] do
  372.    begin
  373.      for j:=1 to 2 do QwriteV (WSrow+1+j,WScol+2,               -1,StrI[j]);
  374.      for j:=3 to 5 do QwriteV (WSrow+2+j,WScol+2,Attr(white,green),StrI[j]);
  375.      for j:=6 to 9 do QwriteV (WSrow+3+j,WScol+2,               -1,StrI[j]);
  376.      readln;
  377.                         Qfill   (WSrow+2  ,WScol+2,11,45,Attr(black,green),' ');
  378.                         QwriteV (WSrow+2  ,WScol+2,Attr(white,green),StrI[10]);
  379.      for j:=11 to 12 do QwriteV (WSrow+j-8,WScol+2,               -1,StrI[j]);
  380.                         QwriteV (WSrow+6  ,WScol+2,Attr(white,green),StrI[13]);
  381.      for j:=14 to 18 do QwriteV (WSrow+j-7,WScol+2,               -1,StrI[j]);
  382.    end;
  383.    ShadowEffect:=NoDir;
  384. end;
  385.  
  386. procedure ShowMaxWndw;
  387. begin
  388.    { -- MaxWndw constant -- }
  389.    MakeWindow (17, 9, 7,38,Attr(black,brown),Attr(black,brown),NoBrdr);
  390.    TitleWindow (Center,'- WINDOW LIMITS -');
  391.    with WndwStat[LI] do
  392.      for j:=1 to 5 do QwriteV (WSrow+j,WScol,-1,StrJ[j]);
  393.  end;
  394.  
  395. procedure ShowQWIK30;
  396. begin
  397.    { -- QWIK30.INC procedures -- }
  398.    MakeWindow (8,20,15,51,Attr(yellow,red),Attr(yellow,red),EvenSolidBrdr);
  399.    TitleWindow (Center,' QWIK Write Procedures ');
  400.    with WndwStat[LI] do
  401.    begin
  402.      for j:=1 to  2 do QwriteV (WSrow+1+j,WScol+1,             -1,StrK[j]);
  403.      for j:=3 to  8 do QwriteV (WSrow+2+j,WScol+1,Attr(white,red),StrK[j]);
  404.      for j:=9 to 10 do QwriteV (WSrow+3+j,WScol+1,             -1,StrK[j])
  405.    end;
  406. end;
  407.  
  408. procedure ShowProgramming;
  409. begin
  410.    { -- Programming for WINDOW34.INC -- }
  411.    MakeWindow (2,25,23,50,Attr(yellow,magenta),Attr(yellow,magenta),
  412.                                                         MhatchBrdr);
  413.    with WndwStat[LI] do
  414.      for j:=1 to 20 do QwriteV (WSrow+1+j,WScol+1,-1,StrL[j]);
  415. end;
  416.  
  417. procedure ShowEquipmentList;
  418. begin
  419.    { -- Compatible computers and adapters for WINDOW34.INC -- }
  420.    MakeWindow (4,35,17,34,Attr(black,brown),Attr(black,brown),MixedBrdr);
  421.    TitleWindow (Center,' Software Compatibility ');
  422.    with WndwStat[LI] do
  423.      for j:=1 to 15 do QwriteV (WSrow+j,WScol+2,Attr(white,brown),StrM[j]);
  424. end;
  425.  
  426. procedure ShowAuthor;
  427. begin
  428.    { -- Author for WINDOW34.INC -- }
  429.    if Vmode<>7 then ShadowEffect:=Right;
  430.    MakeWindow (8,20,11,42,Attr(black,brown),Attr(black,brown),HhatchBrdr);
  431.    with WndwStat[LI] do
  432.      for j:=1 to 7 do QwriteV (WSrow+1+j,WScol+2,Attr(white,brown),StrN[j]);
  433.    ShadowEffect:=NoDir;
  434. end;
  435.  
  436. procedure ReadKB (VAR ExtKey: boolean; VAR Key: char);
  437. begin
  438.   Read (Kbd,Key);                        { Read keyboard input.      }
  439.   if KeyPressed and (Key=EscKey) then    { If first Char was ESC ... }
  440.     begin
  441.       Read (Kbd,Key);                    { ... read second char.     }
  442.       ExtKey := true
  443.     end
  444.   else ExtKey:=false;
  445. end;
  446.  
  447. procedure GetKey;
  448. begin
  449.   repeat
  450.     ReadKB (ExtKey,Key);
  451.   until (Key=RetKey) or (Key=EscKey);
  452. end;
  453.  
  454. procedure FindNextStep;
  455. begin
  456.   case Key of
  457.   EscKey: begin
  458.             if Step>0 then
  459.               begin
  460.                 RemoveWindow;
  461.                 case Step of
  462.                   5: for j:=1 to 11 do RemoveWindow;
  463.                   7: begin
  464.                        ShowBorders;
  465.                        ShowRemoveWindow;
  466.                      end;
  467.                   8: Step:=4;
  468.                 end;  { case }
  469.                 Step:=Step-1
  470.               end
  471.             end;
  472.   RetKey: begin
  473.             Step:=Step+1;
  474.             if Step in [9..14] then ZoomEffect:=true else ZoomEffect:=false;
  475.             case Step of
  476.               7: for i:=0 to 12 do RemoveWindow;
  477.               8: RemoveWindow;
  478.             end
  479.           end;
  480.   end  { case }
  481. end;
  482.  
  483. procedure ShowWindows;
  484. begin
  485.   repeat
  486.     GetKey;
  487.     FindNextStep;
  488.     if Key=RetKey then
  489.       case Step of
  490.         1: ShowGeneral;
  491.         2: ShowList;
  492.         3: ShowInitWindow;
  493.         4: ShowMakeWindow;
  494.         5: ShowBorders;
  495.         6: ShowRemoveWindow;
  496.         7: ShowFlicker;
  497.         8: ShowScrollWindow;
  498.         9: ShowTitleWindow;
  499.        10: ShowSpecialEffects;
  500.        11: ShowMaxWndw;
  501.        12: ShowQWIK30;
  502.        13: ShowProgramming;
  503.        14: ShowEquipmentList;
  504.        15: ShowAuthor;
  505.       end;
  506.    until Step=16;
  507. end;
  508.  
  509. procedure CheckCursor;
  510. var CursorMode: integer absolute $0040:$0060;
  511. begin
  512.   if ActiveDD=MdaMono then
  513.     if CursorMode=$0607 then
  514.       CursorChange($0C0D,OldCursor);
  515. end;
  516.  
  517. begin
  518.    InitWindow (Attr(blue,lightgray));
  519.    CheckCursor;
  520.    CursorOff;
  521.    Show30windows;
  522.    ShowInitialScreen;
  523.    ShowWindows;
  524.    { -- Use the following statment to return to the original screen.-- }
  525.      for i:=1 to LI do RemoveWindow;
  526.    Qfill (1,1,25,80,Tattr,' ');
  527.    QwriteC (12,1,80,Tattr,'(c) 1986,1987  James H. LeMay');
  528.    QwriteC (13,1,80,Tattr,'This concludes the windows tutorial...');
  529.    delay (2000);
  530.    NormVideo;
  531.    GotoRC (1,1);
  532.    ClrScr;
  533.    CursorOn;
  534. end.
  535.