home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TTT405.ZIP / TTTDEMOS.EXE / DEMOTTT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-07-17  |  37.7 KB  |  982 lines
  1. Program Illustrating_the_Toolkit;
  2. {TTT 4.05}
  3. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  4. {        This is the main demonstration program in Technojocks Turbo         }
  5. {        Toolkit. The compiled version is in DemoTTT.Exe.                    }
  6. {                                                                            }
  7. {                   Copyright R D Ainsbury (c) 1986-88                       }
  8. {                                                                            }
  9. {                "In the software business since Tuesday"                    }
  10. {                                                                            }
  11. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  12. Uses CRT, FastTTT, DOS, WinTTT, KeyTTT,
  13.      MenuTTT, IOTTT, PullTTT, DirTTT, MiscTTT;
  14. var
  15.    Main_Choice,Choice,Error : integer;
  16.    ScanTop, ScanBot : byte;
  17.    M1 : Menu_record;
  18.    Ch : char;
  19. Const
  20.    Author = 'Bob Ainsbury, Technojock';
  21.  
  22. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  23. {          T H E     M A I N    M E N U    P R O C E D U R E S                }
  24. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  25. Procedure Define_Menu1;
  26. begin
  27.     With M1 do
  28.     begin
  29.         Heading1 := 'TechnoJocks Turbo Toolkit';
  30.         Heading2 := 'Main Menu';
  31.         Topic[1] := '   The Toolkit explained';
  32.         Topic[2] := '   FastTTT Unit';
  33.         Topic[3] := '   WinTTT Unit';
  34.         Topic[4] := '   Menu Procedures';
  35.         Topic[5] := '   IOTTT Unit';
  36.         Topic[6] := '   DirTTT Unit';
  37.         Topic[7] := '   Print documentation';
  38.         Topic[8] := '   Toolkit Unit Summary';
  39.         Topic[9] := '   Quit to DOS';
  40.         TotalPicks := 9;
  41.         PicksPerLine := 1;            {one column of choices}
  42.         Addprefix := 3;               {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 BaseOfScreen = $B800 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. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  68. {                              O P T I O N      1                             }
  69. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  70. Procedure Toolkit_Explained;
  71. const
  72. X1 = 1;
  73. Y1 = 1;
  74. X2 = 80;
  75. Y2 = 24;
  76. var
  77. C1,C2,C3 : byte;
  78. begin
  79.     If BaseOfScreen = $B800 then
  80.     begin
  81.         C1 := Lightgreen;
  82.         C2 := black;
  83.         C3 := yellow;
  84.     end
  85.     else
  86.     begin
  87.         C1 := white;
  88.         C2 := black;
  89.         C3 := white;
  90.     end;
  91.     Savescreen(1);
  92.     FBox(X1,Y1,X2,Y2,C1,C2,4);
  93.     OffCursor;
  94.     WriteCenter(Y1,C1,C2,' THE TOOLKIT EXPLAINED ');
  95.     WriteAT(X1+3,Y1+2,C3,C2,
  96.     'TechnoJocks Turbo Toolkit is a collection of procedures and functions');
  97.     WriteAT(X1+3,Y1+3,C3,C2,
  98.     'for Turbo Pascal programmers. It will reduce the time taken to write');
  99.     WriteAT(X1+3,Y1+4,C3,C2,
  100.     'applications and is designed for novice and expert programmer alike.');
  101.     WriteAT(X1+3,Y1+6,C3,C2,
  102.     'The real purpose of the Toolkit is to provide easy-to-implement procedures');
  103.     WriteAT(X1+3,Y1+7,C3,C2,
  104.     'that free the programmer from the more tedious and repetitive programming');
  105.     WriteAT(X1+3,Y1+8,C3,C2,
  106.     'chores, such as windows, menus, user input, string formatting, directory');
  107.     WriteAT(X1+3,Y1+9,C3,C2,
  108.     'listings, mouse support etc.');
  109.     WriteAT(X1+3,Y1+11,C3,C2,
  110.    'The Toolkit is being used by many programmers and corporations throughout');
  111.    WriteAT(X1+3,Y1+12,C3,C2,
  112.    'the world. There are TechnoJock Turboholics in Norway, U.K., Japan, Africa');
  113.    WriteAT(X1+3,Y1+13,C3,C2,
  114.    'and all over the USA. Bob is a member of the Association of ShareWare');
  115.    WriteAT(X1+3,Y1+14,C3,C2,
  116.    'Professionals.');
  117.    WriteAT(X1+3,Y1+16,C3,C2,
  118.    'If you use the Toolkit please register your copy and support it''s further');
  119.    WriteAT(X1+3,Y1+17,C3,C2,
  120.    'development. Full registration is $29.95 and this includes 150 page typeset');
  121.       WriteAT(X1+3,Y1+18,C3,C2,
  122.    'Manual - full time students may register for $9.95');
  123.  
  124. WriteAT(X1+17,Y1+20,C1,C2,
  125.    'Enjoy.....');
  126.    WriteAT(X1+28,Y1+22,white,C2,
  127.    'Bob Ainsbury, TechnoJock, Houston.');
  128.    WriteAT(X2-20,Y2,C1,C2,' press any key ... ');
  129.    Ch := GetKey;
  130.    RestoreScreen(1);
  131.    DisposeScreen(1);
  132. end;
  133.  
  134. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  135. {                              O P T I O N      2                             }
  136. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  137. Procedure Explain_Fastwrite;
  138. const
  139. X1 = 1;
  140. Y1 = 1;
  141. X2 = 80;
  142. Y2 = 25;
  143. C1 = white;
  144. C2 = yellow;
  145. C3 = black;
  146. Max_Picks = 14;
  147.  
  148.       Procedure MainText;
  149.       begin
  150.       Box(X1,Y1,X2,Y2,C2,C3,1);
  151.       Horizline(3,77,19,red,black,1);
  152.       WriteCenter(Y1+1,C2,C3,'FastTTT Unit');
  153.       WriteAT(X1+5,Y1+3,C1,C3,
  154.       'The FastTTT unit contains a host of procedures for updating the');
  155.       WriteAT(X1+5,Y1+4,C1,C3,
  156.       'screen, at speeds exceeding an Izuzu.');
  157.       WriteAT(X1+5,Y1+6,C1,C3,
  158.       'The latest version of Turbo Pascal has some significantly improved');
  159.       WriteAT(X1+5,Y1+7,C1,C3,
  160.       'screen writing procedures. But the FastTTT unit is much faster still,');
  161.       WriteAT(X1+5,Y1+8,C1,C3,
  162.       'especially on systems that are prone to snow.');
  163.       WriteAT(X1+5,Y1+10,C1,C3,
  164.       'The procedures are designed to work on IBM systems and 100% compatibles.');
  165.       WriteAT(X1+5,Y1+11,C1,C3,
  166.       'Listed below are some of the main Fastwrit procedures, move the cursor');
  167.       WriteAT(X1+5,Y1+12,C1,C3,
  168.       'to see a fuller description. Press [End] or [Esc] to return to the menu.');
  169.       end;  {sub proc Main_text}
  170.  
  171.       Procedure WriteOption(Pick,F,B:integer);
  172.       const
  173.       Lineone = 15;
  174.       LeftTab = 6;
  175.       Tab = 18;
  176.       begin
  177.       Case Pick of
  178.       1 : WriteAT(LeftTab,Lineone,F,B,             '    Box          ');
  179.       2 : WriteAT(LeftTab+Tab,Lineone,F,B,         '    HorizLine    ');
  180.       3 : WriteAT(LeftTab+2*Tab,LineOne,F,B,       '    VertLine     ');
  181.       4 : WriteAT(LeftTab+3*Tab,LineOne,F,B,       '    WriteAT      ');
  182.       5 : WriteAT(LeftTab,LineOne+1,F,B,           '    ClearText    ');
  183.       6 : WriteAT(LeftTab+Tab,LineOne+1,F,B,       '    WriteCenter  ');
  184.       7 : WriteAT(LeftTab+2*Tab,LineOne+1,F,B,     '    WriteBetween ');
  185.       8 : WriteAT(LeftTab+3*Tab,LineOne+1,F,B,     '    WriteVert    ');
  186.       9 : WriteAT(LeftTab,Lineone+2,F,B,           '    FBox         ');
  187.       10: WriteAt(LeftTab+tab,LineOne+2,F,B,       '    GrowFBox     ');
  188.       11: WriteAt(LeftTab+2*tab,LineOne+2,F,B,     '    ClearLine    ');
  189.       12: WriteAt(LeftTab+3*Tab,LineOne+2,F,B,     '    Attr         ');
  190.       13: WriteAT(LeftTab,Lineone+3,F,B,           '    FastWrite    ');
  191.       14: WriteAt(LeftTab+tab,LineOne+3,F,B,       '    PlainWrite   ');
  192.       end; {case}
  193.       end; {WriteOption}
  194.  
  195.       Procedure Hilite(Pick:integer);
  196.       begin
  197.       WriteOption(Pick,White,red);
  198.       end;   {HiLite}
  199.  
  200.       Procedure LoLite(Pick:integer);
  201.       begin
  202.       WriteOption(Pick,Lightgray,C3);
  203.       end;   {LoLite}
  204.  
  205.       Procedure DisplayDescription(Pick : integer);
  206.       const
  207.       X = 7;
  208.       Y = 20;
  209.       C = yellow;
  210.       begin
  211.       case Pick of
  212.       1 : begin
  213.            WriteAT(X,Y,C,black,  'Syntax :  Box(X1,Y1,X2,Y2,F,B,boxtype : integer);                   ');
  214.            WriteAT(X,Y+2,C,black,'Purpose : Draws a rectangular box on the screen in foreground color ');
  215.            WriteAT(X,Y+3,C,black,'          F and background color B. The boxtype indicates what line ');
  216.            WriteAT(X,Y+4,C,black,'          type to use i.e. single, double or combined.              ');
  217.           end;
  218.       2 : begin
  219.            WriteAT(X,Y,C,black,  'Syntax :  HorizLine(X1,X2,Y,F,B,LineType:integer);                  ');
  220.            WriteAT(X,Y+2,C,black,'Purpose : Draws a horizontal line on the screen in foreground color ');
  221.            WriteAT(X,Y+3,C,black,'          F and background color B. The linetype indicates what line');
  222.            WriteAT(X,Y+4,C,black,'          type to use i.e. single or double.                        ');
  223.           end;
  224.       3 : begin
  225.            WriteAT(X,Y,C,black,  'Syntax :  VertLine(X,Y1,Y2,F,B,LineType:integer);                   ');
  226.            WriteAT(X,Y+2,C,black,'Purpose : Draws a vertical line on the screen in foreground color F ');
  227.            WriteAT(X,Y+3,C,black,'          and background color B. The linetype indicates what line  ');
  228.            WriteAT(X,Y+4,C,black,'          type to use i.e. single or double.                        ');
  229.           end;
  230.       4 : begin
  231.            WriteAT(X,Y,C,black,  'Syntax :  WriteAT(X,Y,F,B:integer;ST:string80);                     ');
  232.            WriteAT(X,Y+2,C,black,'Purpose : Writes the string St very quickly on the screen starting  ');
  233.            WriteAT(X,Y+3,C,black,'          at (X,Y) in foreground color F and background color B. The');
  234.            WriteAT(X,Y+4,C,black,'          string may be concatenated e.g. ''Techno''+''Jock''.          ');
  235.           end;
  236.       5 : begin
  237.            WriteAT(X,Y,C,black,  'Syntax :  ClearText(X1,Y1,X2,Y2,F,B:integer);                       ');
  238.            WriteAT(X,Y+2,C,black,'Purpose : Clears the characters for a rectangular area on the screen');
  239.            WriteAT(X,Y+3,C,black,'          and displays background color B. The attribute for the    ');
  240.            WriteAT(X,Y+4,C,black,'          foreground is set to F. Unaffected by Window setting.     ');
  241.           end;
  242.       6 : begin
  243.            WriteAT(X,Y,C,black,  'Syntax :  WriteCenter(Lineno,F,B:integer;ST:string80);              ');
  244.            WriteAT(X,Y+2,C,black,'Purpose : Writes the string ST very quickly on the screen in the    ');
  245.            WriteAT(X,Y+3,C,black,'          center of line Lineno in foreground color F and back-     ');
  246.            WriteAT(X,Y+4,C,black,'          ground color B. The string may be concatenated.           ');
  247.           end;
  248.       7 : begin
  249.            WriteAT(X,Y,C,black,  'Syntax :  WriteBetween(X1,X2,Y,F,B:integer;ST:string80);            ');
  250.            WriteAT(X,Y+2,C,black,'Purpose : Writes the string ST very quickly on the screen centered  ');
  251.            WriteAT(X,Y+3,C,black,'          between X1 and X2 on line Y, in foreground F and back-    ');
  252.            WriteAT(X,Y+4,C,black,'          ground color B. The string may be concatenated.           ');
  253.           end;
  254.       8 : begin
  255.            WriteAT(X,Y,C,black,  'Syntax :  WriteVert(X,Y,F,B;ST:string80);                           ');
  256.            WriteAT(X,Y+2,C,black,'Purpose : Writes the string ST vertically on the screen starting at ');
  257.            WriteAT(X,Y+3,C,black,'          coordinate (X,Y) and continuing down the screen, in fore- ');
  258.            WriteAT(X,Y+4,C,black,'          ground color F and background color B.                    ');
  259.           end;
  260.       9 : begin
  261.            WriteAT(X,Y,C,black,  'Syntax :  FBox(X1,Y1,X2,Y2,F,B,Boxtype:Integer);                 ');
  262.            WriteAT(X,Y+2,C,black,'Purpose : Draws a rectangular box on the screen in foreground color');
  263.            WriteAT(X,Y+3,C,black,'          F and background color B. The boxtype indicates the line');
  264.            WriteAT(X,Y+4,C,black,'          style. This is similar to Box except the box is cleared.');
  265.           end;
  266.       10: begin
  267.            WriteAT(X,Y,C,black,  'Syntax :  GrowFBox(X1,Y1,X2,Y2,F,B,Boxtype:Integer);             ');
  268.            WriteAT(X,Y+2,C,black,'Purpose : Draws a rectangular box on the screen in foreground color');
  269.            WriteAT(X,Y+3,C,black,'          F and background color B. The boxtype indicates the line');
  270.            WriteAT(X,Y+4,C,black,'          style. This is similar to FBox except the box explodes.');
  271.           end;
  272.       11: begin
  273.            WriteAT(X,Y,C,black,  'Syntax :  ClearLine(Y,F,B:integer);                               ');
  274.            WriteAT(X,Y+2,C,black,'Purpose : All text on screen line Y is cleared. The actual display  ');
  275.            WriteAT(X,Y+3,C,black,'          color of the line will be set to B.                       ');
  276.            WriteAT(X,Y+4,C,black,'                                                                    ');
  277.           end;
  278.       12: begin
  279.            WriteAT(X,Y,C,black,  'Syntax :  Attr(F,B):byte;                                           ');
  280.            WriteAT(X,Y+2,C,black,'Purpose : Combines the foreground color F with the background       ');
  281.            WriteAT(X,Y+3,C,black,'          color B and returns the resulting attribute byte.         ');
  282.            WriteAT(X,Y+4,C,black,'                                                                    ');
  283.           end;
  284.       13: begin
  285.            WriteAT(X,Y,C,black,  'Syntax :  Fastwrite(X,Y,F,B : byte; Str : string);                  ');
  286.            WriteAT(X,Y+2,C,black,'Purpose : This is the core procedure used by the others in the      ');
  287.            WriteAT(X,Y+3,C,black,'          Toolkit. String Str is wriiten on the screen in foreground');
  288.            WriteAT(X,Y+4,C,black,'          F & background B at location (X,Y) el quicko.             ');
  289.           end;
  290.       14: begin
  291.            WriteAT(X,Y,C,black,  'Syntax :  PlainWrite(X,Y:byte; Str: string);                        ');
  292.            WriteAT(X,Y+2,C,black,'Purpose : This is even quicker than FastWrite but it uses the       ');
  293.            WriteAT(X,Y+3,C,black,'          default color attibute already assigned.                  ');
  294.            WriteAT(X,Y+4,C,black,'                                                                    ');
  295.           end;
  296.       end; {case}
  297.       end; {DisplayDescription}
  298.  
  299.       Procedure Keystroke;
  300.       const
  301.           CursorUp = #200;
  302.           CursorDown = #208;
  303.           CursorLeft = #203;
  304.           CursorRight = #205;
  305.           EndKey = #207;
  306.       var
  307.       Allover : boolean;
  308.       I,CurrentPick : integer;
  309.       begin
  310.           Allover := false;
  311.           CurrentPick := 1;
  312.           For I := 1 to Max_Picks do
  313.               LoLite(I);
  314.           HiLite(CurrentPick);
  315.           Repeat
  316.               Ch := getkey;
  317.               Case upcase(Ch) of
  318.               CursorUp :      If CurrentPick > 4 then
  319.                               begin
  320.                                   LoLite(CurrentPick);
  321.                                   CurrentPick := CurrentPick - 4;
  322.                                   HiLite(CurrentPick);
  323.                               end;
  324.               CursorDown :    If CurrentPick <= Max_Picks - 4 then
  325.                               begin
  326.                                   LoLite(CurrentPick);
  327.                                   CurrentPick := CurrentPick + 4;
  328.                                   HiLite(CurrentPick);
  329.                               end;
  330.              ' ',
  331.              CursorRight :   begin
  332.                                  LoLite(CurrentPick);
  333.                                  If CurrentPick < Max_Picks then
  334.                                      CurrentPick := CurrentPick + 1
  335.                                  else
  336.                                      CurrentPick := 1;
  337.                                  HiLite(CurrentPick);
  338.                              end;
  339.             CursorLeft :    begin
  340.                                 LoLite(CurrentPick);
  341.                                 If CurrentPick > 1 then
  342.                                    CurrentPick := CurrentPick - 1
  343.                                 else
  344.                                    CurrentPick := Max_Picks;
  345.                                 HiLite(CurrentPick);
  346.                             end;
  347.             #027,
  348.             EndKey :        Allover := true;
  349.             end; {case}
  350.             DisplayDescription(CurrentPick);
  351.       Until Allover;
  352.       end;  {Keystroke}
  353.  
  354.  
  355. begin       {Explain_Fastwrite}
  356.     SaveScreen(1);
  357.     Clrscr;
  358.     OffCursor;
  359.     MainText;
  360.     DisplayDescription(1);
  361.     Keystroke;
  362.     RestoreScreen(1);
  363.     DisposeScreen(1);
  364. end;  {proc Explain_Fastwrite}
  365.  
  366. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  367. {                              O P T I O N      3                             }
  368. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  369. Procedure Explain_Windows;
  370. var
  371.    I : integer;
  372.    c1,c2,c3,c4,c5,c6: byte;
  373.  
  374. begin
  375.     If BaseOfScreen = $B800 then
  376.     begin
  377.         C1 := yellow;
  378.         C2 := green;
  379.         C3 := white;
  380.         C4 := white;
  381.         C5 := red;
  382.         C6 := magenta;
  383.     end
  384.     else
  385.     begin
  386.         C1 := black;
  387.         C2 := lightgray;
  388.         C3 := white;
  389.         C4 := white;
  390.         C5 := black;
  391.         C6 := black;
  392.     end;
  393.     Savescreen(1);
  394.     OffCursor;
  395.     ClrScr;
  396.     MkWin(1,1,35,14,c1,c2,2);
  397.     WriteBetween(1,35,2,C1,c2,'Window.TTT');
  398.     WriteAt(3,4,c3,c2,'The Window procedures provide');
  399.     WriteAT(3,5,c3,c2,'tools for easily writing flash');
  400.     WriteAT(3,6,c3,c2,'up window routines. ');
  401.     WriteAT(3,8,c3,c2,'They also include procedures');
  402.     WriteAT(3,9,c3,c2,'for saving and restoring screen');
  403.     WriteAT(3,10,c3,c2,'images.');
  404.     WriteAT(3,13,c3,c2,'... press any key.');
  405.     DelayKey(4000);
  406.     Mkwin(34,7,66,20,c4,c5,3);
  407.     WriteAT(36,9,c4,c5, 'The windows can be placed any');
  408.     WriteAT(36,10,c4,c5,'where on the screen and both');
  409.     WriteAT(36,11,c4,c5,'the border style and colors ');
  410.     WriteAT(36,12,c4,c5,'can be easily altered.');
  411.     DelayKey(3000);
  412.     Mkwin(20,13,68,25,c4,c6,1);
  413.     WriteAT(22,15,c4,c6,'The WinTTT unit includes a host of Windowing ');
  414.     WriteAT(22,16,c4,c6,'procedures, and a collection of fancy screen ');
  415.     WriteAT(22,17,c4,c6,'restoring and sliding procedures.            ');
  416.     WriteAT(22,19,c4,c6,'There are three smaller demo programs on the ');
  417.     WriteAT(22,20,c4,c6,'distribution disk that further illustrate the');
  418.     WriteAT(22,21,c4,c6,'power of this unit: WinDem, ScrnDem & SaveDem');
  419.     WriteAT(22,22,c4,c6,'.pas.                                       ');
  420.     WriteAT(22,24,c4,c6,'Press any key to see some screen manipulation');
  421.     Ch := getkey;
  422.     Rmwin;
  423.     Delay(300);
  424.     Rmwin;
  425.     Delay(300);
  426.     Rmwin;
  427.     Delay(300);
  428.     Rmwin;
  429.     SlideRestoreScreen(1,left);
  430.     SlideRestoreScreen(1,up);
  431.     SlideRestoreScreen(1,right);
  432.     DisposeScreen(1);
  433. end;
  434.  
  435. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  436. {                              O P T I O N      4                             }
  437. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  438. Procedure PullDemo;
  439. var
  440. TheMenu : MenuDesc;   {Array holding the menu definitions}
  441.  
  442.        Procedure Define_Demo_Menu;
  443.        begin
  444.            Fillchar(Themenu,sizeof(Themenu),#0);
  445.            TheMenu[1] := '\File';      {menu definition for pull down menu}
  446.            TheMenu[2] := 'Load        ';
  447.            TheMenu[3] := 'New         ';
  448.            TheMenu[4] := 'Save        ';
  449.            TheMenu[5] := 'Write to    ';
  450.            TheMenu[6] := 'Directory   ';
  451.            TheMenu[7] := 'Change dir  ';
  452.            TheMenu[8] := 'OS shell    ';
  453.            TheMenu[9] := 'Quit        ';
  454.  
  455.            TheMenu[10] :=  '\Edit ';
  456.  
  457.            TheMenu[11] :=  '\Run ';
  458.  
  459.            TheMenu[12] := '\Compile     ';
  460.            TheMenu[13] := 'Make         ';
  461.            TheMenu[14] := 'Build        ';
  462.            TheMenu[15] := 'Destination  ';
  463.            TheMenu[16] := 'Find Error   ';
  464.            TheMenu[17] := 'Primary file ';
  465.            TheMenu[18] := 'Find         ';
  466.            TheMenu[19] := 'find/Replace ';
  467.            TheMenu[20] := 'find Next    ';
  468.            TheMenu[21] := 'Get Info     ';
  469.  
  470.            TheMenu[22] := '\Options';
  471.            TheMenu[23] := 'Compiler    ';
  472.            TheMenu[24] := 'Environment ';
  473.            TheMenu[25] := 'Directories ';
  474.            TheMenu[26] := 'Parameters  ';
  475.            TheMenu[27] := 'Load Options';
  476.            TheMenu[28] := 'Save Options';
  477.            TheMenu[29] := '\\';
  478.  
  479.       end; {Proc Define demo menu}
  480.  
  481.       Procedure Fill_Screen_With_Junk;
  482.       var I,J : integer;
  483.       begin
  484.           ClrScr;
  485.           Fillscreen(1,1,80,23,15,0,chr(001));
  486.           Writecenter(15,lightgray,black,' Use the cursor keys... recognize the menu? ');
  487.       end;
  488.  
  489. var
  490.  Major,Minor : byte;
  491.  Ch : char;
  492.  
  493. begin
  494.     Define_Demo_Menu;
  495.     Fill_Screen_With_Junk;
  496.     Major := 1;
  497.     Minor := 1;
  498.     With PM do
  499.     begin
  500.         Style := 0;  {0 no border, 1 single border, 2 double border}
  501.         TopX :=  1;
  502.         TopY := 2;
  503.         ScreenNo := 3;
  504.         Gap :=  5;
  505.         RemoveMenu := false;
  506.     end; {With}
  507.     Pull_Menu(TheMenu,Major,Minor);
  508.     GotoXY(1,20);
  509.     If Major = 0 then
  510.        writeln('You escaped ')
  511.     else
  512.        writeln('You selected main menu ',Major,' and sub-topic ',Minor,' ');
  513.     Writeln('The menu can also be displayed with single or double borders!');
  514.     writeln;
  515.     Writeln('Press any key to return to main menu.......');
  516.     Ch := Readkey;
  517. end;
  518.  
  519.  
  520. Procedure Explain_Menu;
  521. var
  522.   P,code : integer;
  523.   C1,C2,C3: byte;
  524.  
  525.     Procedure Instructions(Number:integer);
  526.     begin
  527.         P := 1;
  528.         Case Number of
  529.         1 : begin
  530.                 WriteAT(9,23,white,black,
  531.                 'This is a mock up of the Main menu but changed to two picks per line,');
  532.                 WriteAT(9,24,white,black,
  533.                 'and moved to the left. Play with the cursor and select an option.    ');
  534.             end;
  535.         2 : begin
  536.                 WriteAT(9,23,white,black,
  537.                 'Now the menu has been changed back to one pick per line and the      ');
  538.                 WriteAT(9,24,white,black,
  539.                 'prefix has changed to a letter. Press a letter or move & Enter.      ');
  540.             end;
  541.         3 : begin
  542.                 WriteAT(9,23,white,black,
  543.                 'Last one I promise! Now the prefix is a number and we''ve changed    ');
  544.                 WriteAT(9,24,white,black,
  545.                 'the colors. Select an option and press Enter.                        ');
  546.             end;
  547.     end; {case}
  548.     end; {sub proc Instructions}
  549.  
  550. begin
  551.     If BaseOfScreen = $B800 then
  552.     begin
  553.         C1 := lightred;
  554.         C2 := red;
  555.     end
  556.     else
  557.     begin
  558.         C1 := lightgray;
  559.         C2 := lightgray;
  560.     end;
  561.     Savescreen(1);
  562.     Clrscr;
  563.     OffCursor;
  564.     Box(1,1,80,25,C1,black,1);
  565.     WriteCenter(3,c1,black,'The MenuTTT Unit');
  566.     WriteAT(3,5,white,black,
  567.     'The Toolkit contains two menu units: one for pull down menus and the other ');
  568.     WriteAT(3,6,white,black,
  569.     'for single boxed menus. Menus area big chore and seem to be something we all');
  570.     WriteAT(3,7,white,black,
  571.     'leave to the end of the development. BUT a friendly and consistent interface');
  572.     WriteAT(3,8,white,black,
  573.     'is fundamental to the acceptance of a program. Menu.TTT is a must.');
  574.     WriteAT(3,10,white,black,
  575.     'The main menu of this demo program is constructed using MenuTTT. All you have');
  576.     WriteAT(3,11,white,black,
  577.     'to do is define a menu record and call the procedure DisplayMenu -- thats    ');
  578.     WriteAT(3,12,white,black,
  579.     'right, there is only one procedure.');
  580.     WriteAT(3,14,white,black,
  581.     'In the menu record you detail the following : a heading, the number of picks,');
  582.     WriteAT(3,15,white,black,
  583.     'the menu text for each pick, the number of picks on a line (typically 1),    ');
  584.     WriteAT(3,16,white,black,
  585.     'the box location and the desired colors, you also indicate whether the Esc   ');
  586.     WriteAT(3,17,white,black,
  587.     'key is enabled. That is all there is to it.');
  588.     WriteAT(3,19,white,black,
  589.     'The menu procedure includes extensive error checking and wherever possible   ');
  590.     WriteAT(3,20,white,black,
  591.     'if an invalid value is found the system will correct. For example if the box ');
  592.     WriteAT(3,21,white,black,
  593.     'will not fit on the screen the procedure will shift it so that it does fit.  ');
  594.     WriteAt(3,23,c1,black,
  595.    'To illustrate how easy it is to modify and change menus, lets display the ');
  596.    WriteAt(3,24,c1,black,
  597.    'main menu a few different ways by simply changing the menu record.        ');
  598.    WriteAt(60,25,c1,black,' press any key .... ');
  599.    Ch := getkey;
  600.    Clrscr;
  601.    Offcursor;
  602.    Box(1,22,80,25,c1,black,1);
  603.    With M1 do
  604.    begin
  605.        PicksPerLine := 2;
  606.        TopleftXY[1] := 1;
  607.    end;
  608.    Instructions(1);
  609.    Displaymenu(M1,false,P,code);
  610.    With M1 do
  611.    begin
  612.        PicksPerLine := 1;
  613.        TopleftXY[1] := 55;
  614.        TopleftXY[2] := 6;
  615.        Addprefix := 2;
  616.    end;
  617.    Instructions(2);
  618.    Displaymenu(M1,false,P,code);
  619.    With M1 do
  620.    begin
  621.        TopleftXY[1] := 15;
  622.        TopleftXY[2] := 5;
  623.        Addprefix := 1;
  624.        If baseOfSCreen = $B800 then
  625.        begin
  626.            Colors[1] := yellow;
  627.            Colors[2] := green;
  628.            Colors[3] := lightgreen;
  629.            Colors[4] := red;
  630.            Colors[5] := white;
  631.        end;
  632.    end;
  633.    Instructions(3);
  634.    Displaymenu(M1,false,P,code);
  635.    Mkwin(5,10,70,17,white,c2,2);
  636.    Offcursor;
  637.    WriteAT(15,12,white,c2,'All these modifications were effected by making');
  638.    WriteAT(15,13,white,c2,'simple changes to the menu record.             ');
  639.    WriteAT(15,15,white,c2,'Now lets check out the pull menu option.       ');
  640.    WriteAT(50,17,white,c2,' press any key .... ');
  641.    Define_Menu1;           {set it all back to normal}
  642.    Ch := getkey;
  643.    Rmwin;
  644.    PullDemo;
  645.    RestoreScreen(1);
  646.    DisposeScreen(1);
  647.    Offcursor;
  648. end;
  649. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  650. {                              O P T I O N      5                             }
  651. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  652. {$F+}
  653. Procedure Help_EditKeys(Ch:Char; Fieldid : integer;var ReturnStr: string);
  654. var C1,C2,c3 : byte;
  655. begin
  656.     If BaseOfScreen = $b800 then
  657.     begin
  658.         C1 := lightcyan;
  659.         C2 := white;
  660.         C3 := blue;
  661.     end
  662.     else
  663.     begin
  664.         C1 := white;
  665.         C2 := black;
  666.         C3 := lightgray;
  667.     end;
  668.     If Ch <> #187 then exit;
  669.     Mkwin(40,1,80,25,C1,c3,2);
  670.     WriteBetween(40,80,2,C1,c3,'IO Editing Keys');
  671.     WriteAT(42,3,c2,c3,'The operative edit keys are defined');
  672.     WriteAT(42,4,c2,c3,'in IOTTT.pas. They may be modified to');
  673.     WriteAT(42,5,c2,c3,'suit your needs. The defaults are:  ');
  674.     WriteAT(42,7,c2,c3, 'Move Up      '+chr(024));
  675.     WriteAT(42,8,c2,c3, 'Move Down    '+chr(025));
  676.     WriteAT(42,9,c2,c3,'Move Right   Ctrl -'+chr(016)+', Tab or Enter');
  677.     WriteAT(42,10,c2,c3,'Move Left    Ctrl '+chr(017)+'- or ShiftTab');
  678.     WriteAT(42,12,c2,c3,'Insert       Press [Ins] to toggle');
  679.     WriteAT(42,14,c2,c3,'Del Char     [Del]  or  [Backspace]');
  680.     WriteAT(42,15,c2,c3,'Del Field    Alt-D');
  681.     WriteAT(42,16,c2,c3,'Del Global   Alt-E');
  682.     WriteAT(42,18,c2,c3,'Update       [End]');
  683.     WriteAT(42,19,c2,c3,'Abort        [Esc]');
  684.     WriteAT(42,21,c2,c3,'Note the abort key can be disabled,');
  685.     WriteAT(42,22,c2,c3,'as it is in this example. Just press');
  686.     WriteAT(42,23,c2,c3,'[End] to finish the example.');
  687.     Ch := getkey;
  688.     Rmwin;
  689. end;
  690. {$F-}
  691.  
  692. Procedure Explain_IO;
  693.  
  694.      Procedure Display_Text;
  695.      var C1,C2 : byte;
  696.      begin
  697.          If BaseOfScreen = $b800 then
  698.          begin
  699.              C1 := yellow;
  700.              C2 := lightgreen;
  701.          end
  702.          else
  703.          begin
  704.              C1 := lightgray;
  705.              C2 := white;
  706.          end;
  707.          Clrscr;
  708.          Box(1,1,80,11,C1,black,3);
  709.   WriteCenter(2,C1,black,'The IOTTT Unit');
  710.   WriteAT(3,4,c2,black,
  711.   'One of the (few) short comings of Turbo Pascal is its very limited support');
  712.   WriteAT(3,5,c2,black,
  713.   'for screen input that gives the user a chance to move around the screen and');
  714.   WriteAT(3,6,c2,black,
  715.   'and edit the input. Thats why I developed the IOTTT unit.');
  716.   WriteAT(3,8,c2,black,
  717.   'These IO procedures allow you to display input fields with format controls');
  718.   WriteAT(3,9,c2,black,
  719.   'e.g. all capitals or only numbers. There are many features to the Kit. The');
  720.   WriteAT(3,10,c2,black,
  721.   'example below illustrates some of the power of this easy to use Kit.');
  722.   end;
  723.  
  724.   Procedure IO_Example;
  725.   var
  726.   s1,s2,s3,s4,s5,s6:string;
  727.   retcode : integer;
  728.   begin
  729.   Box(3,13,78,25,white,black,1);
  730.   Horizline(4,77,15,white,black,1);
  731.   Textcolor(white);
  732.   GotoXY(3,15);write(chr(195));
  733.   GotoXY(78,15);write(chr(180));
  734.   Textcolor(lightred);
  735.   GotoXY(20,14);write(chr(004));
  736.   GotoXY(57,14);write(chr(004));
  737.   GotoXY(22,14);write(chr(004));
  738.   GotoXY(59,14);write(chr(004));
  739.   Textcolor(yellow);
  740.   GotoXY(21,14);write(chr(004));
  741.   GotoXY(58,14);write(chr(004));
  742.   Offcursor;
  743.   WriteCenter(14,Lightgray,black,'Technojocks Inventory Control');
  744.   WriteAt(22,17,white,black,'Catalogue/Part Number');
  745.   WriteAT(10,19,white,black,'Description');
  746.   WriteAT(10,21,white,black,'Quantity');
  747.   WriteAT(50,21,white,black,'Units');
  748.   WriteAT(10,23,white,black,'Shelf');
  749.   WriteAT(50,23,white,black,'Bin No.');
  750.   WriteAT(66,16,white,black,'F1 for HELP');
  751.   S1 := '';
  752.   S2 := '';
  753.   S3 := '';
  754.   S4 := '';
  755.   S5 := '';
  756.   S6 := '0001';
  757.   IO_Setfields(6);
  758.   IO_Soundbeeper(false);
  759.   IO_Allowesc(true);
  760.   IO_UserHook := @Help_Editkeys;
  761.   IO_DefineStr(1,   6,2,6,2,    45,17,  S1,'(####-###)/ ##');
  762.   IO_DefineStr(2,   1,3,1,3,    23,19,  S2,replicate(50,'*'));
  763.   IO_DefineSTR(3,   2,4,2,4,    23,21,  S3,'#####');
  764.   IO_DefineStr(4,   3,5,3,5,    60,21,  S4,'!!!!!!!!!!!!!');
  765.   IO_DefineStr(5,   4,6,4,6,    23,23,  S5,'@@ / @');
  766.   IO_DefineStr(6,   5,1,5,1,    60,23,  S6,'####');
  767.   IO_DefineMsg(1,   13,25, 'Enter the TTT catalogue number (letters not accepted)');
  768.   IO_DefineMsg(2,   15,25, 'Enter the item description from the Purchase Order');
  769.   IO_DefineMsg(4,   25,25, '(note: Units converted to capitals)');
  770.   IO_DefineMsg(5,   20,25, 'Only letters and punctuation chars allowed');
  771.   IO_DefineMsg(6,   20,25, 'Check details and press [End] to update');
  772.   OnCursor;
  773.   IO_Edit(Retcode);
  774.   OffCursor;
  775.   IO_ResetFields;
  776.   end;
  777. begin
  778. SaveScreen(1);
  779. Display_Text;
  780. IO_Example;
  781. RestoreScreen(1);
  782. DisposeScreen(1);
  783. end;
  784. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  785. {                              O P T I O N      6                             }
  786. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  787. Procedure Explain_Dir;
  788.  
  789. Var
  790.  StartPath, Path, Mask, Chosen_File : string;
  791.  Ch : char;
  792.  C1,C2,C3 : byte;
  793. begin
  794.     If BaseOfScreen = $b800 then
  795.     begin
  796.         C1 := Yellow;
  797.         C2 := lightgray;
  798.         C3 := blue;
  799.     end
  800.     else
  801.     begin
  802.         C1 := white;
  803.         C2 := black;
  804.         C3 := lightgray;
  805.     end;
  806.     SaveScreen(1);
  807.     ClrScr;
  808.     FBox(1,1,80,10,C1,c3,2);
  809.     WriteCenter(2,C1,C3,'The DirTTT Unit');
  810.     WriteAT(5,3,c2,c3,
  811.     ' The DirTTT unit provides a single procedure for displaying a directory');
  812.     WriteAT(5,4,c2,c3,
  813.     ' in a Sidekick-like dialogue box. You can optionally display the file');
  814.     WriteAT(5,5,c2,c3,
  815.     ' details of the currently selected field, and allow the users to change');
  816.     WriteAT(5,6,c2,c3,
  817.     ' directories. Only files matching a specified file mask will be shown.');
  818.     WriteAT(5,8,c2,c3,
  819.     ' In the example below ''*.*'' is the mask, use the cursor keys to change');
  820.     WriteAT(5,9,c2,c3,
  821.     ' selections, and select a directory to change to that directory.');
  822.  
  823.     GetDir(0,StartPath);
  824.     Path := StartPath;
  825.     Mask := '*.*';
  826.     With D do
  827.     begin
  828.         Cols := 5;
  829.         Rows := 8;
  830.         TopY := 13;
  831.         AllowEsc := false;
  832.     end;
  833.     Chosen_File := Display_Directory(Path,Mask);
  834.     GotoXy(1,25);
  835.     If Chosen_File = #027 then
  836.         Write('You escaped')
  837.     else
  838.         Write('You selected file ',Chosen_File);
  839.    Write('   Press any key to return to the menu');
  840.    {$I-}
  841.    ChDir(StartPath);
  842.    {$I+}
  843.    Ch := Getkey;
  844.    RestoreScreen(1);
  845.    DisposeScreen(1);
  846. end;
  847.  
  848. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  849. {                              O P T I O N      7                             }
  850. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  851. Procedure Printout;
  852. begin
  853. Mkwin(10,8,70,18,white,red,1);
  854. Offcursor;
  855. WriteAT(15,10,white,red,'The documentation is compressed in a file Manual.exe.');
  856. WriteAT(15,11,white,red,'Execute this file and the file Manual.TTT will self  ');
  857. WriteAT(15,12,white,red,'extract. The manual contains no formatting chars, &');
  858. WriteAT(15,13,white,red,'is 80 characters wide by 66 lines per page.');
  859. WriteAT(15,15,white,red,'At the DOS prompt type Print Manual.TTT. Be warned');
  860. WriteAT(15,16,white,red,'the documentation is good but it''s more than 100 pages.');
  861. WriteAT(50,18,white,red,' press any key .... ');
  862. Ch := getkey;
  863. Rmwin;
  864. end;
  865. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  866. {                              O P T I O N      8                             }
  867. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  868. Procedure Unit_Summary;
  869. const
  870. X1 = 40;
  871. Y1 = 5;
  872. X2 = 80;
  873. Y2 = 25;
  874. var
  875. C1,C2,C3,C4 : byte;
  876.  
  877.  
  878.  
  879. begin
  880.     If BaseOfScreen = $b800 then
  881.     begin
  882.         C1 := white;
  883.         C2 := lightgray;
  884.         C3 := yellow;
  885.         C4 := blue;
  886.     end
  887.     else
  888.     begin
  889.         C1 := white;
  890.         C2 := black;
  891.         C3 := white;
  892.         C4 := lightgray;
  893.     end;
  894.     SaveScreen(1);
  895.     Fbox(1,1,80,24,C1,C4,1);
  896.     WriteCenter(2,C3,C4,'A Summary of the Toolkit Units');
  897.     WriteAT(3,4,c3,c4,'FastTTT  ');
  898.     WriteAT(12,4,c2,c4,'Ultra fast Screen writing routines including box drawing');
  899.     WriteAT(3,6,c3,c4,'WinTTT  ');
  900.     WriteAT(12,6,c2,c4,'Windowing routines together with screen moves, copies & saves');
  901.     WriteAT(3,8,c3,c4,'MenuTTT  ');
  902.     WriteAT(12,8,c2,c4,'Advanced, but easy to use, menu unit with auto-centering etc.');
  903.     WriteAT(3,10,c3,c4,'KeyTTT  ');
  904.     WriteAT(12,10,c2,c4,'Full keyboard control and a host of mouse related procedures');
  905.     WriteAT(3,12,c3,c4,'IOTTT  ');
  906.     WriteAT(12,12,c2,c4,'Form or full screen input procedues, with control of input');
  907.     WriteAT(3,14,c3,c4,'StrngTTT');
  908.     WriteAT(12,14,c2,c4,'Suite of fast string handling procs, including word manipulation');
  909.     WriteAT(3,16,c3,c4,'PullTTT');
  910.     WriteAT(12,16,c2,c4,'Easy to use procedure for displaying Pull down menus');
  911.     WriteAT(3,18,c3,c4,'DirTTT');
  912.     WriteAT(12,18,c2,c4,'Sidekick-like directory listing procedures');
  913.     WriteAT(3,20,c3,c4,'ReadTTT');
  914.     WriteAT(12,20,c2,c4,'Single line input control providing user with full editing');
  915.     WriteAT(3,22,c3,c4,'MiscTTT');
  916.     WriteAT(12,22,c2,c4,'A pot pourri of miscellaneous procedures and functions');
  917.     WriteAT(50,23,c2,c4,'Press any key to continue....');
  918.     Offcursor;
  919.     Ch := getkey;
  920.     SlideRestoreScreen(1,Up);
  921.     DisposeScreen(1);
  922. end;
  923.  
  924. Procedure Initialise;
  925. var X,Y : byte;
  926. begin
  927.     Clrscr;
  928.     Box(25,1,55,4,white,black,1);
  929.     WriteBetween(25,55,2,lightgray,black,'Technojocks Turbo Toolkit');
  930.     WriteBetween(25,55,3,lightgray,black,'V4.05');
  931.     WriteCenter(6,white,black,'"In the software business since Tuesday"');
  932.     WriteAT(5,8,white,black,'This program demonstrates the power of TechnoJocks Turbo Toolkit for');
  933.     WriteAT(5,9,white,black,'Borlands Turbo Pascal v4.0 (IBM and compatibles).');
  934.     WriteAT(5,11,white,black,'The Toolkit is a professional ShareWare product and if you use the');
  935.     WriteAt(5,12,white,black,'Toolkit you must register it. Included in the source code is a file');
  936.     WriteAt(5,13,white,black,'Register.doc, print this file and submit it together with registration');
  937.     WriteAt(5,14,white,black,'fee of:');
  938.     WriteAt(10,16,white,black,' $29.95 for Full registration with 150 page typeset manual');
  939.     WriteAt(10,17,white,black,' $9.95  for full time Student registration');
  940.     WriteAt(5,19,white,black,'to:');
  941.     WriteAt(30,21,white,black,'Bob Ainsbury');
  942.     WriteAt(30,22,white,black,'Technojock');
  943.     WriteAt(30,23,white,black,'P.O. Box 820927');
  944.     WriteAT(30,24,white,black,'Houston, TX 77282');
  945.     WriteAT(55,25,white+blink,black,'Press any key to continue');
  946.     Ch := getkey;
  947.     Clrscr;
  948.     FillScreen(1,1,80,24,white,black,chr(176));
  949.     Findcursor(X,Y,ScanTop,ScanBot);
  950.     OffCursor;
  951.     WriteCenter(25,lightgray,black,'Technojocks Turbo Toolkit v4.0 ');
  952.     Main_Choice := 1;
  953.     Define_Menu1;
  954. end;
  955.  
  956. Procedure Finish;
  957. begin
  958.  ClrScr;
  959.  SizeCursor(ScanTop,Scanbot);
  960.  write('TechnoJocks Turbo Toolkit');
  961.  Halt;
  962. end;
  963.  
  964. begin     {main program}
  965. Initialise;
  966. repeat
  967.      DisplayMenu(M1,false,Main_choice,Error);
  968.      Case Main_Choice of
  969.      1 :Toolkit_Explained;
  970.      2 :Explain_Fastwrite;
  971.      3 :Explain_Windows;
  972.      4 :Explain_Menu;
  973.      5 :Explain_IO;
  974.      6 :Explain_Dir;
  975.      7 :PrintOut;
  976.      8 :Unit_Summary;
  977.      9 :Finish;
  978.      end;  {case}
  979. until true = false;  {a very very very long time !}
  980. end.
  981.  
  982.