home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TOOLKIT.ZIP / DEMOTTT.DEM < prev    next >
Encoding:
Text File  |  1986-10-01  |  33.5 KB  |  811 lines
  1. Program Illustrating_the_Toolkit;
  2. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  3. {        This is the main demonstration program in Technojocks Turbo         }
  4. {        Toolkit. The compiled version is in TTTDemo.Com.                    }
  5. {                                                                            }
  6. {        Please distribute the toolkit to anyone and everyone -- but         }
  7. {        all the files must be distributed together and they should          }
  8. {        not be altered. Enough Crap!                                        }
  9. {                                                                            }
  10. {              Bitches, gripes, thanks, kisses, donations to                 }
  11. {                                                                            }
  12. {                        Bob Ainsbury,                                       }
  13. {                        Technojock,                                         }
  14. {                        P.O. Box 2197,                                      }
  15. {                        Houston TX 77252                                    }
  16. {                                                                            }
  17. {                "In the software business since Tuesday"                    }
  18. {                                                                            }
  19. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  20.  
  21. {$I Decl.ttt}
  22. {$I Fastwrit.TTT}
  23. {$I Window.TTT}
  24. {$I Misc.TTT}
  25. {$I IO.TTT}
  26. {$I Menu.TTT}
  27.  
  28. var
  29. Main_Choice,Choice,Error : integer;
  30. M1 : Menu_record;
  31. Const Author = 'Bob Ainsbury, Technojock';
  32.  
  33. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  34. {          T H E     M A I N    M E N U    P R O C E D U R E S                }
  35. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  36. Procedure Define_Menu1;
  37. begin
  38. With M1 do
  39. begin
  40.  Heading := 'Turbo Toolkit Menu';
  41.  Text[1] := 'The Toolkit explained';
  42.  Text[2] := 'Fastwrit.TTT Procedures';
  43.  Text[3] := 'Window.TTT Procedures';
  44.  Text[4] := 'Menu.TTT Procedures';
  45.  Text[5] := 'IO.TTT Procedures & Demo';
  46.  Text[6] := 'Misc.TTT Procedures';
  47.  Text[7] := 'Print documentation';
  48.  Text[8] := 'Help';
  49.  Text[9] := 'Quit to DOS';
  50.  TotalPicks := 9;
  51.  PicksPerLine := 1;            {one column of choices}
  52.  Addprefix := 3;               {add function key prefixes}
  53.  TopleftXY[1] := 0;            {system will center menu}
  54.  TopleftXY[2] := 3;            {Y coordinate}
  55.  Boxtype := 2;                 {double box}
  56.  Colors[1] := white;           {hi forground}
  57.  Colors[2] := blue;            {hi background}
  58.  Colors[3] := red;             {lo foreground}
  59.  Colors[4] := lightgray;       {lo background}
  60.  Colors[5] := blue;            {box color}
  61.  AllowEsc := false;            {inactivate the escape key}
  62. end;  {with M1 do}
  63. end; {Define_Menu1}
  64. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  65. {                              O P T I O N      1                             }
  66. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  67. Procedure Toolkit_Explained;
  68. const
  69. X1 = 1;
  70. Y1 = 1;
  71. X2 = 80;
  72. Y2 = 20;
  73. C1 = Lightgreen;
  74. C2 = black;
  75. C3 = yellow;
  76. begin
  77. Mkwin(X1,Y1,X2,Y2,C1,C2,4);
  78. OffCursor;
  79. WriteCenter(Y1,C1,C2,' THE TOOLKIT EXPLAINED ');
  80. WriteAT(X1+5,Y1+2,C3,C2,
  81. 'The Toolkit is a productiviity aid for programming in Turbo Pascal');
  82. WriteAT(X1+5,Y1+3,C3,C2,
  83. 'and can be used by novice and expert programmer alike.');
  84. WriteAT(X1+5,Y1+5,C3,C2,
  85. 'I developed the Toolkit to help me speed up the development time of');
  86. WriteAT(X1+5,Y1+6,C3,C2,
  87. 'my programs. Most of the work I undertake is screen IO related and');
  88. WriteAT(X1+5,Y1+7,C3,C2,
  89. 'so the Toolkit is biased to these tasks. There is an extensive user');
  90. WriteAT(X1+5,Y1+8,C3,C2,
  91. 'guide which details how to use all the procedures and functions in ');
  92. WriteAT(X1+5,Y1+9,C3,C2,
  93. 'the Toolkit -- select option 7 from the main menu to get a printout.');
  94. WriteAT(X1+5,Y1+11,C3,C2,
  95. 'The whole of this demonstration program was built very quickly using');
  96. WriteAT(X1+5,Y1+12,C3,C2,
  97. 'the Toolkit. The Toolkit is actually a set of files ending with a TTT');
  98. WriteAT(X1+5,Y1+13,C3,C2,
  99. 'extension (plus some demonstration files like this one). All you have ');
  100. WriteAT(X1+5,Y1+14,C3,C2,
  101. 'to do is include the necessary TTT files with a {$I} directive and call');
  102. WriteAT(X1+5,Y1+15,C3,C2,
  103. 'the procedure. Refer to the Toolkit manual for a full explanation.');
  104. WriteAT(X1+17,Y1+17,C1,C2,
  105. 'Enjoy.....');
  106. WriteAT(X1+28,Y1+18,white,C2,
  107. 'Bob Ainsbury, Technojock, Houston (713) 293-2760');
  108. WriteAT(X2-20,Y2,C1,C2,' press any key ... ');
  109. Wait_For_Keypress(Ch);
  110. Rmwin;
  111. end;
  112. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  113. {                              O P T I O N      2                             }
  114. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  115. Procedure Explain_Fastwrite;
  116. const
  117. X1 = 1;
  118. Y1 = 1;
  119. X2 = 80;
  120. Y2 = 25;
  121. C1 = white;
  122. C2 = yellow;
  123. C3 = black;
  124. Max_Picks = 16;
  125.  
  126.       Procedure MainText;
  127.       begin
  128.       Box(X1,Y1,X2,Y2,C2,C3,1);
  129.       Horizline(3,77,19,red,black,1);
  130.       WriteCenter(Y1+1,C2,C3,'Fastwrit.TTT');
  131.       WriteAT(X1+5,Y1+3,C1,C3,
  132.       'The Fastwrit.TTT file contains a host of procedures for updating');
  133.       WriteAT(X1+5,Y1+4,C1,C3,
  134.       'the screen and controlling the cursor.');
  135.       WriteAT(X1+5,Y1+6,C1,C3,
  136.       'The procedures revolve around an Inline method of writing directly to');
  137.       WriteAT(X1+5,Y1+7,C1,C3,
  138.       'video memory and are therefore very machine dependent. They will  ');
  139.       WriteAT(X1+5,Y1+8,C1,C3,
  140.       'work on IBM and true compatible PC''s. If this demo is working then');
  141.       WriteAT(X1+5,Y1+9,C1,C3,
  142.       'the procedures are OK on this machine!');
  143.       WriteAT(X1+5,Y1+11,C1,C3,
  144.       'Listed below are some of the main Fastwrit procedures, move the cursor');
  145.       WriteAT(X1+5,Y1+12,C1,C3,
  146.       'to see a fuller description. Press [End] or [Esc] to return to the menu.');
  147.       end;  {sub proc Main_text}
  148.  
  149.       Procedure WriteOption(Pick,F,B:integer);
  150.       const
  151.       Lineone = 15;
  152.       LeftTab = 6;
  153.       Tab = 18;
  154.       begin
  155.       Case Pick of
  156.       1 : WriteAT(LeftTab,Lineone,F,B,             '    Box          ');
  157.       2 : WriteAT(LeftTab+Tab,Lineone,F,B,         '    HorizLine    ');
  158.       3 : WriteAT(LeftTab+2*Tab,LineOne,F,B,       '    VertLine     ');
  159.       4 : WriteAT(LeftTab+3*Tab,LineOne,F,B,       '    WriteAT      ');
  160.       5 : WriteAT(LeftTab,LineOne+1,F,B,           '    ClearText    ');
  161.       6 : WriteAT(LeftTab+Tab,LineOne+1,F,B,       '    WriteCenter  ');
  162.       7 : WriteAT(LeftTab+2*Tab,LineOne+1,F,B,     '    WriteBetween ');
  163.       8 : WriteAT(LeftTab+3*Tab,LineOne+1,F,B,     '    WriteVert    ');
  164.       9 : WriteAT(LeftTab,Lineone+2,F,B,           '    TempMessage  ');
  165.       10: WriteAt(LeftTab+tab,LineOne+2,F,B,       '    FindCursor   ');
  166.       11: WriteAt(LeftTab+2*tab,LineOne+2,F,B,     '    PosCursor    ');
  167.       12: WriteAt(LeftTab+3*Tab,LineOne+2,F,B,     '    SizeCursor   ');
  168.       13: WriteAT(LeftTab,Lineone+3,F,B,           '    OffCursor    ');
  169.       14: WriteAt(LeftTab+tab,LineOne+3,F,B,       '    OnCursor     ');
  170.       15: WriteAt(LeftTab+2*tab,LineOne+3,F,B,     '    VideoOff     ');
  171.       16: WriteAt(LeftTab+3*Tab,LineOne+3,F,B,     '    VideoOn      ');
  172.       end; {case}
  173.       end; {WriteOption}
  174.  
  175.       Procedure Hilite(Pick:integer);
  176.       begin
  177.       WriteOption(Pick,White,red);
  178.       end;   {HiLite}
  179.  
  180.       Procedure LoLite(Pick:integer);
  181.       begin
  182.       WriteOption(Pick,Lightgray,C3);
  183.       end;   {LoLite}
  184.  
  185.       Procedure DisplayDescription(Pick : integer);
  186.       const
  187.       X = 7;
  188.       Y = 20;
  189.       C = yellow;
  190.       begin
  191.       case Pick of
  192.       1 : begin
  193.            WriteAT(X,Y,C,black,  'Syntax :  Box(X1,Y1,X2,Y2,F,B,boxtype : integer);                   ');
  194.            WriteAT(X,Y+2,C,black,'Purpose : Draws a rectangular box on the screen in foreground color ');
  195.            WriteAT(X,Y+3,C,black,'          F and background color B. The boxtype indicates what line ');
  196.            WriteAT(X,Y+4,C,black,'          type to use i.e. single, double or combined.              ');
  197.           end;
  198.       2 : begin
  199.            WriteAT(X,Y,C,black,  'Syntax :  HorizLine(X1,X2,Y,F,B,LineType:integer);                  ');
  200.            WriteAT(X,Y+2,C,black,'Purpose : Draws a horizontal line on the screen in foreground color ');
  201.            WriteAT(X,Y+3,C,black,'          F and background color B. The linetype indicates what line');
  202.            WriteAT(X,Y+4,C,black,'          type to use i.e. single or double.                        ');
  203.           end;
  204.       3 : begin
  205.            WriteAT(X,Y,C,black,  'Syntax :  VertLine(X,Y1,Y2,F,B,LineType:integer);                   ');
  206.            WriteAT(X,Y+2,C,black,'Purpose : Draws a vertical line on the screen in foreground color F ');
  207.            WriteAT(X,Y+3,C,black,'          and background color B. The linetype indicates what line  ');
  208.            WriteAT(X,Y+4,C,black,'          type to use i.e. single or double.                        ');
  209.           end;
  210.       4 : begin
  211.            WriteAT(X,Y,C,black,  'Syntax :  WriteAT(X,Y,F,B:integer;ST:string80);                     ');
  212.            WriteAT(X,Y+2,C,black,'Purpose : Writes the string St very quickly on the screen starting  ');
  213.            WriteAT(X,Y+3,C,black,'          at (X,Y) in foreground color F and background color B. The');
  214.            WriteAT(X,Y+4,C,black,'          string may be concatenated e.g. ''Techno''+''Jock''.          ');
  215.           end;
  216.       5 : begin
  217.            WriteAT(X,Y,C,black,  'Syntax :  ClearText(X1,Y1,X2,Y2,F,B:integer);                       ');
  218.            WriteAT(X,Y+2,C,black,'Purpose : Clears the characters for a rectangular area on the screen');
  219.            WriteAT(X,Y+3,C,black,'          and displays background color B. The attribute for the    ');
  220.            WriteAT(X,Y+4,C,black,'          foreground is set to F. Unaffected by Window setting.     ');
  221.           end;
  222.       6 : begin
  223.            WriteAT(X,Y,C,black,  'Syntax :  WriteCenter(Lineno,F,B:integer;ST:string80);              ');
  224.            WriteAT(X,Y+2,C,black,'Purpose : Writes the string ST very quickly on the screen in the    ');
  225.            WriteAT(X,Y+3,C,black,'          center of line Lineno in foreground color F and back-     ');
  226.            WriteAT(X,Y+4,C,black,'          ground color B. The string may be concatenated.           ');
  227.           end;
  228.       7 : begin
  229.            WriteAT(X,Y,C,black,  'Syntax :  WriteBetween(X1,X2,Y,F,B:integer;ST:string80);            ');
  230.            WriteAT(X,Y+2,C,black,'Purpose : Writes the string ST very quickly on the screen centered  ');
  231.            WriteAT(X,Y+3,C,black,'          between X1 and X2 on line Y, in foreground F and back-    ');
  232.            WriteAT(X,Y+4,C,black,'          ground color B. The string may be concatenated.           ');
  233.           end;
  234.       8 : begin
  235.            WriteAT(X,Y,C,black,  'Syntax :  WriteVert(X,Y,F,B;ST:string80);                           ');
  236.            WriteAT(X,Y+2,C,black,'Purpose : Writes the string ST vertically on the screen starting at ');
  237.            WriteAT(X,Y+3,C,black,'          coordinate (X,Y) and continuing down the screen, in fore- ');
  238.            WriteAT(X,Y+4,C,black,'          ground color F and background color B.                    ');
  239.           end;
  240.       9 : begin
  241.            WriteAT(X,Y,C,black,  'Syntax :  Tempmessage(X,Y,F,B:integer;ST:string80);                 ');
  242.            WriteAT(X,Y+2,C,black,'Purpose : Displays a message anywhere on the screen in foreground   ');
  243.            WriteAT(X,Y+3,C,black,'          color F and background color B, and waits for any key to  ');
  244.            WriteAT(X,Y+4,C,black,'          be pressed. The screen contents are then restored.        ');
  245.           end;
  246.       10: begin
  247.            WriteAT(X,Y,C,black,  'Syntax :  FindCursor(var X,Y,ScanTop,ScanBot:integer);              ');
  248.            WriteAT(X,Y+2,C,black,'Purpose : Returns the precise location of the cursor, and the top & ');
  249.            WriteAT(X,Y+3,C,black,'          bottom scan lines i.e. the cursor shape. The X and Y      ');
  250.            WriteAT(X,Y+4,C,black,'          coords are independant of the current Window setting.     ');
  251.           end;
  252.       11: begin
  253.            WriteAT(X,Y,C,black,  'Syntax :  PosCursor(X,Y:integer);                                   ');
  254.            WriteAT(X,Y+2,C,black,'Purpose : Locates the cursor at coordinates (X,Y). This procedure   ');
  255.            WriteAT(X,Y+3,C,black,'          differs from Turbo Pascals procedure GotoXY, in that it   ');
  256.            WriteAT(X,Y+4,C,black,'          not affected by the current window setting.               ');
  257.           end;
  258.       12: begin
  259.            WriteAT(X,Y,C,black,  'Syntax :  SizeCursor(ScanTop,ScanBot:integer);                      ');
  260.            WriteAT(X,Y+2,C,black,'Purpose : Changes the shape of the cursor on monochrome and color   ');
  261.            WriteAT(X,Y+3,C,black,'          systems. The top scan line is 0 and the bottom is either  ');
  262.            WriteAT(X,Y+4,C,black,'          13 for monochrome or 7 for color.                         ');
  263.           end;
  264.       13: begin
  265.            WriteAT(X,Y,C,black,  'Syntax :  Offcursor;                                                ');
  266.            WriteAT(X,Y+2,C,black,'Purpose : Provides a simple way of hiding the cursor on both mono-  ');
  267.            WriteAT(X,Y+3,C,black,'          chrome and color systems.                                 ');
  268.            WriteAT(X,Y+4,C,black,'                                                                    ');
  269.           end;
  270.       14: begin
  271.            WriteAT(X,Y,C,black,  'Syntax :  OnCursor;                                                 ');
  272.            WriteAT(X,Y+2,C,black,'Purpose : Provides a quick way of resetting the cursor to the       ');
  273.            WriteAT(X,Y+3,C,black,'          default DOS setting i.e. a thin line beneath the          ');
  274.            WriteAT(X,Y+4,C,black,'          character.                                                ');
  275.           end;
  276.       15: begin
  277.            WriteAT(X,Y,C,black,  'Syntax :  VideoOff;                                                 ');
  278.            WriteAT(X,Y+2,C,black,'Purpose : Switches the video port off to avoid ''snow'' on systems  ');
  279.            WriteAT(X,Y+3,C,black,'          equipped with an IBM Color Graphics Adapter when writing  ');
  280.            WriteAT(X,Y+4,C,black,'          direct to screen memory.                                  ');
  281.           end;
  282.       16: begin
  283.            WriteAT(X,Y,C,black,  'Syntax :  VideoOn;                                                  ');
  284.            WriteAT(X,Y+2,C,black,'Purpose : Switches the video port on following VideoOff and         ');
  285.            WriteAT(X,Y+3,C,black,'          refreshes the screen.                                     ');
  286.            WriteAT(X,Y+4,C,black,'                                                                    ');
  287.           end;
  288.       end; {case}
  289.       end; {DisplayDescription}
  290.  
  291.       Procedure Keystroke;
  292.       var
  293.       Allover : boolean;
  294.       I,CurrentPick : integer;
  295.       begin
  296.       Allover := false;
  297.       CurrentPick := 1;
  298.       For I := 1 to Max_Picks do
  299.        LoLite(I);
  300.       HiLite(CurrentPick);
  301.       Repeat
  302.        Wait_For_Keypress(Ch);
  303.        If upcase(Ch) in [' ',EscKey,Tabkey] then Funckey := true;
  304.        If Funckey = true then
  305.        begin
  306.         Case upcase(Ch) of
  307.         CursorUp :      If CurrentPick > 4 then
  308.                         begin
  309.                          LoLite(CurrentPick);
  310.                          CurrentPick := CurrentPick - 4;
  311.                          HiLite(CurrentPick);
  312.                         end;
  313.         CursorDown :    If CurrentPick <= Max_Picks - 4 then
  314.                         begin
  315.                          LoLite(CurrentPick);
  316.                          CurrentPick := CurrentPick + 4;
  317.                          HiLite(CurrentPick);
  318.                         end;
  319.         ' ',
  320.         Tabkey,
  321.         CursorRight :   begin
  322.                          LoLite(CurrentPick);
  323.                          If CurrentPick < Max_Picks then
  324.                           CurrentPick := CurrentPick + 1
  325.                          else
  326.                           CurrentPick := 1;
  327.                          HiLite(CurrentPick);
  328.                         end;
  329.         CursorLeft :    begin
  330.                          LoLite(CurrentPick);
  331.                          If CurrentPick > 1 then
  332.                           CurrentPick := CurrentPick - 1
  333.                          else
  334.                           CurrentPick := Max_Picks;
  335.                          HiLite(CurrentPick);
  336.                         end;
  337.         EscKey,
  338.         EndKey :        Allover := true;
  339.         end; {case}
  340.         DisplayDescription(CurrentPick);
  341.        end;  {if true}
  342.       Until Allover;
  343.       end;  {Keystroke}
  344.  
  345.  
  346. begin       {Explain_Fastwrite}
  347. SaveScreen(1);
  348. Clrscr;
  349. OffCursor;
  350. MainText;
  351. DisplayDescription(1);
  352. Keystroke;
  353. RestoreScreen(1);
  354. DisposeScreen(1);
  355. end;  {proc Explain_Fastwrite}
  356. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  357. {                              O P T I O N      3                             }
  358. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  359. Procedure Explain_Windows;
  360. var I : integer;
  361. begin
  362. Savescreen(1);
  363. OffCursor;
  364. MkWin(1,1,35,14,yellow,green,2);
  365. WriteBetween(1,35,3,yellow,green,'Window.TTT');
  366. WriteAt(3,5,white,green,'The Window procedures provide');
  367. WriteAT(3,6,white,green,'tools for easily writing flash');
  368. WriteAT(3,7,white,green,'up window routines. ');
  369. WriteAT(3,10,white,green,'They also include procedures');
  370. WriteAT(3,11,white,green,'for saving and restoring screen');
  371. WriteAT(3,12,white,green,'images.');
  372. Delay(4000);
  373. Mkwin(34,7,66,20,lightgray,red,3);
  374. WriteAT(36,9,white,red, 'The windows can be placed any');
  375. WriteAT(36,10,white,red,'where on the screen and both');
  376. WriteAT(36,11,white,red,'the border style and colors ');
  377. WriteAT(36,12,white,red,'can be easily altered.');
  378. Delay(3000);
  379. Mkwin(20,13,68,25,lightblue,magenta,1);
  380. WriteAT(22,15,white,magenta,'There are five procedures in the Windows Kit.');
  381. WriteAT(22,16,white,magenta,'The two window procedures are simply MkWin to');
  382. WriteAT(22,17,white,magenta,'create a window, and RmWin to remove a window');
  383. WriteAT(22,19,white,magenta,'The remaining three procedures are SaveScreen');
  384. WriteAT(22,20,white,magenta,'RestoreScreen and DisposeScreen. As the names');
  385. WriteAT(22,21,white,magenta,'suggest these procedures control the saving &');
  386. WriteAT(22,22,white,magenta,'restoring of screens.                        ');
  387. WriteAT(22,24,white,magenta,'Press any key to see a fast screen restore!');
  388. Savescreen(2);
  389. Wait_for_Keypress(Ch);
  390. RestoreScreen(1);
  391. Delay(700);
  392. RestoreScreen(2);
  393. For I := 1 to 12 do
  394. begin
  395.  RestoreScreen(1);
  396.  Delay(150);
  397.  RestoreScreen(2);
  398.  Delay(150);
  399. end;
  400. Mkwin(1,21,80,25,white,red,0);
  401. WriteCenter(23,white,red,'Phew. That included a 150th of a second delay so you could see it!');
  402. WriteAt(60,25,white,red,'press any key ....  ');
  403. DisposeScreen(1);
  404. DisposeScreen(2);
  405. Wait_for_Keypress(Ch);
  406. Rmwin;
  407. Delay(200);
  408. Rmwin;
  409. Delay(200);
  410. Rmwin;
  411. Delay(200);
  412. Rmwin;
  413. Mkwin(20,10,60,15,white,red,2);
  414. WriteAt(25,12,white,red,'End of the Windows Demonstration');
  415. WriteAt(25,13,white,red,'You are now back at the menu!');
  416. Delay(3000);
  417. RmWin;
  418. end;
  419. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  420. {                              O P T I O N      4                             }
  421. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  422. Procedure Explain_Menu;
  423. var P,code : integer;
  424.     Procedure Instructions(Number:integer);
  425.     begin
  426.     P := 1;
  427.     Case Number of
  428.     1 : begin
  429.          WriteAT(9,23,white,black,
  430.          'This is a mock up of the Main menu but changed to two picks per line,');
  431.          WriteAT(9,24,white,black,
  432.          'and moved to the left. Play with the cursor and select an option.    ');
  433.         end;
  434.     2 : begin
  435.          WriteAT(9,23,white,black,
  436.          'Now the menu has been changed back to one pick per line and the      ');
  437.          WriteAT(9,24,white,black,
  438.          'prefix has changed to a letter. Press a letter or move & Enter.      ');
  439.         end;
  440.     3 : begin
  441.          WriteAT(9,23,white,black,
  442.          'Last one I promise! Now the prefix is a number and we''ve changed    ');
  443.          WriteAT(9,24,white,black,
  444.          'the colors. Select an option and press Enter.                        ');
  445.         end;
  446.     end; {case}
  447.     end; {sub proc Instructions}
  448. begin
  449. Savescreen(1);
  450. Clrscr;
  451. OffCursor;
  452. Box(1,1,80,25,lightred,black,1);
  453. WriteCenter(3,lightred,black,'Menu.TTT');
  454. WriteAT(3,5,white,black,
  455. 'The Menu kit is one of the most powerful and easy to use tools in the whole');
  456. WriteAT(3,6,white,black,
  457. 'Toolkit. Menuing routines are always a chore and seem to be something we all');
  458. WriteAT(3,7,white,black,
  459. 'leave to the end of the development. BUT a friendly and consistent interface');
  460. WriteAT(3,8,white,black,
  461. 'is fundamental to the acceptance of a program. Menu.TTT is a must.');
  462. WriteAT(3,10,white,black,
  463. 'The main menu of this demo program is constructed using the kit. All you have');
  464. WriteAT(3,11,white,black,
  465. 'to do is define a menu record and call the procedure DisplayMenu -- thats    ');
  466. WriteAT(3,12,white,black,
  467. 'right, there is only one procedure.');
  468. WriteAT(3,14,white,black,
  469. 'In the menu record you detail the following : a heading, the number of picks,');
  470. WriteAT(3,15,white,black,
  471. 'the menu text for each pick, the number of picks on a line (typically 1),    ');
  472. WriteAT(3,16,white,black,
  473. 'the box location and the desired colors, you also indicate whether the Esc   ');
  474. WriteAT(3,17,white,black,
  475. 'key is enabled. That is all there is to it.');
  476. WriteAT(3,19,white,black,
  477. 'The menu procedure includes extensive error checking and wherever possible   ');
  478. WriteAT(3,20,white,black,
  479. 'if an invalid value is found the system will correct. For example if the box ');
  480. WriteAT(3,21,white,black,
  481. 'will not fit on the screen the procedure will shift it so that it does fit.  ');
  482. WriteAt(3,23,lightred,black,
  483. 'To illustrate how easy it is to modify and change menus, lets display the ');
  484. WriteAt(3,24,lightred,black,
  485. 'main menu a few different ways by simply changing the menu record.        ');
  486. WriteAt(60,25,lightred,black,' press any key .... ');
  487. Wait_for_Keypress(Ch);
  488. Clrscr;
  489. Offcursor;
  490. Box(1,22,80,25,lightred,black,1);
  491. With M1 do
  492. begin
  493.  PicksPerLine := 2;
  494.  TopleftXY[1] := 1;
  495. end;
  496. Instructions(1);
  497. Displaymenu(M1,false,P,code);
  498. With M1 do
  499. begin
  500.  PicksPerLine := 1;
  501.  TopleftXY[1] := 55;
  502.  TopleftXY[2] := 6;
  503.  Addprefix := 2;
  504. end;
  505. Instructions(2);
  506. Displaymenu(M1,false,P,code);
  507. With M1 do
  508. begin
  509.  TopleftXY[1] := 10;
  510.  TopleftXY[2] := 9;
  511.  Addprefix := 1;
  512.  Colors[1] := yellow;
  513.  Colors[2] := green;
  514.  Colors[3] := lightgreen;
  515.  Colors[4] := black;
  516.  Colors[5] := white;
  517. end;
  518. Instructions(3);
  519. Displaymenu(M1,false,P,code);
  520. Mkwin(5,10,70,17,white,red,2);
  521. Offcursor;
  522. WriteAT(15,12,white,red,'All these modifications were effected by making');
  523. WriteAT(15,13,white,red,'simple changes to the menu record.             ');
  524. WriteAT(15,15,white,red,'Thats all, lets return to the real menu.      ');
  525. WriteAT(50,17,white,red,' press any key .... ');
  526. Define_Menu1;           {set it all back to normal}
  527. Wait_for_Keypress(Ch);
  528. Rmwin;
  529. RestoreScreen(1);
  530. DisposeScreen(1);
  531. end;
  532. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  533. {                              O P T I O N      5                             }
  534. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  535. Procedure Help_EditKeys;
  536. begin
  537. Mkwin(40,1,80,25,lightcyan,blue,2);
  538. WriteBetween(40,80,2,lightcyan,blue,'IO Editing Keys');
  539. WriteAT(42,3,white,blue,'The operative edit keys are defined');
  540. WriteAT(42,4,white,blue,'in DECL.TTT. They may be modified to');
  541. WriteAT(42,5,white,blue,'suit your needs. The defaults are:  ');
  542. WriteAT(42,7,white,blue, 'Move Up      '+chr(024));
  543. WriteAT(42,8,white,blue, 'Move Down    '+chr(025));
  544. WriteAT(42,9,white,blue,'Move Right   Ctrl -'+chr(016)+', Tab or Enter');
  545. WriteAT(42,10,white,blue,'Move Left    Ctrl '+chr(017)+'- or ShiftTab');
  546. WriteAT(42,12,white,blue,'Insert       Press [Ins] to toggle');
  547. WriteAT(42,14,white,blue,'Del Char     [Del]  or  [Backspace]');
  548. WriteAT(42,15,white,blue,'Del Field    Alt-D');
  549. WriteAT(42,16,white,blue,'Del Global   Alt-E');
  550. WriteAT(42,18,white,blue,'Update       [End]');
  551. WriteAT(42,19,white,blue,'Abort        [Esc]');
  552. WriteAT(42,21,white,blue,'Note the abort key can be disabled,');
  553. WriteAT(42,22,white,blue,'as it is in this example. Just press');
  554. WriteAT(42,23,white,blue,'[End] to finish the example.');
  555. Wait_For_Keypress(Ch);
  556. Rmwin;
  557. end;
  558.  
  559. Procedure Explain_IO;
  560.   Procedure Display_Text;
  561.   begin
  562.  
  563.   Clrscr;
  564.   Box(1,1,80,11,yellow,black,3);
  565.   WriteCenter(2,yellow,black,'IO.TTT');
  566.   WriteAT(3,4,lightgreen,black,
  567.   'One of the (few) short comings of Turbo Pascal is its very limited support');
  568.   WriteAT(3,5,lightgreen,black,
  569.   'for screen input that gives the user a chance to move around the screen and');
  570.   WriteAT(3,6,lightgreen,black,
  571.   'and edit the input. Thats why I developed the IO kit.');
  572.   WriteAT(3,8,lightgreen,black,
  573.   'These IO procedures allow you to display input fields with format controls');
  574.   WriteAT(3,9,lightgreen,black,
  575.   'e.g. all capitals or only numbers. There are many features to the Kit. The');
  576.   WriteAT(3,10,lightgreen,black,
  577.   'example below illustrates some of the power of this easy to use Kit.');
  578.   end;
  579.  
  580.   Procedure IO_Example;
  581.   var
  582.   s1,s2,s3,s4,s5,s6:string80;
  583.   retcode : integer;
  584.   begin
  585.   Box(3,13,78,25,white,black,1);
  586.   Horizline(4,77,15,white,black,1);
  587.   Textcolor(white);
  588.   GotoXY(3,15);write(chr(195));
  589.   GotoXY(78,15);write(chr(180));
  590.   Textcolor(lightred);
  591.   GotoXY(20,14);write(chr(004));
  592.   GotoXY(57,14);write(chr(004));
  593.   GotoXY(22,14);write(chr(004));
  594.   GotoXY(59,14);write(chr(004));
  595.   Textcolor(yellow);
  596.   GotoXY(21,14);write(chr(004));
  597.   GotoXY(58,14);write(chr(004));
  598.   Offcursor;
  599.   WriteCenter(14,Lightblue,black,'Technojocks Inventory Control');
  600.   WriteAt(22,17,white,black,'Catalogue/Part Number');
  601.   WriteAT(10,19,white,black,'Description');
  602.   WriteAT(10,21,white,black,'Quantity');
  603.   WriteAT(50,21,white,black,'Units');
  604.   WriteAT(10,23,white,black,'Shelf');
  605.   WriteAT(50,23,white,black,'Bin No.');
  606.   WriteAT(66,16,lightred,black,'F1 for HELP');
  607.   S1 := '';
  608.   S2 := '';
  609.   S3 := '';
  610.   S4 := '';
  611.   S5 := '';
  612.   S6 := '0001';
  613.   IO_Setfields(6);
  614.   IO_Soundbeeper(false);
  615.   IO_Allowesc(true);
  616.   IO_HelpProc(ofs(Help_Editkeys));
  617.   IO_Setcolors(white,lightgray,blue,lightgray,red,lightgray);
  618.   IO_DefineStr(1,   6,2,6,2,    45,17,  S1,'(####-###)/ ##');
  619.   IO_DefineStr(2,   1,3,1,3,    23,19,  S2,replicate(50,'*'));
  620.   IO_DefineSTR(3,   2,4,2,4,    23,21,  S3,'#####');
  621.   IO_DefineStr(4,   3,5,3,5,    60,21,  S4,'!!!!!!!!!!!!!');
  622.   IO_DefineStr(5,   4,6,4,6,    23,23,  S5,'@@ / @');
  623.   IO_DefineStr(6,   5,1,5,1,    60,23,  S6,'####');
  624.   IO_DefineMsg(1,   13,25, 'Enter the TTT catalogue number (letters not accepted)');
  625.   IO_DefineMsg(2,   15,25, 'Enter the item description from the Purchase Order');
  626.   IO_DefineMsg(4,   25,25, '(note: Units converted to capitals)');
  627.   IO_DefineMsg(5,   20,25, 'Only letters and punctuation chars allowed');
  628.   IO_DefineMsg(6,   20,25, 'Check details and press [End] to update');
  629.   OnCursor;
  630.   IO_Edit(Retcode);
  631.   OffCursor;
  632.   IO_ResetFields;
  633.   end;
  634. begin
  635. SaveScreen(1);
  636. Display_Text;
  637. IO_Example;
  638. RestoreScreen(1);
  639. DisposeScreen(1);
  640. end;
  641. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  642. {                              O P T I O N      6                             }
  643. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  644. Procedure Explain_Misc;
  645. begin
  646. Savescreen(1);
  647. Mkwin(1,1,80,21,yellow,black,1);
  648. OffCursor;
  649. WriteCenter(2,yellow,black,'Misc.TTT');
  650. WriteAT(7,3,lightgreen,black,
  651. 'This Kit simply contains a pot pourri of miscellaneous procedures and');
  652. WriteAT(7,4,lightgreen,black,
  653. 'functions. Some of them are used by the Menu and IO Kits but most are');
  654. WriteAT(7,5,lightgreen,black,
  655. 'standalone tools. I have kept this file small to minimize the compile');
  656. WriteAT(7,6,lightgreen,black,
  657. 'time of the ToolKit. However, this file could be supplemented with   ');
  658. WriteAT(7,7,lightgreen,black,
  659. 'your own bag of tricks.');
  660. WriteAT(7,9,lightgreen,black,
  661. 'At the time of going to the press, this Kit included the following:');
  662. WriteAT(7,11,yellow,black,
  663. 'Date, Time');
  664. WriteAT(7,12,yellow,black,
  665. 'Printer_Ready');
  666. WriteAT(7,13,yellow,black,
  667. 'Print_Screen');
  668. WriteAT(7,14,yellow,black,
  669. 'Flush_Key_Buffer');
  670. WriteAT(7,15,yellow,black,
  671. 'MemAvail_in_Bytes');
  672. WriteAT(7,16,yellow,black,
  673. 'Replicate');
  674. WriteAT(7,17,yellow,black,
  675. 'Wait_for_Keypress');
  676. WriteAT(7,18,yellow,black,
  677. 'Beep');
  678. WriteAT(7,19,yellow,black,
  679. 'Str_to_Int, Int_to_Str, Real_to_Str');
  680. WriteAt(30,11,lightgreen,black,
  681. 'Return the date or time nicely formatted');
  682. WriteAt(30,12,lightgreen,black,
  683. 'Return true if the printer is available ');
  684. WriteAt(30,13,lightgreen,black,
  685. 'Prints screen, same as pressing PrtSc');
  686. WriteAt(30,14,lightgreen,black,
  687. 'Clears the keyboard buffer completely');
  688. WriteAt(30,15,lightgreen,black,
  689. 'Returns the heap space available');
  690. WriteAt(30,16,lightgreen,black,
  691. 'Returns string with a char repeated');
  692. WriteAt(30,17,lightgreen,black,
  693. 'Pauses for key stroke and returns key');
  694. WriteAt(30,18,lightgreen,black,
  695. 'An annoying Beep');
  696. WriteAT(47,19,lightgreen,black,'String and number conversions');
  697. Wait_for_KeyPress(Ch);
  698. RestoreScreen(1);
  699. DisposeScreen(1);
  700. end;
  701. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  702. {                              O P T I O N      7                             }
  703. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  704. Procedure Printout;
  705. begin
  706. Mkwin(10,8,70,18,white,red,1);
  707. Offcursor;
  708. WriteAT(15,10,white,red,'The documentation is contained in file Manual.TTT');
  709. WriteAT(15,11,white,red,'and it contains no formatting characters. The page');
  710. WriteAT(15,12,white,red,'length is set to 66 and all lines are less than 80');
  711. WriteAT(15,13,white,red,'characaters long.');
  712. WriteAT(15,15,white,red,'At the DOS prompt type Print Manual.TTT , be warned');
  713. WriteAT(15,16,white,red,'the documentation is good but it''s more than 50 pages.');
  714. WriteAT(50,18,white,red,' press any key .... ');
  715. Wait_for_Keypress(Ch);
  716. Rmwin;
  717. end;
  718. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  719. {                              O P T I O N      8                             }
  720. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  721. Procedure Help;
  722. const
  723. X1 = 40;
  724. Y1 = 5;
  725. X2 = 80;
  726. Y2 = 25;
  727. C1 = lightgray;
  728. C2 = blue;
  729. C3 = white;
  730. C4 = lightcyan;
  731. begin
  732. Mkwin(X1,Y1,X2,Y2,C1,C2,3);
  733. Offcursor;
  734. WriteBetween(X1,X2,Y1+1,C3,C2,'Help');
  735. WriteAT(X1+4,Y1+3,C4,C2,'This system gives you a whirl');
  736. WriteAT(X1+4,Y1+4,C4,C2,'wind tour of Technojocks Turbo ');
  737. WriteAT(X1+4,Y1+5,C4,C2,'Toolkit. Simply highlight the  ');
  738. WriteAT(X1+4,Y1+6,C4,C2,'topic of interest and press Enter');
  739. WriteAT(X1+4,Y1+7,C4,C2,'or press the number prefix,or ');
  740. WriteAT(X1+4,Y1+8,C4,C2,'press the function key. ');
  741. WriteAT(X1+4,Y1+10,C4,C2,'This whole demo program was built');
  742. WriteAT(X1+4,Y1+11,C4,C2,'using the toolkit. If you like it');
  743. WriteAT(X1+4,Y1+12,C4,C2,'let me know.');
  744. WriteAT(X2-18,Y1+13,C4,C2,'Bob Ainsbury');
  745. WriteAT(X2-18,Y1+15,C4,C2,'P.O. Box 2197');
  746. WriteAT(X2-18,Y1+14,C4,C2,'Technojock');
  747. WriteAT(X2-18,Y1+16,C4,C2,'Houston TX 77252');
  748. WriteAT(X2-18,Y1+17,C4,C2,'(713) 293-2760');
  749. WriteBetween(X1,X2,Y2-1,C3,C2,'press any key ...');
  750. Wait_for_Keypress(Ch);
  751. RmWin;
  752. end;
  753.  
  754. Procedure Initialize;
  755. begin
  756. Clrscr;
  757. Box(25,1,55,5,white,black,1);
  758. WriteBetween(25,55,3,lightgray,black,'Technojocks Turbo Toolkit');
  759. WriteBetween(25,55,4,lightgray,black,'V3.0');
  760. WriteCenter(7,white,black,'"In the software business since Tuesday"');
  761. WriteAT(19,10,white,black,'This is a program that demonstrates the power of');
  762. WriteAT(19,11,white,black,'Technojocks Turbo Toolkit. Remember, the toolkit');
  763. WriteAT(19,12,white,black,'is for IBM compatibles. The toolkit is for both');
  764. WriteAt(19,13,white,black,'monochrome and color systems BUT this demo is');
  765. WriteAt(19,14,white,black,'full of dazzling color - sorry monochromers you');
  766. WriteAt(19,15,white,black,'will have to use your imagination!');
  767. WriteAt(19,17,white,black,'Bitches, gripes, thanks, kisses, donations to:');
  768. WriteAt(30,19,white,black,'Bob Ainsbury');
  769. WriteAt(30,20,white,black,'Technojock');
  770. WriteAt(30,21,white,black,'P.O. Box 2197');
  771. WriteAT(30,22,white,black,'Houston, TX 77252');
  772. WriteAT(5,25,white,black,'Does this machine suffer from snow ? (Y/N) [answer N if unsure]');
  773. GotoXy(70,25);
  774. Wait_For_Keypress(Ch);
  775. If upcase(Ch) = 'Y' then snow := true;
  776. Clrscr;
  777. OffCursor;
  778. Box(25,22,55,25,lightgray,black,1);
  779. WriteBetween(25,55,23,lightgray,black,'Technojocks Turbo Toolkit');
  780. WriteBetween(25,55,24,lightgray,black,'V3.0');
  781. Main_Choice := 1;
  782. Define_Menu1;
  783. end;
  784.  
  785. Procedure Finish;
  786. begin
  787.  ClrScr;
  788.  OnCursor;
  789.  write('TechnoJocks Turbo Toolkit');
  790.  Halt;
  791. end;
  792.  
  793. begin     {main program}
  794. Initialize;
  795. repeat
  796.  DisplayMenu(M1,false,Main_choice,Error);
  797.  Case Main_Choice of
  798.  1 :Toolkit_Explained;
  799.  2 :Explain_Fastwrite;
  800.  3 :Explain_Windows;
  801.  4 :Explain_Menu;
  802.  5 :Explain_IO;
  803.  6 :Explain_Misc;
  804.  7 :PrintOut;
  805.  8 :Help;
  806.  9 :Finish;
  807.  end;  {case}
  808. until true = false;  {a very very very long time !}
  809. end.
  810.  
  811.