home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / progmisc / tttdem51.zip / DEMOTTT.PAS next >
Pascal/Delphi Source File  |  1992-12-14  |  56KB  |  1,486 lines
  1. Program Illustrating_the_Toolkit;
  2.  
  3.  
  4. {IMPORTANT NOTE: compile with the Options Compiler Conditional defines set with
  5.  
  6.                                 DIRFULL
  7. }
  8.  
  9.  
  10. Uses CRT, FastTTT5, DOS, WinTTT5, KeyTTT5,
  11.      MenuTTT5, IOTTT5, PullTTT5, DirTTT5, NestTTT5,
  12.      ListTTT5,StrnTTT5, MiscTTT5;
  13. var
  14.    Main_Choice,Choice,Error : integer;
  15.    ScanTop, ScanBot : byte;
  16.    M1, MM : Menu_record;
  17.    Ch : char;
  18. Const
  19.    Author = 'Bob Ainsbury, TechnoJock';
  20.  
  21. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  22. {          T H E     M A I N    M E N U    P R O C E D U R E S                }
  23. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  24. Procedure Define_Menu1;
  25. begin
  26.     Menu_Set(M1);
  27.     With M1 do
  28.     begin
  29.         Heading1 := 'TechnoJock''s Turbo Toolkit';
  30.         Heading2 := 'Main Menu';
  31.         Topic[1] := '   The Toolkit explained';
  32.         Topic[2] := '   FastTTT5 Unit';
  33.         Topic[3] := '   WinTTT5  Unit';
  34.         Topic[4] := '   Menus';
  35.         Topic[5] := '   IOTTT5   Unit';
  36.         Topic[6] := '   DirTTT5  Unit';
  37.         Topic[7] := '   Documentation';
  38.         Topic[8] := '   Unit Summary';
  39.         Topic[9] := '   Quit to DOS';
  40.         TotalPicks := 9;
  41.         PicksPerLine := 1;            {one column of choices}
  42.         Addprefix := 1;               {add function key prefixes}
  43.         TopleftXY[1] := 0;            {system will center menu}
  44.         TopleftXY[2] := 3;            {Y coordinate}
  45.         Boxtype := 5;                 {fancy box}
  46.         If ColorScreen then
  47.         begin
  48.             Colors[1] := white;           {hi forground}
  49.             Colors[2] := red;            {hi background}
  50.             Colors[3] := lightgray;             {lo foreground}
  51.             Colors[4] := blue;       {lo background}
  52.             Colors[5] := lightcyan;            {box color}
  53.         end
  54.         else
  55.         begin
  56.             Colors[1] := white;           {hi forground}
  57.             Colors[2] := black;            {hi background}
  58.             Colors[3] := black;             {lo foreground}
  59.             Colors[4] := lightgray;       {lo background}
  60.             Colors[5] := white;            {box color}
  61.         end;
  62.         AllowEsc := false;            {inactivate the escape key}
  63.         Margins := 5;
  64. end;  {with M1 do}
  65. end; {Define_Menu1}
  66.  
  67. Procedure Define_Menu_menu;
  68. begin
  69.     Menu_Set(MM);
  70.     With MM do
  71.     begin
  72.         Heading1 := 'Menu Units';
  73.         Heading2 := '';
  74.         Topic[1] := '   Introduction ';
  75.         Topic[2] := '   MenuTTT5     ';
  76.         Topic[3] := '   PullTTT5     ';
  77.         Topic[4] := '   NestTTT5     ';
  78.         Topic[5] := '   ListTTT5     ';
  79.         Topic[6] := '   Return to main menu ';
  80.         TotalPicks := 6;
  81.         TopleftXY[1] := 40;            {Y coordinate}
  82.         TopleftXY[2] := 9;            {Y coordinate}
  83.         AddPrefix := 4;
  84.         Boxtype := 5;                 {fancy box}
  85.         If ColorScreen  then
  86.         begin
  87.             Colors[1] := white;          {hi forground}
  88.             Colors[2] := red;            {hi background}
  89.             Colors[3] := lightgray;      {lo foreground}
  90.             Colors[4] := blue;           {lo background}
  91.             Colors[5] := lightcyan;      {box color}
  92.         end
  93.         else
  94.         begin
  95.             Colors[1] := white;           {hi forground}
  96.             Colors[2] := black;           {hi background}
  97.             Colors[3] := black;           {lo foreground}
  98.             Colors[4] := lightgray;       {lo background}
  99.             Colors[5] := white;           {box color}
  100.         end;
  101.         AllowEsc := true;            {inactivate the escape key}
  102.         Margins := 5;
  103. end;  {with M1 do}
  104. end; {Define_Menu_menu}
  105.  
  106.  
  107.  
  108. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  109. {                              O P T I O N      1                             }
  110. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  111. Procedure Toolkit_Explained;
  112. const
  113. X1 = 1;
  114. Y1 = 1;
  115. X2 = 80;
  116. Y2 = 24;
  117. var
  118. C1,C2,C3 : byte;
  119. begin
  120.     If ColorScreen then
  121.     begin
  122.         C1 := Lightgreen;
  123.         C2 := black;
  124.         C3 := yellow;
  125.     end
  126.     else
  127.     begin
  128.         C1 := white;
  129.         C2 := black;
  130.         C3 := white;
  131.     end;
  132.     Savescreen(1);
  133.     FBox(X1,Y1,X2,Y2,C1,C2,4);
  134.     OffCursor;
  135.     WriteCenter(Y1,C1,C2,' THE TOOLKIT EXPLAINED ');
  136.     WriteAT(X1+1,Y1+2,C3,C2,
  137.     'TechnoJock''s Turbo Toolkit is a collection of procedures and functions');
  138.     WriteAT(X1+3,Y1+3,C3,C2,
  139.     'for Turbo Pascal programmers. It will reduce the time taken to write');
  140.     WriteAT(X1+1,Y1+4,C3,C2,
  141.     'applications and is designed for novice and expert programmer alike.');
  142.     WriteAT(X1+1,Y1+6,C3,C2,
  143.     'The real purpose of the Toolkit is to provide easy-to-implement procedures');
  144.     WriteAT(X1+1,Y1+7,C3,C2,
  145.     'that free the programmer from the more tedious and repetitive programming');
  146.     WriteAT(X1+1,Y1+8,C3,C2,
  147.     'chores, such as windows, menus, user input, string formatting, directory');
  148.     WriteAT(X1+1,Y1+9,C3,C2,
  149.     'listings, mouse support, etc.');
  150.     WriteAT(X1+1,Y1+11,C3,C2,
  151.    'The Toolkit is being used by many programmers and corporations throughout');
  152.    WriteAT(X1+1,Y1+12,C3,C2,
  153.    'the world. There are TechnoJock Turboholics in Canada, Australia, Norway');
  154.    WriteAT(X1+1,Y1+13,C3,C2,
  155.    'UK, New Zealand, Switzerland, Sweden, West Germany, and all over the USA. ');
  156.    WriteAT(X1+1,Y1+15,C3,C2,
  157.    'If you use the Toolkit, please register your copy and support its further');
  158.    WriteAT(X1+1,Y1+16,C3,C2,
  159.    'development. Registration is $49.95 plus shipping and this includes 300 a');
  160.    WriteAT(X1+1,Y1+17,C3,C2,
  161.    'page typeset manual.');
  162.  
  163. WriteAT(X1+17,Y1+20,C1,C2,
  164.    'Enjoy.....');
  165.    WriteAT(X1+28,Y1+22,white,C2,
  166.    'TechnoJock Software, Inc., Houston.');
  167.    WriteAT(X2-20,Y2,C1,C2,' press any key ... ');
  168.    Ch := GetKey;
  169.    RestoreScreen(1);
  170.    DisposeScreen(1);
  171. end;
  172.  
  173. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  174. {                              O P T I O N      2                             }
  175. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  176. Procedure Explain_Fastwrite;
  177. const
  178. X1 = 1;
  179. Y1 = 1;
  180. X2 = 80;
  181. Y2 = 25;
  182. C1 = white;
  183. C2 = yellow;
  184. C3 = black;
  185. Max_Picks = 14;
  186.  
  187.       Procedure MainText;
  188.       begin
  189.       Box(X1,Y1,X2,Y2,C2,C3,1);
  190.       Horizline(3,77,19,red,black,1);
  191.       WriteCenter(Y1+1,C2,C3,'FastTTT5 Unit');
  192.       WriteAT(X1+5,Y1+3,C1,C3,
  193.       'The FastTTT5 unit contains a host of procedures for updating the');
  194.       WriteAT(X1+5,Y1+4,C1,C3,
  195.       'screen, at speeds exceeding an Isuzu.');
  196.       WriteAT(X1+5,Y1+6,C1,C3,
  197.       'The latest version of Turbo Pascal has some significantly improved');
  198.       WriteAT(X1+5,Y1+7,C1,C3,
  199.       'screen writing procedures. But the FastTTT5 unit is faster still,');
  200.       WriteAT(X1+5,Y1+8,C1,C3,
  201.       'especially on systems that are prone to snow.');
  202.       WriteAT(X1+5,Y1+10,C1,C3,
  203.       'The procedures are designed to work on IBM systems and 100% compatibles.');
  204.       WriteAT(X1+5,Y1+11,C1,C3,
  205.       'Listed below are just a few of the procedures in this unit. Move the cursor');
  206.       WriteAT(X1+5,Y1+12,C1,C3,
  207.       'to see a fuller description. Press [End] or [Esc] to return to the menu.');
  208.       end;  {sub proc Main_text}
  209.  
  210.       Procedure WriteOption(Pick,F,B:integer);
  211.       const
  212.       Lineone = 15;
  213.       LeftTab = 6;
  214.       Tab = 18;
  215.       begin
  216.       Case Pick of
  217.       1 : WriteAT(LeftTab,Lineone,F,B,             '    Box          ');
  218.       2 : WriteAT(LeftTab+Tab,Lineone,F,B,         '    HorizLine    ');
  219.       3 : WriteAT(LeftTab+2*Tab,LineOne,F,B,       '    VertLine     ');
  220.       4 : WriteAT(LeftTab+3*Tab,LineOne,F,B,       '    WriteAT      ');
  221.       5 : WriteAT(LeftTab,LineOne+1,F,B,           '    ClearText    ');
  222.       6 : WriteAT(LeftTab+Tab,LineOne+1,F,B,       '    WriteCenter  ');
  223.       7 : WriteAT(LeftTab+2*Tab,LineOne+1,F,B,     '    WriteBetween ');
  224.       8 : WriteAT(LeftTab+3*Tab,LineOne+1,F,B,     '    WriteVert    ');
  225.       9 : WriteAT(LeftTab,Lineone+2,F,B,           '    FBox         ');
  226.       10: WriteAt(LeftTab+tab,LineOne+2,F,B,       '    GrowFBox     ');
  227.       11: WriteAt(LeftTab+2*tab,LineOne+2,F,B,     '    ClearLine    ');
  228.       12: WriteAt(LeftTab+3*Tab,LineOne+2,F,B,     '    Attr         ');
  229.       13: WriteAT(LeftTab,Lineone+3,F,B,           '    FastWrite    ');
  230.       14: WriteAt(LeftTab+tab,LineOne+3,F,B,       '    PlainWrite   ');
  231.       end; {case}
  232.       end; {WriteOption}
  233.  
  234.       Procedure Hilite(Pick:integer);
  235.       begin
  236.       WriteOption(Pick,White,red);
  237.       end;   {HiLite}
  238.  
  239.       Procedure LoLite(Pick:integer);
  240.       begin
  241.       WriteOption(Pick,Lightgray,C3);
  242.       end;   {LoLite}
  243.  
  244.       Procedure DisplayDescription(Pick : integer);
  245.       const
  246.       X = 7;
  247.       Y = 20;
  248.       C = yellow;
  249.       begin
  250.       case Pick of
  251.       1 : begin
  252.            WriteAT(X,Y,C,black,  'Syntax :  Box(X1,Y1,X2,Y2,F,B,boxtype : integer);                   ');
  253.            WriteAT(X,Y+2,C,black,'Purpose : Draws a rectangular box on the screen in foreground color ');
  254.            WriteAT(X,Y+3,C,black,'          F and background color B. The boxtype indicates what line ');
  255.            WriteAT(X,Y+4,C,black,'          type to use i.e. single, double or combined.              ');
  256.           end;
  257.       2 : begin
  258.            WriteAT(X,Y,C,black,  'Syntax :  HorizLine(X1,X2,Y,F,B,LineType:integer);                  ');
  259.            WriteAT(X,Y+2,C,black,'Purpose : Draws a horizontal line on the screen in foreground color ');
  260.            WriteAT(X,Y+3,C,black,'          F and background color B. The linetype indicates what line');
  261.            WriteAT(X,Y+4,C,black,'          type to use i.e. single or double.                        ');
  262.           end;
  263.       3 : begin
  264.            WriteAT(X,Y,C,black,  'Syntax :  VertLine(X,Y1,Y2,F,B,LineType:integer);                   ');
  265.            WriteAT(X,Y+2,C,black,'Purpose : Draws a vertical line on the screen in foreground color F ');
  266.            WriteAT(X,Y+3,C,black,'          and background color B. The linetype indicates what line  ');
  267.            WriteAT(X,Y+4,C,black,'          type to use i.e. single or double.                        ');
  268.           end;
  269.       4 : begin
  270.            WriteAT(X,Y,C,black,  'Syntax :  WriteAT(X,Y,F,B:integer;ST:string80);                     ');
  271.            WriteAT(X,Y+2,C,black,'Purpose : Writes the string St very quickly on the screen starting  ');
  272.            WriteAT(X,Y+3,C,black,'          at (X,Y) in foreground color F and background color B. The');
  273.            WriteAT(X,Y+4,C,black,'          string may be concatenated e.g. ''Techno''+''Jock''.          ');
  274.           end;
  275.       5 : begin
  276.            WriteAT(X,Y,C,black,  'Syntax :  ClearText(X1,Y1,X2,Y2,F,B:integer);                       ');
  277.            WriteAT(X,Y+2,C,black,'Purpose : Clears the characters for a rectangular area on the screen');
  278.            WriteAT(X,Y+3,C,black,'          and displays background color B. The attribute for the    ');
  279.            WriteAT(X,Y+4,C,black,'          foreground is set to F. Unaffected by Window setting.     ');
  280.           end;
  281.       6 : begin
  282.            WriteAT(X,Y,C,black,  'Syntax :  WriteCenter(Lineno,F,B:integer;ST:string80);              ');
  283.            WriteAT(X,Y+2,C,black,'Purpose : Writes the string ST very quickly on the screen in the    ');
  284.            WriteAT(X,Y+3,C,black,'          center of line Lineno in foreground color F and back-     ');
  285.            WriteAT(X,Y+4,C,black,'          ground color B. The string may be concatenated.           ');
  286.           end;
  287.       7 : begin
  288.            WriteAT(X,Y,C,black,  'Syntax :  WriteBetween(X1,X2,Y,F,B:integer;ST:string80);            ');
  289.            WriteAT(X,Y+2,C,black,'Purpose : Writes the string ST very quickly on the screen centered  ');
  290.            WriteAT(X,Y+3,C,black,'          between X1 and X2 on line Y, in foreground F and back-    ');
  291.            WriteAT(X,Y+4,C,black,'          ground color B. The string may be concatenated.           ');
  292.           end;
  293.       8 : begin
  294.            WriteAT(X,Y,C,black,  'Syntax :  WriteVert(X,Y,F,B;ST:string80);                           ');
  295.            WriteAT(X,Y+2,C,black,'Purpose : Writes the string ST vertically on the screen starting at ');
  296.            WriteAT(X,Y+3,C,black,'          coordinate (X,Y) and continuing down the screen, in fore- ');
  297.            WriteAT(X,Y+4,C,black,'          ground color F and background color B.                    ');
  298.           end;
  299.       9 : begin
  300.            WriteAT(X,Y,C,black,  'Syntax :  FBox(X1,Y1,X2,Y2,F,B,Boxtype:Integer);                    ');
  301.            WriteAT(X,Y+2,C,black,'Purpose : Draws a rectangular box on the screen in foreground color ');
  302.            WriteAT(X,Y+3,C,black,'          F and background color B. The boxtype indicates the line  ');
  303.            WriteAT(X,Y+4,C,black,'          style. This is similar to Box except the box is cleared.  ');
  304.           end;
  305.       10: begin
  306.            WriteAT(X,Y,C,black,  'Syntax :  GrowFBox(X1,Y1,X2,Y2,F,B,Boxtype:Integer);                ');
  307.            WriteAT(X,Y+2,C,black,'Purpose : Draws a rectangular box on the screen in foreground color ');
  308.            WriteAT(X,Y+3,C,black,'          F and background color B. The boxtype indicates the line  ');
  309.            WriteAT(X,Y+4,C,black,'          style. This is similar to FBox except the box explodes.   ');
  310.           end;
  311.       11: begin
  312.            WriteAT(X,Y,C,black,  'Syntax :  ClearLine(Y,F,B:integer);                                 ');
  313.            WriteAT(X,Y+2,C,black,'Purpose : All text on screen line Y is cleared. The actual display  ');
  314.            WriteAT(X,Y+3,C,black,'          color of the line will be set to B.                       ');
  315.            WriteAT(X,Y+4,C,black,'                                                                    ');
  316.           end;
  317.       12: begin
  318.            WriteAT(X,Y,C,black,  'Syntax :  Attr(F,B):byte;                                           ');
  319.            WriteAT(X,Y+2,C,black,'Purpose : Combines the foreground color F with the background       ');
  320.            WriteAT(X,Y+3,C,black,'          color B and returns the resulting attribute byte.         ');
  321.            WriteAT(X,Y+4,C,black,'                                                                    ');
  322.           end;
  323.       13: begin
  324.            WriteAT(X,Y,C,black,  'Syntax :  Fastwrite(X,Y,F,B : byte; Str : string);                  ');
  325.            WriteAT(X,Y+2,C,black,'Purpose : This is the core procedure used by the others in the      ');
  326.            WriteAT(X,Y+3,C,black,'          Toolkit. String Str is written on the screen in foreground');
  327.            WriteAT(X,Y+4,C,black,'          F & background B at location (X,Y) el quicko.             ');
  328.           end;
  329.       14: begin
  330.            WriteAT(X,Y,C,black,  'Syntax :  PlainWrite(X,Y:byte; Str: string);                        ');
  331.            WriteAT(X,Y+2,C,black,'Purpose : This is even quicker than FastWrite but it uses the       ');
  332.            WriteAT(X,Y+3,C,black,'          default color attibute already assigned.                  ');
  333.            WriteAT(X,Y+4,C,black,'                                                                    ');
  334.           end;
  335.       end; {case}
  336.       end; {DisplayDescription}
  337.  
  338.       Procedure Keystroke;
  339.       const
  340.           CursorUp = #200;
  341.           CursorDown = #208;
  342.           CursorLeft = #203;
  343.           CursorRight = #205;
  344.           EndKey = #207;
  345.       var
  346.       Allover : boolean;
  347.       I,CurrentPick : integer;
  348.       begin
  349.           Allover := false;
  350.           CurrentPick := 1;
  351.           For I := 1 to Max_Picks do
  352.               LoLite(I);
  353.           HiLite(CurrentPick);
  354.           Repeat
  355.               Ch := getkey;
  356.               Case upcase(Ch) of
  357.               CursorUp :      If CurrentPick > 4 then
  358.                               begin
  359.                                   LoLite(CurrentPick);
  360.                                   CurrentPick := CurrentPick - 4;
  361.                                   HiLite(CurrentPick);
  362.                               end;
  363.               CursorDown :    If CurrentPick <= Max_Picks - 4 then
  364.                               begin
  365.                                   LoLite(CurrentPick);
  366.                                   CurrentPick := CurrentPick + 4;
  367.                                   HiLite(CurrentPick);
  368.                               end;
  369.              ' ',
  370.              CursorRight :   begin
  371.                                  LoLite(CurrentPick);
  372.                                  If CurrentPick < Max_Picks then
  373.                                      CurrentPick := CurrentPick + 1
  374.                                  else
  375.                                      CurrentPick := 1;
  376.                                  HiLite(CurrentPick);
  377.                              end;
  378.             CursorLeft :    begin
  379.                                 LoLite(CurrentPick);
  380.                                 If CurrentPick > 1 then
  381.                                    CurrentPick := CurrentPick - 1
  382.                                 else
  383.                                    CurrentPick := Max_Picks;
  384.                                 HiLite(CurrentPick);
  385.                             end;
  386.             #027,
  387.             EndKey :        Allover := true;
  388.             end; {case}
  389.             DisplayDescription(CurrentPick);
  390.       Until Allover;
  391.       end;  {Keystroke}
  392.  
  393.  
  394. begin       {Explain_Fastwrite}
  395.     SaveScreen(1);
  396.     Clrscr;
  397.     OffCursor;
  398.     MainText;
  399.     DisplayDescription(1);
  400.     Keystroke;
  401.     RestoreScreen(1);
  402.     DisposeScreen(1);
  403. end;  {proc Explain_Fastwrite}
  404.  
  405. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  406. {                              O P T I O N      3                             }
  407. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  408. Procedure Explain_Windows;
  409. var
  410.    I : integer;
  411.    c1,c2,c3,c4,c5,c6: byte;
  412.  
  413. begin
  414.     If ColorScreen then
  415.     begin
  416.         C1 := yellow;
  417.         C2 := green;
  418.         C3 := white;
  419.         C4 := white;
  420.         C5 := red;
  421.         C6 := magenta;
  422.     end
  423.     else
  424.     begin
  425.         C1 := black;
  426.         C2 := lightgray;
  427.         C3 := white;
  428.         C4 := white;
  429.         C5 := black;
  430.         C6 := black;
  431.     end;
  432.     Savescreen(1);
  433.     OffCursor;
  434.     ClrScr;
  435.     MkWin(1,1,35,14,c1,c2,2);
  436.     WriteBetween(1,35,2,C1,c2,'WinTTT5');
  437.     WriteAt(3,4,c3,c2,'The Window procedures provide');
  438.     WriteAT(3,5,c3,c2,'tools for easily writing flash');
  439.     WriteAT(3,6,c3,c2,'up window routines. ');
  440.     WriteAT(3,8,c3,c2,'They also include procedures');
  441.     WriteAT(3,9,c3,c2,'for saving and restoring screen');
  442.     WriteAT(3,10,c3,c2,'images.');
  443.     WriteAT(3,13,c3,c2,'... press any key.');
  444.     DelayKey(4000);
  445.     Mkwin(34,7,66,20,c4,c5,3);
  446.     WriteAT(36,9,c4,c5, 'The windows can be placed any');
  447.     WriteAT(36,10,c4,c5,'where on the screen and both');
  448.     WriteAT(36,11,c4,c5,'the border style and colors ');
  449.     WriteAT(36,12,c4,c5,'can be easily altered.');
  450.     DelayKey(3000);
  451.     Mkwin(20,13,68,25,c4,c6,1);
  452.     WriteAT(22,15,c4,c6,'The WinTTT unit includes a host of Windowing ');
  453.     WriteAT(22,16,c4,c6,'procedures, and a collection of fancy screen ');
  454.     WriteAT(22,17,c4,c6,'restoring and sliding procedures.            ');
  455.     WriteAT(22,19,c4,c6,'As well as windows, the WinTTT5 unit includes');
  456.     WriteAT(22,20,c4,c6,'full support for virtual screens, cursor con-');
  457.     WriteAT(22,21,c4,c6,'trol, routines for the display of temporary ');
  458.     WriteAT(22,22,c4,c6,'messages and much more.                     ');
  459.     WriteAT(22,24,c4,c6,'Press any key to see some screen manipulation');
  460.     Ch := getkey;
  461.     Rmwin;
  462.     Delay(300);
  463.     Rmwin;
  464.     Delay(300);
  465.     Rmwin;
  466.     Delay(300);
  467.     Rmwin;
  468.     SlideRestoreScreen(1,left);
  469.     SlideRestoreScreen(1,up);
  470.     SlideRestoreScreen(1,right);
  471.     DisposeScreen(1);
  472. end;
  473.  
  474. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  475. {                              O P T I O N      4                             }
  476. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  477.  Procedure Menu_Intro;
  478.  {}
  479.  var
  480.    C1,C2,C3: byte;
  481.  begin
  482.     If ColorScreen then
  483.     begin
  484.         C1 := lightred;
  485.         C2 := red;
  486.     end
  487.     else
  488.     begin
  489.         C1 := lightgray;
  490.         C2 := lightgray;
  491.     end;
  492.     Savescreen(1);
  493.     Clrscr;
  494.     OffCursor;
  495.     Box(1,1,80,25,C1,black,1);
  496.     WriteCenter(3,c1,black,'The Toolkit Menu Units');
  497.     WriteAT(3,5,white,black,
  498.     'The most appropriate style of menu for an application is very dependent upon');
  499.     WriteAT(3,6,white,black,
  500.     'the primary purpose of the program. For example, a good menu for a database ');
  501.     WriteAT(3,7,white,black,
  502.     'will not be suitable for a word processor. The Toolkit offers four different');
  503.     WriteAT(3,8,white,black,
  504.     'menu systems so that you can select the most appropriate menu interface for');
  505.     WriteAT(3,9,white,black,
  506.     'your application.');
  507.     WriteAT(3,11,white,black,
  508.     'The four menuing units are MenuTTT5, PullTTT5, NestTTT5 and ListTTT5. Each');
  509.     WriteAT(3,12,white,black,
  510.     'of the menus employs a set of default characteristics, e.g. menu position,');
  511.     WriteAT(3,13,white,black,
  512.     'menu color, etc. The look and feel of the menu can be dramatically altered');
  513.     WriteAT(3,14,white,black,
  514.     'by changing the default settings.');
  515.     WriteAT(3,16,white,black,
  516.     'MenuTTT5 is the unit used to display the menus in this demo program.     ');
  517.     WriteAT(3,17,white,black,
  518.     'PullTTT5 provides a very easy way of implementing a pull down menu system');
  519.     WriteAT(3,18,white,black,
  520.     'similar to the one used in the Turbo Environment. NestTTT5 is a very power-');
  521.     WriteAT(3,19,white,black,
  522.     'ful and flexible menu modelled on Borland''s Sprint word processor. ListTTT5');
  523.     WriteAT(3,20,white,black,
  524.     'is a generic listing program that can be used to display a list in a ');
  525.     WriteAT(3,21,white,black,
  526.     'scrollable window. The list procedure is passed an array of strings that');
  527.     WriteAT(3,22,white,black,
  528.     'define each of the topics in the list.');
  529.    WriteAt(60,25,c1,black,' press any key .... ');
  530.    Ch := getkey;
  531.    RestoreScreen(1);
  532.    DisposeSCreen(1);
  533.  end; {of proc Menu_Intro}
  534.  
  535. Procedure PullDemo;
  536. var
  537. TheMenu : Pull_array;   {Array holding the menu definitions}
  538.  
  539.        Procedure Define_Demo_Menu;
  540.        begin
  541.            Fillchar(Themenu,sizeof(Themenu),#0);
  542.            TheMenu[1] := '\File';      {menu definition for pull down menu}
  543.            TheMenu[2] := 'Load        ';
  544.            TheMenu[2] := 'Pick        ';
  545.  
  546.            TheMenu[3] := 'New         ';
  547.            TheMenu[4] := 'Save        ';
  548.            TheMenu[5] := 'Write to    ';
  549.            TheMenu[6] := 'Directory   ';
  550.            TheMenu[7] := 'Change dir  ';
  551.            TheMenu[8] := 'OS shell    ';
  552.            TheMenu[9] := 'Quit        ';
  553.  
  554.            TheMenu[10] :=  '\Edit ';
  555.  
  556.            TheMenu[11] :=  '\Run ';
  557.            TheMenu[12] :=  'Program reset ';
  558.            TheMenu[13] :=  'Go to cursor  ';
  559.            TheMenu[14] :=  'Trace into    ';
  560.            TheMenu[15] :=  ' Step Over    ';
  561.            TheMenu[16] :=  'User Screen   ';
  562.  
  563.            TheMenu[17] := '\Compile';
  564.            TheMenu[18] := 'Compile      ';
  565.            TheMenu[19] := 'Make         ';
  566.            TheMenu[20] := 'Build        ';
  567.            TheMenu[21] := 'Destination  ';
  568.            TheMenu[22] := 'Find Error   ';
  569.            TheMenu[23] := 'Primary file ';
  570.            TheMenu[24] := 'Get Info     ';
  571.  
  572.            TheMenu[25] := '\Options';
  573.            TheMenu[26] := 'Compiler        ';
  574.            TheMenu[27] := 'Linker          ';
  575.            TheMenu[28] := 'Environment     ';
  576.            TheMenu[29] := 'Directories     ';
  577.            TheMenu[30] := 'Parameters      ';
  578.            TheMenu[31] := 'Save Options    ';
  579.            TheMenu[32] := 'Retrieve Options';
  580.  
  581.            TheMenu[22] := '\Debug';
  582.            TheMenu[23] := 'Evaluate              ';
  583.            TheMenu[23] := 'Call stack            ';
  584.            TheMenu[24] := 'Find procedure        ';
  585.            TheMenu[25] := 'Integrated debugging  ';
  586.            TheMenu[26] := 'Stand-alone debugging ';
  587.            TheMenu[27] := 'Display Swapping      ';
  588.            TheMenu[28] := 'Refresh display       ';
  589.  
  590.            TheMenu[29] := '\Break/Watch';
  591.            TheMenu[30] := 'Add Watch             ';
  592.            TheMenu[31] := 'Delete Watch          ';
  593.            TheMenu[32] := 'Edit Watch            ';
  594.            TheMenu[33] := 'Remove all watches    ';
  595.            TheMenu[34] := 'Toggle breakpoint     ';
  596.            TheMenu[35] := 'Clear all breakpoints ';
  597.            TheMenu[36] := 'View next breakpoint  ';
  598.            TheMenu[37] := '\\';
  599.  
  600.       end; {Proc Define demo menu}
  601.  
  602.       Procedure Fill_Screen_With_Junk;
  603.       var I,J : integer;
  604.       begin
  605.           ClrScr;
  606.           Box(1,2,80,25,cyan,black,2);
  607.           ClearLine(1,white,blue);
  608.           WriteCenter(2,yellow,cyan,'EDIT');
  609.           Writecenter(15,lightgray,black,' Use the cursor keys... recognize the menu? ');
  610.           WriteAT(3,3,lightgray,black,
  611.           'Line 1     Col 1           Insert  Indent          Unindent  c:NONAME.PAS ');
  612.       end;
  613.  
  614. var
  615.  Major,Minor : byte;
  616.  Ch : char;
  617.  
  618. begin
  619.     Define_Demo_Menu;
  620.     SaveScreen(1);
  621.     Fill_Screen_With_Junk;
  622.     Major := 1;
  623.     Minor := 1;
  624.     With PTTT do
  625.     begin
  626.         Style := 0;  {0 no border, 1 single border, 2 double border}
  627.         TopX :=  1;
  628.         TopY := 1;
  629.         Gap :=  5;
  630.         RemoveMenu := false;
  631.     end; {With}
  632.     Pull_Menu(TheMenu,Major,Minor);
  633.     GotoXY(1,20);
  634.     If Major = 0 then
  635.        WriteAt(15,17,white,black,'You escaped ')
  636.     else
  637.        WriteAt(15,17,white,black,'You selected main menu '+Int_to_Str(Major)+' and sub-topic '+Int_to_Str(Minor));
  638.     WriteAt(15,18,yellow,black,'Press any key to return to the real menu.......');
  639.     Ch := Getkey;
  640.     RestoreScreen(1);
  641.     DisposeScreen(1);
  642. end;
  643.  
  644. {+++++++++++++++++++++++}
  645. {                       }
  646. {   N E S T    D E M O  }
  647. {                       }
  648. {+++++++++++++++++++++++}
  649. var
  650.   Hyphens,
  651.   EndProgram: Boolean;
  652.   Main_Menu,
  653.   Long_menu,
  654.   File_Menu,                       {dummy menu is a short cut to represent}
  655.   Utility_Menu,                    {all the other menus that would be used}
  656.   Dummy_Menu:Nest_Menu;            {in a large system.                    }
  657.  
  658.  
  659.    Procedure Dummy_Activity(var Finish:byte);
  660.    {Saves writing a lot of real life procedures for the demo}
  661.    begin
  662.        TempMessageBox(20,5,white,red,3,'Just imagine I did something!');
  663.        Finish := DontClear;   {return to same place in the menu}
  664.    end; {of proc Dummy_Activity}
  665.  
  666.  
  667.  
  668. {$F+}
  669.    Procedure Action(Var Code: integer; var Finish:byte);
  670.    {This is the main procedure the controls the execution of all
  671.     the menu options.}
  672.    begin
  673.        Case Code of
  674.        902: begin
  675.                 If Hyphens then
  676.                    Modify_Topic_name(Utility_Menu,2,'Hyphenation  *  Off')
  677.                 else
  678.                    Modify_Topic_name(Utility_Menu,2,'Hyphenation  *  On ');
  679.                 Hyphens := not Hyphens;
  680.                 Finish := RefreshTopic;
  681.             end;
  682.        910: begin
  683.                 TempMessageBox(20,5,white,red,3,'We will back up one level');
  684.                 Finish := ClearCurrent;
  685.             end;
  686.        999: begin
  687.                 sound(1000);delay(2);nosound;
  688.                 Endprogram := true;
  689.                 Finish := ClearAll;
  690.             end;
  691.        else Dummy_Activity(Finish);
  692.        end;  {case}
  693.    end; {of proc Action}
  694.    {$F-}
  695.  
  696.    
  697.  
  698. Procedure NestTTT5_Demo_1;
  699. {This section is a direct import of the file nestdem1.pas}
  700.  
  701.   Procedure SetUp_Menus;
  702.   begin
  703.       Initialize_Menu(Main_Menu,'Sprint',0,0);  {14}
  704.       Initialize_Menu(File_Menu,'File',22,12);
  705.       Initialize_Menu(Utility_Menu,'Utility',19,13);
  706.       Initialize_Menu(Long_Menu,'Potpourri',19,10);
  707.       Initialize_Menu(Dummy_Menu,'A N Other',0,0);
  708.   end; {of proc SetUp_Menus}
  709.  
  710.   Procedure Define_Main_Menu;
  711.   {}
  712.   begin
  713.       Add_Topic(Main_Menu,'File       *  Alt-F',true,#161,101,@File_Menu);
  714.       Add_Topic(Main_Menu,'Edit'              ,true,#0  ,0,@Dummy_Menu);
  715.       Add_Topic(Main_Menu,'-'                 ,true,#0  ,0  ,nil);
  716.       Add_Topic(Main_Menu,'Insert'            ,true,#0,103,@Dummy_Menu);
  717.       Add_Topic(Main_Menu,'Typestyle'         ,true,#0,104,@Dummy_Menu);
  718.       Add_Topic(Main_Menu,'Style'             ,true,#0,105,@Dummy_Menu);
  719.       Add_Topic(Main_Menu,'Layout'            ,true,#0,0,@Dummy_Menu);
  720.       Add_Topic(Main_Menu,'-'                 ,true,#0,0,nil);
  721.       Add_Topic(Main_Menu,'Print'             ,false,#0,107,@Dummy_Menu);
  722.       Add_Topic(Main_Menu,'Window'            ,true,#0,108,@Dummy_Menu);
  723.       Add_Topic(Main_Menu,'Utilities  *  Alt-U'  ,true,#150,109,@Utility_Menu);
  724.       Add_Topic(Main_Menu,'Customize'         ,true,#0,110,@Dummy_Menu);
  725.       Add_Topic(Main_Menu,'-'                 ,true,#0,0,nil);
  726.       Add_Topic(Main_Menu,'Quit'              ,true,#173,999,nil);
  727.   end; {of proc Define_Main_Menu}
  728.  
  729.   Procedure Define_File_Menu;
  730.   {}
  731.   begin
  732.       Add_Topic(File_Menu,'New'            ,true,#0,201,nil);
  733.       Add_Topic(File_Menu,'Open'           ,true,#0,202,nil);
  734.       Add_Topic(File_Menu,'Close'          ,true,#0,203,nil);
  735.       Add_Topic(File_Menu,'Insert'         ,true,#0,204,nil);
  736.       Add_Topic(File_Menu,'-'              ,true,#0,0,nil);
  737.       Add_Topic(File_Menu,'Save'           ,true,#0,205,nil);
  738.       Add_Topic(File_Menu,'Write As'       ,true,#0,206,nil);
  739.       Add_Topic(File_Menu,'Revert to Saved',true,#0,207,nil);
  740.       Add_Topic(File_Menu,'-'              ,true,#0,0,nil);
  741.       Add_Topic(File_Menu,'Translate'      ,true,#0,208,nil);
  742.       Add_Topic(File_Menu,'File Manager'   ,true,#0,209,nil);
  743.       Add_Topic(File_Menu,'Pick from List' ,true,#0,210,nil);
  744.   end; {of proc Define_File_Menu}
  745.  
  746.   Procedure Define_Long_Menu;
  747.   {}
  748.   begin
  749.       Add_Topic(Long_Menu,'bottom of File' ,true,#0,71,nil);
  750.       Add_Topic(Long_Menu,'Bottom of screen',true,#0,72,nil);
  751.       Add_Topic(Long_Menu,'case Rotate'    ,true,#0,73,nil);
  752.       Add_Topic(Long_Menu,'case Switch'     ,true,#0,74,nil);
  753.       Add_Topic(Long_Menu,'center Tab'     ,true,#0,75,nil);
  754.       Add_Topic(Long_Menu,'Decimal tab'    ,true,#0,76,nil);
  755.       Add_Topic(Long_Menu,'delete Line'    ,true,#0,77,nil);
  756.       Add_Topic(Long_Menu,'delete Word'    ,true,#0,78,nil);
  757.       Add_Topic(Long_Menu,'delete Sentence',true,#0,79,nil);
  758.       Add_Topic(Long_Menu,'delete Paragraph',true,#0,80,nil);
  759.       Add_Topic(Long_Menu,'delete End of line' ,true,#0,81,nil);
  760.       Add_Topic(Long_Menu,'reformat Document',true,#0,82,nil);
  761.       Add_Topic(Long_Menu,'eXchange cases'    ,true,#0,73,nil);
  762.       Add_Topic(Long_Menu,'lookup Zip'     ,true,#0,74,nil);
  763.       Add_Topic(Long_Menu,'Underline'      ,true,#0,75,nil);
  764.       Add_Topic(Long_Menu,'Italicize'      ,true,#0,76,nil);
  765.       Add_Topic(Long_Menu,'go Home'        ,true,#0,77,nil);
  766.       Add_Topic(Long_Menu,'Cancel undo'    ,true,#0,78,nil);
  767.   end; {of proc Define_Long_Menu}
  768.  
  769.   Procedure Define_Utility_Menu;
  770.   {}
  771.   begin
  772.       Hyphens := true;
  773.       Add_Topic(Utility_Menu,'Spelling'    ,true,#0,901,nil);
  774.       Add_Topic(Utility_Menu,'Hyphenation  *  On ' ,true,#0,902,nil);
  775.       Add_Topic(Utility_Menu,'Thesaurus'   ,true,#0,903,nil);
  776.       Add_Topic(Utility_Menu,'Glossary'    ,true,#0,904,nil);
  777.       Add_Topic(Utility_Menu,'-'           ,true,#0,0,nil);
  778.       Add_Topic(Utility_Menu,'Arrange-Sort',true,#0,905,nil);
  779.       Add_Topic(Utility_Menu,'Line Drawing',true,#0,906,nil);
  780.       Add_Topic(Utility_Menu,'-'           ,true,#0,0,nil);
  781.       Add_Topic(Utility_Menu,'Potpourri    *',true,#0,907,@Long_Menu);
  782.       Add_Topic(Utility_Menu,'QuickCard'   ,true,#0,908,nil);
  783.       Add_Topic(Utility_Menu,'Macros'      ,true,#0,909,nil);
  784.       Add_Topic(Utility_Menu,'-'           ,true,#0,0,nil);
  785.       Add_Topic(Utility_Menu,'Back Up Demo *',true,#0,910,nil);
  786.   end; {of proc Define_Utility_Menu}
  787.  
  788.   Procedure Define_Dummy_Menu;
  789.   {}
  790.   begin
  791.       Add_Topic(Dummy_Menu,'Ignite'      ,true,#0,801,nil);
  792.       Add_Topic(Dummy_Menu,'Check Boosters',true,#0,802,nil);
  793.       Add_Topic(Dummy_Menu,'Fire Retros' ,true,#0,803,nil);
  794.       Add_Topic(Dummy_Menu,'Shutdown'    ,true,#0,804,nil);
  795.       Add_Topic(Dummy_Menu,'-'           ,true,#0,0,nil);
  796.       Add_Topic(Dummy_Menu,'Launch'      ,true,#0,805,nil);
  797.       Add_Topic(Dummy_Menu,'Remove Suit',false,#0,806,nil);
  798.       Add_Topic(Dummy_Menu,'-'           ,true,#0,0,nil);
  799.       Add_Topic(Dummy_Menu,'Abort Mission',true,#0,807,nil);
  800.       Add_Topic(Dummy_Menu,'Panic'       ,true,#0,808,nil);
  801.   end; {of proc Define_Dummy_Menu}
  802.  
  803.   Procedure Paint_Screen;
  804.   {makes the screen look like a word processor}
  805.   begin
  806.       ClearText(1,1,80,25,lightgray,blue);
  807.       WriteAt(1,25,black,lightgray,
  808.       Padleft('Press F10 or / for menu.             Alt-X   to quit to main demo',80,' '));
  809.       Plainwrite(1,1,
  810.       '[     T     1         2         3         4         5         6         7     ]');
  811.       Plainwrite(5,3,'Imagine you have written a wordprocessing program and you want');
  812.       PlainWrite(5,4,'to give the program a full and powerful menu system. The NestTTT');
  813.       PlainWrite(5,5,'unit will give you all the power you need and more!');
  814.       PlainWrite(5,7,'For starters, press the F10 key or the slash key, and roam around');
  815.       Plainwrite(5,8,'the menu a little. Features include: capital letter selection, ');
  816.       Plainwrite(5,9,'optional HotKey selection, point and shoot (with full mouse support),');
  817.       Plainwrite(5,10,'non-selectable topics, line separators, auto positioning of menus and');
  818.       PlainWrite(5,11,'sub menus. The list goes on and on...');
  819.       PlainWrite(5,13,'When a menu "system" has been defined, it''s easy to call up any of the');
  820.       PlainWrite(5,14,'nested menus and bypass all the parent menus. For example, press Alt-U');
  821.       Plainwrite(5,15,'while no menu is on display - the Utility menu will automatically pop-up');
  822.       Plainwrite(5,16,'at the top level.');
  823.       PlainWrite(5,18,'All of the topics that are highlighted with an asterisk "*" are designed');
  824.       Plainwrite(5,19,'to illustrate some of the features of the menu. For example, select the');
  825.       Plainwrite(5,20,'Utility option from the main menu, or press Alt-U, and select the Potpourri');
  826.       Plainwrite(5,21,'topic. This is a menu that exceeds the no. of display lines - the menu');
  827.       Plainwrite(5,22,'will automatically scroll the topics. Also, select the Hyphenation topic');
  828.       Plainwrite(5,23,'to see a topic that can switch between two or more displays.');
  829.   end; {of proc Paint_Screen}
  830.  
  831.  
  832.    Procedure Menu_Loop;
  833.    {}
  834.    var Ch : char;
  835.    begin
  836.        EndProgram := false;
  837.        Repeat
  838.             Ch := Getkey;
  839.             Case Ch of
  840.             #178,                               {Alt-M}
  841.             '/',
  842.             #196 :  Show_Nest(Main_menu);       {F10}
  843.             #161 :  Show_Nest(File_Menu);       {Alt F}
  844.             #150 :  Show_Nest(Utility_menu);    {Alt U}
  845.             #027,
  846.             #173 :  Endprogram := true;         {Alt X}
  847.             end;
  848.       Until   EndProgram;
  849.    end; {of proc Menu_Loop}
  850.  
  851.  
  852. begin                                         {The main program}
  853.     SaveScreen(1);
  854.     ClearText(1,1,80,25,white,black);
  855.     SetUp_menus;
  856.     Define_Main_Menu;
  857.     Define_File_menu;
  858.     Define_Utility_Menu;
  859.     Define_Dummy_Menu;
  860.     Define_Long_Menu;
  861.     Assign_Despatcher(Action);
  862.     With NTTT do             {optionally modify default colors etc.}
  863.     begin
  864.         AllowEsc := true;
  865.         LeftSide := false;
  866.         BoxFCol := black;
  867.         BoxBCol := lightgray;
  868.         CapFCol := white;
  869.         BacCol := lightgray;
  870.         NorFCol := Black;
  871.         LoFCol := blue;
  872.         HiFCol := Lightgray;
  873.         HiBCol := blue;
  874.         LeftChar := ' ';
  875.         RightChar := ' ';
  876.     end;
  877.     Paint_Screen;
  878.     Menu_Loop;
  879.     Delete_All_Topics(Utility_Menu);
  880.     Delete_All_Topics(File_Menu);
  881.     Delete_All_Topics(Main_Menu);
  882.     Delete_All_Topics(Dummy_Menu);
  883.     RestoreScreen(1);
  884.     DisposeScreen(1);
  885. end;
  886.  
  887. {+++++++++++++++++++++++}
  888. {                       }
  889. {   L I S T    D E M O  }
  890. {                       }
  891. {+++++++++++++++++++++++}
  892. procedure Show_The_Girlfriends;
  893. const
  894.     ListWidth = 60;
  895. type
  896.     StrList  = string[ListWidth];
  897.  
  898. var
  899.     MyList   : array[1..30] of StrList;
  900.  
  901.  Procedure Fill_MyList;
  902.  {}
  903.  begin
  904.      MyList[1] := 'Erica';
  905.      MyList[2] := 'Alison';
  906.      MyList[3] := 'Barbara';
  907.      MyList[4] := 'Sarah';
  908.      MyList[5] := 'Katy';
  909.      MyList[6] := 'Janice';
  910.      MyList[7] := 'Susan';
  911.      MyList[8] := 'Serita';
  912.      MyList[9] := 'Anne';
  913.      MyList[10] := 'Michelle';
  914.      MyList[11] := 'Theresa';
  915.      MyList[12] := 'Shirley';
  916.      MyList[13] := 'Sue';
  917.      MyList[14] := 'Marianne';
  918.      MyList[15] := 'Wilma';
  919.      MyList[16] := 'Beatrice';
  920.      MyList[17] := 'Regina';
  921.      MyList[18] := 'Sudafed';
  922.      MyList[19] := 'Trojan';
  923.      MyList[20] := 'Whip';
  924.  end; {of proc Fill_MyList}
  925.  
  926.  Procedure Display_Info;
  927.  {}
  928.  begin
  929.      Box(1,1,40,21,lightred,black,1);
  930.      FCol := yellow;
  931.      BCol := black;
  932.      Writebetween(1,40,2,white,black,'ListTTT5');
  933.      ColWrite(3,4,'This unit is a generic list program  ');
  934.      ColWrite(3,5,'that can be used to display an array ');
  935.      ColWrite(3,6,'of strings in a window. The user can ');
  936.      ColWrite(3,7,'select one pick, or optionally more  ');
  937.      ColWrite(3,8,'than one pick, from the list. ');
  938.      ColWrite(3,10,'All you have to do is pass the List  ');
  939.      ColWrite(3,11,'a string array and it will take care ');
  940.      ColWrite(3,12,'of the rest! ');
  941.      ColWrite(3,14,'The unit will return the topic(s)    ');
  942.      ColWrite(3,15,'selected by the user. The adjacent');
  943.      ColWrite(3,16,'list was created with the ListTTT5');
  944.      ColWrite(3,17,'unit. Use the cursor keys to move ');
  945.      ColWrite(3,18,'around the menu, press the space  ');
  946.      ColWrite(3,19,'to (de)select and Enter to quit.');
  947.  end; {of proc Display_Info}
  948.  
  949.  
  950. begin
  951.     Fill_MyList;
  952.     Savescreen(1);
  953.     ClrScr;
  954.     Display_Info;
  955.     With LTTT do
  956.     begin
  957.         X := 50;
  958.         Y := 9;
  959.     end;
  960.     Show_List(MyList,ListWidth,20);
  961.     RestoreScreen(1);
  962.     DisposeScreen(1);
  963. end;
  964.  
  965. {+++++++++++++++++++++++}
  966. {                       }
  967. {   M E N U    D E M O  }
  968. {                       }
  969. {+++++++++++++++++++++++}
  970.  
  971. Procedure Explain_Menu;
  972. var
  973.   P,code : integer;
  974.   C1,C2,C3: byte;
  975.  
  976.     Procedure Instructions(Number:integer);
  977.     begin
  978.         P := 1;
  979.         Case Number of
  980.         1 : begin
  981.                 WriteAT(9,23,white,black,
  982.                 'This is a mock up of the Main menu but changed to two picks per line,');
  983.                 WriteAT(9,24,white,black,
  984.                 'and moved to the left. Play with the cursor and select an option.    ');
  985.             end;
  986.         2 : begin
  987.                 WriteAT(9,23,white,black,
  988.                 'Now the menu has been changed back to one pick per line and the      ');
  989.                 WriteAT(9,24,white,black,
  990.                 'prefix has changed to a letter. Press a letter or move & Enter.      ');
  991.             end;
  992.         3 : begin
  993.                 WriteAT(9,23,white,black,
  994.                 'Last one I promise! Now the prefix is a number and we''ve changed    ');
  995.                 WriteAT(9,24,white,black,
  996.                 'the colors. Select an option and press Enter.                        ');
  997.             end;
  998.     end; {case}
  999.     end; {sub proc Instructions}
  1000.  
  1001. begin
  1002.    If ColorScreen then
  1003.    begin
  1004.        C1 := lightred;
  1005.        C2 := red;
  1006.    end
  1007.    else
  1008.    begin
  1009.        C1 := lightgray;
  1010.        C2 := lightgray;
  1011.    end;
  1012.    SaveScreen(1);
  1013.    Clrscr;
  1014.    Offcursor;
  1015.    Box(1,22,80,25,c1,black,1);
  1016.    With M1 do
  1017.    begin
  1018.        PicksPerLine := 2;
  1019.        TopleftXY[1] := 1;
  1020.    end;
  1021.    Instructions(1);
  1022.    Displaymenu(M1,false,P,code);
  1023.    With M1 do
  1024.    begin
  1025.        PicksPerLine := 1;
  1026.        TopleftXY[1] := 55;
  1027.        TopleftXY[2] := 5;
  1028.        Addprefix := 2;
  1029.    end;
  1030.    Instructions(2);
  1031.    Displaymenu(M1,false,P,code);
  1032.    With M1 do
  1033.    begin
  1034.        TopleftXY[1] := 15;
  1035.        TopleftXY[2] := 4;
  1036.        Addprefix := 1;
  1037.        If ColorScreen then
  1038.        begin
  1039.            Colors[1] := yellow;
  1040.            Colors[2] := green;
  1041.            Colors[3] := lightgreen;
  1042.            Colors[4] := red;
  1043.            Colors[5] := white;
  1044.        end;
  1045.    end;
  1046.    Instructions(3);
  1047.    Displaymenu(M1,false,P,code);
  1048.    Mkwin(5,10,70,17,white,c2,2);
  1049.    Offcursor;
  1050.    WriteAT(15,12,white,c2,'All these modifications were effected by making');
  1051.    WriteAT(15,13,white,c2,'simple changes to the menu record.             ');
  1052.    WriteAT(50,17,white,c2,' press any key .... ');
  1053.    Define_Menu1;           {set it all back to normal}
  1054.    Ch := getkey;
  1055.    Rmwin;
  1056.    RestoreScreen(1);
  1057.    DisposeScreen(1);
  1058.    Offcursor;
  1059. end;
  1060.  
  1061. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  1062. {                              O P T I O N      5                             }
  1063. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  1064. {$F+}
  1065. Procedure Help_EditKeys(var Ch:Char;var Fieldid : byte;var Refresh: byte);
  1066. var C1,C2,c3 : byte;
  1067. begin
  1068.     If ColorScreen then
  1069.     begin
  1070.         C1 := lightcyan;
  1071.         C2 := white;
  1072.         C3 := blue;
  1073.     end
  1074.     else
  1075.     begin
  1076.         C1 := white;
  1077.         C2 := black;
  1078.         C3 := lightgray;
  1079.     end;
  1080.     If Ch <> #187 then exit;
  1081.     Mkwin(40,1,80,25,C1,c3,2);
  1082.     WriteBetween(40,80,2,C1,c3,'IO Editing Keys');
  1083.     WriteAT(42,3,c2,c3,'The operative edit keys are defined');
  1084.     WriteAT(42,4,c2,c3,'in IOTTT5.pas. They may be modified to');
  1085.     WriteAT(42,5,c2,c3,'suit your needs. The defaults are:  ');
  1086.     WriteAT(42,7,c2,c3, 'Move Up      '+chr(024));
  1087.     WriteAT(42,8,c2,c3, 'Move Down    '+chr(025));
  1088.     WriteAT(42,9,c2,c3,'Move Right   Ctrl -'+chr(016)+', Tab or Enter');
  1089.     WriteAT(42,10,c2,c3,'Move Left    Ctrl '+chr(017)+'- or ShiftTab');
  1090.     WriteAT(42,12,c2,c3,'Insert       Press [Ins] to toggle');
  1091.     WriteAT(42,14,c2,c3,'Del Char     [Del]  or  [Backspace]');
  1092.     WriteAT(42,15,c2,c3,'Del Field    Alt-D');
  1093.     WriteAT(42,16,c2,c3,'Del Global   Alt-E');
  1094.     WriteAT(42,18,c2,c3,'Update       F10');
  1095.     WriteAT(42,19,c2,c3,'Abort        [Esc]');
  1096.     WriteAT(42,21,c2,c3,'Note the abort key can be disabled,');
  1097.     WriteAT(42,22,c2,c3,'as it is in this example. Just press');
  1098.     WriteAT(42,23,c2,c3,'[F10] to finish the example.');
  1099.     Ch := getkey;
  1100.     Rmwin;
  1101. end;
  1102. {$F-}
  1103.  
  1104. Procedure Explain_IO;
  1105.  
  1106.      Procedure Display_Text;
  1107.      var C1,C2 : byte;
  1108.      begin
  1109.          If ColorScreen then
  1110.          begin
  1111.              C1 := yellow;
  1112.              C2 := lightgreen;
  1113.          end
  1114.          else
  1115.          begin
  1116.              C1 := lightgray;
  1117.              C2 := white;
  1118.          end;
  1119.          Clrscr;
  1120.          Box(1,1,80,11,C1,black,3);
  1121.   WriteCenter(2,C1,black,'The IOTTT5 Unit');
  1122.   WriteAT(3,4,c2,black,
  1123.   'One of the (few) short comings of Turbo Pascal is its very limited support');
  1124.   WriteAT(3,5,c2,black,
  1125.   'for screen input that gives the user a chance to move around the screen and');
  1126.   WriteAT(3,6,c2,black,
  1127.   'and edit the input. Thats why we developed the IOTTT5 unit.');
  1128.   WriteAT(3,8,c2,black,
  1129.   'These IO procedures allow you to display input fields with format controls');
  1130.   WriteAT(3,9,c2,black,
  1131.   'e.g. all capitals or only numbers. There are many features to the Kit. The');
  1132.   WriteAT(3,10,c2,black,
  1133.   'example below illustrates some of the power of this easy to use Kit.');
  1134.   end;
  1135.  
  1136.   Procedure IO_Example;
  1137.   var
  1138.   s1,s2,s3,s4,s5,s6:string;
  1139.   retcode : integer;
  1140.   begin
  1141.   Box(3,13,78,25,white,black,1);
  1142.   Horizline(4,77,15,white,black,1);
  1143.   Textcolor(white);
  1144.   GotoXY(3,15);write(chr(195));
  1145.   GotoXY(78,15);write(chr(180));
  1146.   Textcolor(lightred);
  1147.   GotoXY(20,14);write(chr(004));
  1148.   GotoXY(57,14);write(chr(004));
  1149.   GotoXY(22,14);write(chr(004));
  1150.   GotoXY(59,14);write(chr(004));
  1151.   Textcolor(yellow);
  1152.   GotoXY(21,14);write(chr(004));
  1153.   GotoXY(58,14);write(chr(004));
  1154.   Offcursor;
  1155.   WriteCenter(14,Lightgray,black,'Technojock''s Inventory Control');
  1156.   WriteAt(22,17,white,black,'Catalogue/Part Number');
  1157.   WriteAT(10,19,white,black,'Description');
  1158.   WriteAT(10,21,white,black,'Quantity');
  1159.   WriteAT(50,21,white,black,'Units');
  1160.   WriteAT(10,23,white,black,'Shelf');
  1161.   WriteAT(50,23,white,black,'Bin No.');
  1162.   WriteAT(66,16,white,black,'F1 for HELP');
  1163.   WriteAT(6,16,white,black,'F10 for EXIT');
  1164.   S1 := '';
  1165.   S2 := '';
  1166.   S3 := '';
  1167.   S4 := '';
  1168.   S5 := '';
  1169.   S6 := '0001';
  1170.   Create_fields(6);
  1171.   Allow_Beep(false);
  1172.   Allow_Esc(true);
  1173.   Assign_CharHook(Help_Editkeys);
  1174.   Add_Field(1,   6,2,6,2,    45,17);
  1175.   String_Field(1,  S1,'(####-###)/ ##');
  1176.   Add_Field(2,   1,3,1,3,    23,19);
  1177.   String_Field(2,  S2,replicate(50,'*'));
  1178.   Add_field(3,   2,4,2,4,    23,21);
  1179.   String_Field(3,  S3,'#####');
  1180.   Add_Field(4,   3,5,3,5,    60,21);
  1181.   String_Field(4,  S4,'!!!!!!!!!!!!!');
  1182.   Add_Field(5,   4,6,4,6,    23,23);
  1183.   String_Field(5,  S5,'@@ / @');
  1184.   Add_Field(6,   5,1,5,1,    60,23);
  1185.   String_Field(6,  S6,'####');
  1186.   Add_Message(1,   13,25, 'Enter the TTT catalogue number (letters not accepted)');
  1187.   Add_Message(2,   15,25, 'Enter the item description from the Purchase Order');
  1188.   Add_Message(4,   25,25, '(note: Units converted to capitals)');
  1189.   Add_Message(5,   20,25, 'Only letters and punctuation chars allowed');
  1190.   Add_Message(6,   20,25, 'Check details and press F10 to update');
  1191.   OnCursor;
  1192.   Process_Input(1);
  1193.   OffCursor;
  1194.   Dispose_Fields;
  1195.   end;
  1196.  
  1197. begin
  1198. SaveScreen(1);
  1199. Display_Text;
  1200. IO_Example;
  1201. RestoreScreen(1);
  1202. DisposeScreen(1);
  1203. end;
  1204. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  1205. {                              O P T I O N      6                             }
  1206. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  1207. Procedure Explain_Dir;
  1208.  
  1209. Var
  1210.  StartPath, Path, Mask, Chosen_File : string;
  1211.  Ch : char;
  1212.  C1,C2,C3 : byte;
  1213.  Retcode : integer;
  1214. begin
  1215.     If ColorScreen then
  1216.     begin
  1217.         C1 := Yellow;
  1218.         C2 := lightgray;
  1219.         C3 := blue;
  1220.     end
  1221.     else
  1222.     begin
  1223.         C1 := white;
  1224.         C2 := black;
  1225.         C3 := lightgray;
  1226.     end;
  1227.     SaveScreen(1);
  1228.     ClrScr;
  1229.     FBox(1,15,80,25,C1,c3,2);
  1230.     WriteCenter(16,C1,C3,'The DirTTT Unit');
  1231.     WriteAT(5,17,c2,c3,
  1232.     ' The DirTTT5 unit provides a single procedure for displaying a directory');
  1233.     WriteAT(5,18,c2,c3,
  1234.     ' in a Sidekick Plus style dialogue box. The look and feel of the display');
  1235.     WriteAT(5,19,c2,c3,
  1236.     ' can be easily modified by changing the parameters in the DTTT variable.');
  1237.     WriteAT(5,21,c2,c3,
  1238.     ' Experiment with the directory listing above. Press F1 for Help. Use the');
  1239.     WriteAT(5,22,c2,c3,
  1240.     ' space bar to toggle the column display, Alt-N, Alt-D, etc. to change ');
  1241.     WriteAT(5,23,c2,c3,
  1242.     ' sorts, Alt-Z to expand the box, or just type in a new filename or file');
  1243.     WriteAT(5,24,c2,c3,' mask. Try It!');
  1244.  
  1245.     GetDir(0,StartPath);
  1246.     Path := StartPath;
  1247.     Mask := '*.*';
  1248.     With DTTT do
  1249.     begin
  1250.         ColsWide := 5;
  1251.         Rows := 8;
  1252.         TopY := 1;
  1253.         AllowEsc := false;
  1254.     end;
  1255.     Chosen_File := Display_Directory(Path+'\'+Mask,retcode);
  1256.     GotoXy(1,1);
  1257.     If retcode = 1 then
  1258.         Write('You escaped')
  1259.     else
  1260.         Write('You selected file ',Chosen_File);
  1261.    Write('   Press any key to return to the menu');
  1262.    {$I-}
  1263.    ChDir(StartPath);
  1264.    {$I+}
  1265.    Ch := Getkey;
  1266.    RestoreScreen(1);
  1267.    DisposeScreen(1);
  1268. end;
  1269.  
  1270. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  1271. {                              O P T I O N      7                             }
  1272. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  1273. Procedure Printout;
  1274. begin
  1275. Mkwin(10,8,70,18,white,red,1);
  1276. Offcursor;
  1277. WriteAT(15,10,white,red,'The documentation is compressed in a file Manual.exe.');
  1278. WriteAT(15,11,white,red,'Execute this file and the file Manual.TTT will self  ');
  1279. WriteAT(15,12,white,red,'extract. The manual contains no formatting chars, &');
  1280. WriteAT(15,13,white,red,'is 80 characters wide by 66 lines per page.');
  1281. WriteAT(15,15,white,red,'At the DOS prompt type Print Manual.TTT. Be warned');
  1282. WriteAT(15,16,white,red,'the documentation is good but it''s more than 100 pages.');
  1283. WriteAT(50,18,white,red,' press any key .... ');
  1284. Ch := getkey;
  1285. Rmwin;
  1286. end;
  1287. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  1288. {                              O P T I O N      8                             }
  1289. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  1290. Procedure Unit_Summary;
  1291. const
  1292. X1 = 40;
  1293. Y1 = 5;
  1294. X2 = 80;
  1295. Y2 = 25;
  1296. var
  1297. C1,C2,C3,C4 : byte;
  1298. begin
  1299.     If ColorScreen  then
  1300.     begin
  1301.         C1 := white;
  1302.         C2 := lightgray;
  1303.         C3 := yellow;
  1304.         C4 := blue;
  1305.     end
  1306.     else
  1307.     begin
  1308.         C1 := white;
  1309.         C2 := black;
  1310.         C3 := white;
  1311.         C4 := lightgray;
  1312.     end;
  1313.     SaveScreen(1);
  1314.     Fbox(1,1,80,24,C1,C4,1);
  1315.     WriteCenter(2,C3,C4,'A Summary of the Toolkit Units');
  1316.     WriteAt(3,4,c1,c4,
  1317.     'There are twelve major units included in the Toolkit. This demonstration');
  1318.     WriteAt(3,5,c1,c4,
  1319.     'program has only illustrated a few of the features and capabilities of the');
  1320.     WriteAt(3,6,c1,c4,
  1321.     'Toolkit. The READTTT5, STRNTTT5 and MISCTTT5 units were not even mentioned!');
  1322.     WriteAt(3,7,c1,c4,
  1323.     'The demo disk includes many smaller programs to illustrate Toolkit ');
  1324.     WriteAt(3,8,c1,c4,
  1325.     'programming techniques. By way of a summary, the Toolkit units are:');
  1326.  
  1327.     WriteAT(3,10,c3,c4,'FastTTT5 ');
  1328.     WriteAT(12,10,c2,c4,'Ultra fast Screen writing routines including box drawing');
  1329.     WriteAT(3,11,c3,c4,'WinTTT5 ');
  1330.     WriteAT(12,11,c2,c4,'Windowing routines together with screen moves, copies & saves');
  1331.     WriteAT(3,12,c3,c4,'MenuTTT5 ');
  1332.     WriteAT(12,12,c2,c4,'Advanced, but easy to use, menu unit with auto-centering etc.');
  1333.     WriteAT(3,13,c3,c4,'KeyTTT5 ');
  1334.     WriteAT(12,13,c2,c4,'Full keyboard control and a host of mouse related procedures');
  1335.     WriteAT(3,14,c3,c4,'IOTTT5 ');
  1336.     WriteAT(12,14,c2,c4,'Form or full screen input procedues, with control of input');
  1337.     WriteAT(3,15,c3,c4,'StrnTTT5');
  1338.     WriteAT(12,15,c2,c4,'Suite of fast string handling procs, including word manipulation');
  1339.     WriteAT(3,16,c3,c4,'PullTTT5');
  1340.     WriteAT(12,16,c2,c4,'Easy to use procedure for displaying Pull down menus');
  1341.     WriteAT(3,17,c3,c4,'DirTTT5');
  1342.     WriteAT(12,17,c2,c4,'Sidekick Plus style directory listing procedures with sorting');
  1343.     WriteAT(3,18,c3,c4,'ReadTTT5');
  1344.     WriteAT(12,18,c2,c4,'Single line input control providing user with full editing');
  1345.     WriteAT(3,19,c3,c4,'NestTTT5');
  1346.     WriteAT(12,19,c2,c4,'A Sprint style nested menu system');
  1347.     WriteAT(3,20,c3,c4,'ListTTT5');
  1348.     WriteAT(12,20,c2,c4,'A generic list routine to list any string array in a window');
  1349.     WriteAT(3,21,c3,c4,'MiscTTT5');
  1350.     WriteAT(12,21,c2,c4,'A pot pourri of miscellaneous procedures and functions');
  1351.     WriteAT(50,23,c2,c4,'Press any key to continue....');
  1352.     Offcursor;
  1353.     Ch := getkey;
  1354.     SlideRestoreScreen(1,Up);
  1355.     DisposeScreen(1);
  1356. end;
  1357.  
  1358. Procedure Initialise;
  1359. var X,Y : byte;
  1360.  
  1361.       Procedure Sparkle;
  1362.       {}
  1363.       var tempX,tempC:byte;
  1364.           I : integer;
  1365.       begin
  1366.           Delay(1000);
  1367.           For I := 8 to 13 do
  1368.           begin
  1369.               If keypressed then exit;
  1370.               Attrib(5,I,78,I,yellow,black);
  1371.               Delay(75);
  1372.           end;
  1373.           Delay(500);
  1374.           For I := 15 to 17 do
  1375.           begin
  1376.               If keypressed then exit;
  1377.               Attrib(5,I,78,I,lightgreen,black);
  1378.               Delay(75);
  1379.           end;
  1380.           For I := 1 to 80 do
  1381.           begin
  1382.               If keypressed then exit;
  1383.               Attrib(I,20,I,20,lightcyan,black);
  1384.               Delay(15);
  1385.           end;
  1386.           Repeat
  1387.                tempX := Random(26);
  1388.                TempC := Random(6);
  1389.                Inc(TempC,9);
  1390.                Attrib(27+tempX,2,27+tempX,2,TempC,black);
  1391.                TempX := Random(40);
  1392.                Attrib(20+tempX,20,20+tempX,20,TempC,black);
  1393.                Delay(50);
  1394.           Until keypressed;
  1395.       end; {of proc Sparkle}
  1396.  
  1397. begin
  1398.     CreateScreen(2,25);
  1399.     Activate_Virtual_Screen(2);
  1400.     Box(25,1,55,4,white,black,1);
  1401.     WriteBetween(25,55,2,lightgray,black,'TechnoJock''s Turbo Toolkit');
  1402.     WriteBetween(25,55,3,lightgray,black,'v5.00');
  1403.     WriteAT(5,8,white,black,'This program demonstrates the power of TechnoJock''s Turbo Toolkit for');
  1404.     WriteAT(5,9,white,black,'Borland''s Turbo Pascal v4.0 and v5.0 (on IBM and true compatibles).');
  1405.     WriteAT(5,10,white,black,'The Toolkit is a professional ShareWare product, and if you use the');
  1406.     WriteAt(5,11,white,black,'Toolkit, you must register it. Included in the source code is a file');
  1407.     WriteAt(5,12,white,black,'Register.doc. Print this file and submit it together with a registration');
  1408.     WriteAt(5,13,white,black,'fee of $49.95 + shipping and handling to:');
  1409.     WriteAt(30,15,white,black,'TechnoJock Software, Inc.');
  1410.     WriteAt(30,16,white,black,'P.O. Box 820927');
  1411.     WriteAT(30,17,white,black,'Houston, TX 77282');
  1412.     
  1413.     WriteCenter(23,white,black,'Copyright (C) 1986, 1989 TechnoJock Software, Inc.');
  1414.     WriteCenter(24,white,black,'All Rights Reserved');
  1415.  
  1416.     Activate_Visible_Screen;
  1417.     SlideRestoreSCreen(2,Down);
  1418.     WriteAT(55,25,lightgray,black,'Press any key to continue');
  1419.     If not keypressed then
  1420.        ClickWrite(20,20,white,black,'"In the Software business since Tuesday"');
  1421.     If ColorScreen then
  1422.        Sparkle;
  1423.     Ch := getkey;
  1424.     Clrscr;
  1425.     FillScreen(1,1,80,24,white,black,chr(176));
  1426.     Findcursor(X,Y,ScanTop,ScanBot);
  1427.     OffCursor;
  1428.     WriteCenter(25,lightgray,black,'TechnoJock''s Turbo Toolkit v5.00 ');
  1429.     Main_Choice := 1;
  1430.     Define_Menu1;
  1431.     Define_menu_Menu;
  1432. end;
  1433.  
  1434.  Procedure Menu_System;
  1435.  {}
  1436.  var
  1437.    Pick : integer;
  1438.    Error : integer;
  1439.  begin
  1440.      SaveScreen(9);
  1441.      Attrib(1,1,80,25,lightgray,black);
  1442.      Pick := 1;
  1443.      Repeat
  1444.           DisplayMenu(MM,false,Pick,Error);
  1445.           If Error = 0 then
  1446.              Case Pick of
  1447.              1 :Menu_Intro;
  1448.              2 :Explain_Menu;
  1449.              3 :PullDemo;
  1450.              4 :NestTTT5_Demo_1;
  1451.              5 :Show_The_Girlfriends;
  1452.              end;
  1453.      Until (Pick = MM.TotalPicks) or (Error <> 0);   
  1454.      RestoreScreen(9);
  1455.      DisposeScreen(9);
  1456.  end; {of proc MenuSystem}
  1457.  
  1458.  
  1459. Procedure Finish;
  1460. begin
  1461.  ClrScr;
  1462.  Reset_StartUp_Mode;
  1463.  writeln('TechnoJock''s Turbo Toolkit v5.0');
  1464.  writeln('Copyright (c) 1986, 1989 TechnoJock Software, Inc.');
  1465.  Halt;
  1466. end;
  1467.  
  1468. begin     {main program}
  1469. Initialise;
  1470. repeat
  1471.      DisplayMenu(M1,false,Main_choice,Error);
  1472.      Case Main_Choice of
  1473.      1 :Toolkit_Explained;
  1474.      2 :Explain_Fastwrite;
  1475.      3 :Explain_Windows;
  1476.      4 :Menu_System;
  1477.      5 :Explain_IO;
  1478.      6 :Explain_Dir;
  1479.      7 :PrintOut;
  1480.      8 :Unit_Summary;
  1481.      9 :Finish;
  1482.      end;  {case}
  1483. until true = false;  {a very very very long time !}
  1484. end.
  1485.  
  1486.