home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / WINDOW.ZIP / WTUTOR32.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1987-02-20  |  12.1 KB  |  329 lines
  1. { WTUTOR32.PAS - demonstration program for WINDOW32.INC     ver 3.2, 02-20-87 }
  2.  
  3. program WindowTutor;
  4.  
  5. {$i Qwik21.inc}
  6.  
  7. Const MaxWndw = 30;      { Define storage area for Max number of window stats }
  8. {$I Window32.inc}
  9.  
  10. var i,j,k,m: integer;
  11.     OldCursor,Battr: integer;
  12.  
  13. const
  14.     stra : array [1..16] of str80 = (
  15.       '',
  16.       'The windowing procedures in the file  WINDOW32.INC',
  17.       'are  a  set of public domain routines  that  allow',
  18.       'Turbo PASCAL to create incredibly fast multi-level',
  19.       'windows.   Created  under  the  Teamware  concept,',
  20.       'WINDOW32.INC makes use of the quick screen writing',
  21.       'utilities  of QWIK21.INC.   The windows may be  of',
  22.       'any  size (from 2x2 to screen limits)  and  color,',
  23.       'and  may  have  one of several  different   border',
  24.       'styles and colors including no border.   They also',
  25.       'work in any column mode 40/80/etc.   Once inside a',
  26.       'window,   the   normal  Turbo  PASCAL   procedures',
  27.       '"TextColor"  and "TextBackground" may be  used  to',
  28.       'change   character  attributes.    These  routines',
  29.       'automatically  configure  to your video  card  and',
  30.       'mode.');
  31.  
  32.     strb : array [1..13] of str80 = (
  33.       '',
  34.       'The window procedures package consists of four  procedures;',
  35.       '  InitWindow, MakeWindow, RemoveWindow and TitleWindow.',
  36.       'The procedures are described in the following windows:',
  37.       '',
  38.       'InitWindow',
  39.       '',
  40.       'FORMAT:   InitWindow (WindowAttribute: byte);',
  41.       '',
  42.       'InitWindow initializes  several variables required  by  the',
  43.       'windowing package,  as well as selecting the foreground and',
  44.       'background colors of the initial screen display. InitWindow',
  45.       'must be called before using any of the other procedures.');
  46.  
  47.     strc : array [1..17] of str80 = (
  48.       'MakeWindow',
  49.       '',
  50.       'FORMAT:  MakeWindow (Row,Col,Rows,Cols,Wattr,Battr: byte;',
  51.       '                                           BrdrSel: borders);',
  52.       '',
  53.       'MakeWindow puts a new blank window on the display.  The window starts',
  54.       'at the upper left corner (row,col)  and extends for a number of  rows',
  55.       'and columns (rows,cols).   If a border exists, the actual  dimensions',
  56.       'of the  Turbo window will be  2 less than indicated in the MakeWindow',
  57.       'statement.  The border can be one of the following:',
  58.       '',
  59.       '   NoBrdr     - just window       EvenSolidBrdr - evenly solid',
  60.       '   BlankBrdr  - blank spaces      ThinSolidBrdr - thin solid line',
  61.       '   SingleBrdr - single line       LhatchBrdr - light hatch',
  62.       '   DoubleBrdr - double line       MhatchBrdr - medium hatch',
  63.       '   MixedBrdr  - single/double     HhatchBrdr - heavy hatch',
  64.       '   SolidBrdr  - solid             UserBrdr   - user defined border');
  65.  
  66.     strk : array [1..19] of str80 = (
  67.       '',
  68.       '',
  69.       '    ScrollWindow',
  70.       '',
  71.       '',
  72.       'FORMAT:  ScrollWindow (RowBegin,RowEnd: byte; Dir: DirType);',
  73.       '',
  74.       'Turbo''s  standard procedures  InsLine  and DelLine work  just fine in',
  75.       'these windows on  video  page 0 and are recommended.  However, if you',
  76.       'are working  on other video  pages or in  special column  modes, then',
  77.       'this procedure wil do the same thing.  In addition, this will also do',
  78.       'partial windows.',
  79.       '',
  80.       'The direction of scroll can be either of the following:',
  81.       '',
  82.       '    ''Up''   - to scroll up',
  83.       '    ''Down'' - to scroll down',
  84.       '',
  85.       '');
  86.  
  87.     strd : array [1..6] of str80 = (
  88.       'RemoveWindow',
  89.       'FORMAT:   RemoveWindow;',
  90.       '',
  91.       'RemoveWindow removes the last window',
  92.       'remaining  on  the screen  from  the',
  93.       'MakeWindow procedure.');
  94.  
  95.     stre : array [1..6] of str80 = (
  96.       'TitleWindow',
  97.       'FORMAT:   TitleWindow (Justify, Title);',
  98.       '',
  99.       'TitleWindow  places a title in the top border',
  100.       'of the current window.  Justify permits Left,',
  101.       'Center or Right justification of the title.');
  102.  
  103.     strj : array [1..17] of str80 = (
  104.       'There are now two special effects that can',
  105.       'enhance the window display:',
  106.       '   ZoomEffect   - emulates the MacIntosh.',
  107.       '   ShadowEffect - places a left or right',
  108.       '              shadow underneath the menu.',
  109.       'These global variables can be placed anywhere',
  110.       'in your program.  ZoomEffect is boolean while',
  111.       'ShadowEffect is of DirType.',
  112.       'CGA:',
  113.       'The CGA is self-regulating and controls the',
  114.       'zoom rate.',
  115.       'MDA and EGA:',
  116.       'These video cards are quite fast and need a',
  117.       'delay for the effect.  A default value of 11',
  118.       'milliseconds is used in a typed constant',
  119.       'named ''ZoomDelay'' and shouldn''t need any',
  120.       'adjustment.');
  121.  
  122.     strf : array [1..6] of str80 = (
  123.       '',
  124.       ' The maximum  number  of windows that',
  125.       ' may be on the screen at any one time',
  126.       ' is   specified   by   the   constant',
  127.       ' "MaxWndw". Assign it in your program',
  128.       ' before including $I WINDOW32.INC.');
  129.  
  130.     stri : array [1..9] of str80 = (
  131.       ' In addition to windows, there are 15 powerful',
  132.       ' Q screen write procedures you can use:',
  133.       '      QwriteLV   QfillC     QstoreToMem',
  134.       '      QwriteV    Qfill      QstoreToScr',
  135.       '      Qwrite     Qattr      QviewPage',
  136.       '      QwriteC    QattrC     QwritePage',
  137.       '      QwriteCV   GotoRC     CursorChange ',
  138.       ' In QWIK21.ARC, compile and run QDEMO.PAS to see',
  139.       ' all of the features.');
  140.  
  141.     strg : array [1..20] of str80 = (
  142.       ' The procedures are used as follows:',
  143.       '',
  144.       '  program YourProgram;',
  145.       '  {$I Qwik21.inc}',
  146.       '  const MaxWndw = ???     { Max # of windows }',
  147.       '  {$I Window32.inc}',
  148.       '  ...Your variables and procedures...',
  149.       '  begin',
  150.       '    .',
  151.       '    InitWindow (WindowAttribute);',
  152.       '    .',
  153.       '    MakeWindow (Row,Col,Rows,Cols,Wattr,Battr,',
  154.       '                                     BrdrSel);',
  155.       '    TitleWindow (Justify,''the window title'');',
  156.       '    .',
  157.       '    RemoveWindow;',
  158.       '    .',
  159.       '  end.',
  160.       '',
  161.       ' { Use one RemoveWindow for each MakeWindow. }');
  162.  
  163.     strh : array [1..7] of str80 = (
  164.       'If you have any questions or comments,',
  165.       'please write to or call:',
  166.       '',
  167.       '   Jim H. LeMay',
  168.       '   6341 Klamath Rd.',
  169.       '   Ft. Worth, TX  76116',
  170.       '   (817)735-4833 (after 1730 CST)');
  171.  
  172.     Title: str160 = ' Turbo PASCAL Windows (Continued) ';
  173.     HideCursor: integer = $2020;      { Value to hide cursor }
  174.  
  175. begin
  176.    InitWindow (Attr(blue,cyan));
  177.    CursorChange (HideCursor,OldCursor);
  178.    GotoRC (1,1);
  179.  
  180.    { -- Throw out 30 windows 4 times -- }
  181.    for m:=1 to 4 do
  182.    begin
  183.      for i:=1 to 30 do
  184.      begin
  185.        j := random (70);
  186.        k := random (21);
  187.        MakeWindow (k+1,j+1,5,11,Attr(yellow,red),Attr(yellow,red),LhatchBrdr);
  188.        Qwrite (k+3,j+3, -1,'WINDOWS');
  189.      end;
  190.      if m=4 then delay (1500) else delay (300);;
  191.      for i:=LI downto 1 do RemoveWindow;
  192.    end;
  193.  
  194.    { -- Create initial screen -- }
  195.    QwriteC ( 1, 1,80, -1,'Turbo PASCAL Windows Tutorial');
  196.    TextColor (black);
  197.    QwriteC ( 3, 1,80,Tattr,'For each of the following displays,');
  198.    QwriteC ( 4, 1,80,Tattr,'press RETURN to continue.');
  199.    QwriteC (12, 1,80,Tattr,'This is the original screen without windows.');
  200.    readln;
  201.  
  202.    { -- General description -- }
  203.    ShadowEffect:=Right;
  204.    MakeWindow (3,15,19,52,Attr(black,green),Attr(black,green),MixedBrdr);
  205.    TitleWindow (Center,' Turbo PASCAL Windows ');
  206.    For j :=1 to 16 do QwriteV (j+3,16,Attr(black,green),stra[j]);
  207.    readln;
  208.    ShadowEffect:=NoDir;
  209.  
  210.    { -- InitWindow description -- }
  211.    MakeWindow (5,2,16,61,Attr(yellow,red),Attr(yellow,red),SingleBrdr);
  212.    TitleWindow (Left,Title);
  213.    For j :=1 to 5 do QwriteV (j+5,3,Attr(yellow,red),strb[j]);
  214.    QwriteV (11,4,Attr(white,blue),strb[6]);
  215.    For j :=7 to 9 do QwriteV (j+5,3,Attr(cyan,red),strb[j]);
  216.    For j :=10 to 13 do QwriteV (j+5,3,Attr(white,red),strb[j]);
  217.    readln;
  218.  
  219.    { -- MakeWindow description -- }
  220.    MakeWindow (4,7,21,71,Attr(lightmagenta,blue),Attr(lightmagenta,blue),
  221.                                                               SolidBrdr);
  222.    TitleWindow (Left,Title);
  223.    QwriteV (6,12,Attr(yellow,red),strc[1]);
  224.    For j :=2 to 4 do QwriteV (j+5,8,Attr(lightred,blue),strc[j]);
  225.    For j :=5 to 17 do QwriteV (j+5,8,Attr(yellow,blue),strc[j]);
  226.    readln;
  227.    for j :=1 to 19 do InsLine;
  228.    for j :=1 to 19 do
  229.      begin
  230.        ScrollWindow (1,19,up);
  231.        QwriteV (23, 8,-1,StrK[j])
  232.      end;
  233.    readln;
  234.  
  235.    { -- Show different borders -- }
  236.    for i:=0 to 5 do
  237.    begin
  238.      if i=1 then Battr:=Attr(yellow,yellow) else Battr := Attr(yellow,green);
  239.      MakeWindow (2+2*i,13+3*i,5,10,Attr(yellow,green),Battr,Borders(i));
  240.    end;
  241.    with Brdr[UserBrdr] do
  242.    begin
  243.      TL := ^O;
  244.      TH := ^O;
  245.      TR := ^O;
  246.      LV := '▐';
  247.      RV := '▌';
  248.      BL := ^O;
  249.      BH := ^O;
  250.      BR := ^O
  251.    end;
  252.    for i:=6 to 11 do
  253.      MakeWindow (24-2*i,24+3*i,5,10,Attr(yellow,green),Battr,Borders(i));
  254.    readln;
  255.  
  256.    { -- RemoveWindow description -- }
  257.    MakeWindow (11,20,11,40,Attr(black,brown),Attr(black,brown),DoubleBrdr);
  258.    TitleWindow (Left,Title);
  259.    QwriteV (13,26,Attr(white,magenta),strd[1]);
  260.    QwriteV (15,22,Attr(yellow,brown),strd[2]);
  261.    For j :=3 to 6 do QwriteV (j+13,22,Attr(white,brown),strd[j]);
  262.    readln;
  263.    for i:=0 to 12 do RemoveWindow;
  264.  
  265.    { -- TitleWindow description -- }
  266.    ZoomEffect:=true;
  267.    MakeWindow (12,16,11,49,Attr(red,lightgray),Attr(red,lightgray),
  268.                                                     EvenSolidBrdr);
  269.    TitleWindow (Left,Title);
  270.    QwriteV (14,22,Attr(lightgreen,blue),stre[1]);
  271.    QwriteV (16,18,Attr(black,lightgray),stre[2]);
  272.    For j :=3 to 6 do QwriteV (j+14,18,Attr(green,lightgray),stre[j]);
  273.    readln;
  274.  
  275.    { -- Special effects description -- }
  276.    ShadowEffect:=Right;
  277.    MakeWindow ( 6,25,14,49,Attr(black,green),Attr(white,green),DoubleBrdr);
  278.    TitleWindow (Center,' Special Effects ');
  279.    For j:=1 to 2 do QwriteV (j+7,27,-1,strj[j]);
  280.    For j:=3 to 5 do QwriteV (j+8,27,Attr(white,green),strj[j]);
  281.    For j:=6 to 8 do QwriteV (j+9,27,-1,strj[j]);
  282.    readln;
  283.    Qfill ( 8,27,10,45,Attr(black,green),' ');
  284.    QwriteV ( 8,27,Attr(white,green),strj[9]);
  285.    For j:=10 to 11 do QwriteV (j-1,27,-1,strj[j]);
  286.    QwriteV (12,27,Attr(white,green),strj[12]);
  287.    For j:=13 to 17 do QwriteV (j,27,-1,strj[j]);
  288.    readln;
  289.    ShadowEffect:=NoDir;
  290.  
  291.    { -- MaxWndw constant -- }
  292.    MakeWindow (17, 9, 7,38,Attr(black,brown),Attr(black,brown),NoBrdr);
  293.    TitleWindow (Center,'- WINDOW LIMITS -');
  294.    For j :=1 to 6 do QwriteV (j+16, 9,Attr(black,brown),strf[j]);
  295.    readln;
  296.  
  297.    { -- QWIK21.INC procedures -- }
  298.    MakeWindow (8,20,15,51,Attr(yellow,red),Attr(yellow,red),EvenSolidBrdr);
  299.    TitleWindow (Center,' Utility Procedures ');
  300.    For j :=1 to 2 do QwriteV (j+ 9,21,Attr(yellow,red),stri[j]);
  301.    For j :=3 to 7 do QwriteV (j+10,21,Attr(white,red),stri[j]);
  302.    For j :=8 to 9 do QwriteV (j+11,21,Attr(yellow,red),stri[j]);
  303.    readln;
  304.  
  305.    { -- Programming for WINDOW32.INC -- }
  306.    MakeWindow (2,25,23,50,Attr(yellow,magenta),Attr(yellow,magenta),
  307.                                                         MhatchBrdr);
  308.    For j :=1 to 20 do QwriteV (j+3,26,Attr(yellow,magenta),strg[j]);
  309.    readln;
  310.  
  311.    { -- Editor for WINDOW32.INC -- }
  312.    ZoomEffect:=false;
  313.    ShadowEffect:=Right;
  314.    MakeWindow (8,20,11,42,Attr(black,brown),Attr(black,brown),HhatchBrdr);
  315.    TitleWindow (Center,' Teamware Editor: ');
  316.    For j :=1 to 7 do QwriteV (j+9,22,Attr(white,brown),strh[j]);
  317.    readln;
  318.  
  319.    { -- Use the following statment to return to the original screen.-- }
  320.      for i:=1 to LI do RemoveWindow;
  321.    Qfill (1,1,25,80,Tattr,' ');
  322.    QwriteC (12,1,80,Tattr,'This concludes the windows tutorial...');
  323.    delay (2000);
  324.    ShadowEffect := NoDir;            { Optional termination }
  325.    CursorChange (OldCursor,OldCursor);
  326.    NormVideo;
  327.    ClrScr
  328. end.
  329.