home *** CD-ROM | disk | FTP | other *** search
/ Collection of Education / collectionofeducationcarat1997.iso / COMPUSCI / TOT11.ZIP / TOTDEM11.ZIP / TOTDEMO.PAS < prev   
Pascal/Delphi Source File  |  1991-02-11  |  44KB  |  1,128 lines
  1. program TOTDEMO;
  2. {               Copyright 1991 TechnoJock Software, Inc.               }
  3. {                          All Rights Reserved                         }
  4. {                         Restricted by License                        }
  5.  
  6. {                             Build # 1.00a                            }
  7. {$M 16000,250000,250000}
  8. {$I TOTFLAGS.INC}
  9.  
  10. {   
  11.     This is the main demo program, designed to show the capabilities 
  12.     of TechnoJock's Object Toolkit. The majority of the Toolkit demos 
  13.     are educational and illustrative, rather than flashy! This file 
  14.     combines many of the smaller demo programs and adds a touch of 
  15.     glamor. (If you're from New York, don't worry about the glamor!)
  16. }
  17.  
  18. {  COMPILATION PROBLEMS:
  19.  
  20.    Memory:  1) Enable the FINAL directive in TOTFLAGS.INC
  21.             2) Set Compile destination to disk
  22.             3) Set Link to disk
  23.             4) Set Link Mapfile off
  24.             5) Trim your config.sys and remove TSRs
  25.             6) Disable integrated and standalone debugging
  26.  
  27.             If you still have problems, run the command line 
  28.             compiler: TPC or TPCX
  29.  
  30.    File not found:   Update the Unit, Include and OBJ Options 
  31.                      Directories to point to the Toolkit
  32.                      directory.
  33.  
  34.    Unit File Format Error:  Select Compile Build to force recompilation
  35.                             of all Toolkit units.
  36.  
  37. }
  38.  
  39. uses DOS, CRT,
  40.      totSYS, totINPUT, totFAST, totWIN, totMSG, totLINK,
  41.      totLIST, totDIR, totIO1, totIO2, totIO3, totMENU,
  42.      totSTR, totDATE, totMISC,
  43.      extWIN;
  44. var  MainMenu: MoveMenuOBJ;
  45.      Choice: byte;  
  46.      SaveScreen: ScreenOBJ;
  47.  
  48. procedure Error(Line1,Line2:string);
  49. {}
  50. var PopUp:MessageOBJ;
  51. begin
  52.    with PopUp do
  53.    begin
  54.       Init(1,' Error ');
  55.       AddLine('');
  56.       AddLine(Line1);
  57.       AddLine(Line2);
  58.       AddLine('');
  59.       Show;
  60.       Done;
  61.    end;
  62. end; {Error}
  63. {||||||||||||||||||||||||||||||||||}
  64. {                                  }
  65. {     I n t r o   S c r e e n      }
  66. {                                  }
  67. {||||||||||||||||||||||||||||||||||}
  68. procedure Sparkle;
  69. {}
  70. var 
  71.   tempX,tempC:byte;
  72.   I : integer;
  73. begin
  74.    with Key do
  75.       with Screen do
  76.       begin
  77.           delay(1000);
  78.           for I := 5 to 11 do
  79.           begin
  80.               if keypressed then exit;
  81.               Attrib(5,I,78,I,yellow);
  82.               delay(75);
  83.           end;
  84.           delay(500);
  85.           for I := 13 to 18 do
  86.           begin
  87.               if keypressed then exit;
  88.               Attrib(5,I,78,I,lightgreen);
  89.               delay(75);
  90.           end;
  91.           for I := 1 to 80 do
  92.           begin
  93.               if keypressed then exit;
  94.               Attrib(I,20,I,20,lightcyan);
  95.               delay(15);
  96.           end;
  97.           repeat
  98.                tempX := Random(27);
  99.                TempC := Random(6);
  100.                Inc(TempC,9);
  101.                Attrib(27+tempX,2,27+tempX,2,TempC);
  102.                TempX := Random(40);
  103.                Attrib(20+tempX,20,20+tempX,20,TempC);
  104.                delay(50);
  105.           until Keypressed;
  106.       end;
  107. end; {Sparkle}
  108.  
  109. procedure Banner;
  110. {}
  111. var StartUp: ScreenOBJ;
  112. begin
  113.    with StartUp do
  114.    begin
  115.       Init;
  116.       Create(80,25,white);
  117.       Box(25,1,55,3,white,1);
  118.       WriteAt(27,2,7,'TechnoJock''s Object Toolkit');
  119.       WriteAT(5,5,15,'This program demonstrates the power of TechnoJock''s Object Toolkit for');
  120.       WriteAT(5,6,15,'Borland''s Turbo Pascal v5.5 and v6.0 (on IBM and true compatibles).');
  121.       WriteAT(5,7,15,'If you experience any difficulty using the product, please call or');
  122.       WriteAt(5,8,15,'write to us. More information about the Toolkit is located in the');
  123.       WriteAt(5,9,15,'README.COM file and in the documentation.');
  124.       WriteAt(5,11,15,'For further information, contact:');
  125.       WriteAt(30,13,15,'TechnoJock Software, Inc.');
  126.       WriteAt(30,14,15,'P.O. Box 820927');
  127.       WriteAT(30,15,15,'Houston, TX 77282');
  128.       WriteAT(30,17,15,'Voice (713) 493-6354');
  129.       WriteAT(30,18,15,'Fax   (713) 493-5872');
  130.       WriteCenter(23,15,'Copyright (c) 1991 TechnoJock Software, Inc.');
  131.       WriteCenter(24,15,'Restricted by License');
  132.       SlideDisplay(down);
  133.    end; 
  134.    Screen.CursOff;
  135.    Screen.WriteRight(80,25,7,'Press any key to continue...');
  136.    if not Key.Keypressed then
  137.       Screen.WriteClick(20,20,white,'"In the Software business since Tuesday"');
  138.    if Monitor^.ColorOn then
  139.       Sparkle;
  140.    Key.GetInput;
  141. end; {Banner}
  142.  
  143. procedure Introduction;
  144. {}
  145. var
  146.   PopUp: PromptOBJ;
  147.   Result: tAction;
  148. begin
  149.    Screen.Clear(white,'░'); {paint the screen}
  150.    with PopUp do
  151.    begin
  152.       Init(1,' TechnoJock''s Object Toolkit ');
  153.       AddLine('');
  154.       AddLine('   This is a demo of the Object Toolkit from   ');
  155.       AddLine('   TechnoJock Software, Inc. Please do not ');
  156.       AddLine('   run this demo while intoxicated! ');
  157.       AddLine('');
  158.       AddLine('       Would you like to see the demo? ');
  159.       AddLine('');
  160.       SetOption(1,'  Oh ~Y~es  ',89,Finished);
  161.       SetOption(2,'  Hell ~N~o  ',78,Escaped);
  162.       Result := Show;
  163.       Done;
  164.       if Result = Escaped then
  165.       begin
  166.          Writeln('Be like that!');
  167.          halt;
  168.       end;
  169.    end;
  170.    Banner;
  171. end; {Introduction}
  172. {|||||||||||||||||||||||||||||}
  173. {                             }
  174. {     M e n u   S t u f f     }
  175. {                             }
  176. {|||||||||||||||||||||||||||||}
  177. procedure SetUpMenu;
  178. {}
  179. begin
  180.    with MainMenu do
  181.    begin
  182.       Init;
  183.       SetStyleTitle(6,' TechnoJock''s Object Toolkit ');
  184.       SetMessageXY(0,24);
  185.       SetGap(5);
  186.       Win^.SetClose(false);
  187.       Win^.SetBoundary(1,1,80,23);
  188.       AddItem('');
  189.       AddFullItem(' ~I~ntroduction               ',1,73,
  190.                   'Displays a screen describing the main Toolkit features',nil);
  191.       AddFullItem(' ~F~orm Input                 ',2,70,
  192.                   'Get an idea of the power of the Toolkit''s form management facility',nil);
  193.       AddFullItem(' Display ~D~irectories        ',3,68,
  194.                   'Use the Toolkit''s directory display objects',nil);
  195.       AddFullItem(' ~B~rowse Lists, etc.         ',4,66,
  196.                   'Use the Toolkit''s browse and list objects',nil);
  197.       AddFullItem(' Display ~M~enus              ',5,77,
  198.                   'View Pull-down and Lotus-style menus',nil); 
  199.       AddFullItem(' ~S~trings and Dates          ',6,83,
  200.                   'A description of some of the other fine units!',nil);
  201.       AddFullItem(' ~H~ardware                   ',7,72,
  202.                   'Using the totSYS unit to determine system hardware',nil);
  203.       AddFullItem(' I~n~ternational Features     ',8,78,
  204.                   'A description of the Toolkit''s international aspects',nil);
  205.       AddFullItem(' ~V~iewing the "read me" file ',9,86,
  206.                   'Displays all the late breaking news about the Toolkit',nil);
  207.       AddFullItem(' ~P~rinting the documentation ',10,80,
  208.                   'Information on how to print the User''s Manual',nil);
  209.       AddFullItem(' P~u~rchasing the Toolkit     ',11,85,
  210.                   'How to buy a copy of the Toolkit', nil);
  211.       AddItem('');
  212.       AddFullItem(' ~Q~uit                       ',99,81,
  213.                   'Go do summat else',nil);
  214.    end;
  215.    Screen.PartClear(1,1,80,22,white,'░'); {paint the screen}
  216.    Screen.PartClear(1,23,80,25,30,' '); 
  217. end; {SetUpMenu}
  218. {|||||||||||||||||||||||||}
  219. {                         }
  220. {     O p t i o n    1    }
  221. {                         }
  222. {|||||||||||||||||||||||||}
  223. procedure IntroOption;
  224. {uses a scrollable virtual window to display the text}
  225. var
  226.   InfoData: ScreenOBJ;
  227.   InfoWin: VirtualWinOBJ;
  228. begin
  229.    with InfoData do
  230.    begin
  231.       Init; 
  232.       Create(80,46,71);
  233.       WriteAt(1,1,75,'What is the Object Toolkit?');
  234.       WritePlain(5,3,'TechnoJock''s Object Toolkit (or simply the Toolkit) is a library of');
  235.       WritePlain(5,4,'objects, procedures and functions for Pascal programmers. While writing');
  236.       WritePlain(5,5,'a PC program, most people s