home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / toolkid / bigdemo.dem next >
Encoding:
Text File  |  1980-01-01  |  10.8 KB  |  235 lines
  1. PROGRAM BigDemo;
  2.  
  3. USES IOSTUFF,MENUBOX,MENU123,MENUPULL,DIR,GETCOLOR,GETLINE,POPASCII,DRAWBOX,CRT;
  4.  
  5. CONST
  6.    Abort = #0;
  7. VAR
  8.    ExitNow     : boolean;        { Exit switch }
  9.    MainMenu    : AnyStr;         { Main menu string }
  10.    FilSubMenu  : AnyStr;         { 1st submenu string }
  11.    ScrSubMenu  : AnyStr;         { 2nd submenu string }
  12.    BoxSubMenu  : AnyStr;         { 4th submenu string }
  13.    MenuSubMenu : AnyStr;         { 5th submenu string }
  14.    DummyFile   : AnyStr;         { Dummy to hold pickfile }
  15.    Fore,Back   : Integer;        { Foreground and background colors }
  16.    ChASCII     : Char;           { ASCII character returned from ChooseASCII }
  17.    ScreenPick  : Char;           { Returns menu pick in screen menu }
  18.    Result      : Char;           { Character returned from menus }
  19.    X,Y         : Integer;        { Cursor location on screen }
  20.    TempStr     : AnyStr;         { Used in reading string from screen }
  21.    II          : Integer;        { Loop index }
  22.    PCh         : Char;
  23. {============================================================================}
  24. PROCEDURE Pause;                 { Write a message and wait for a keystroke }
  25. BEGIN
  26.   WriteSt('Hit any key to proceed',1,25);
  27.   PCh := ReadKey;
  28. END;
  29. {============================================================================}
  30. BEGIN
  31.   Fore := Cyan;               { default colors }
  32.   Back := Black;
  33.   SetColor(Fore,Back);        { Set colors }
  34.   ClrScr;
  35.   X := 10;                    { cursor location for drawbox }
  36.   Y := 5;
  37.  
  38.   MainMenu :=('File/'+        { String for main menu }
  39.               'Screen/'+
  40.               'GetLine/'+
  41.               'Menus/'+
  42.               'Boxes/'+
  43.               'Info./');
  44.  
  45.   FilSubMenu :=('Directory/'+   { String for file submenu }
  46.                 'Change Dir/'+
  47.                 'Pick File/'+
  48.                 'Quit/');
  49.  
  50.   ScrSubMenu :=('Select Colors/'+      { String for screen submenu }
  51.                 'Clear Screen/'+
  52.                 'ASCII Char./'+
  53.                 'Fill Screen/');
  54.  
  55.   BoxSubMenu :=('Draw w Cursor/'+      { String for screen submenu }
  56.                 'Border demo/');
  57.  
  58.   MenuSubMenu :=('Box Menus/'+      { String for screen submenu }
  59.                  '123 Menus/'+
  60.                  'Pulldown Menus/');
  61.  
  62. ExitNow := false;              { turn off exit switch }
  63.  
  64. FillScr('░');
  65.  
  66. SetMain(MainMenu);           { Setup the main menu }
  67. SetSub(1,FilSubMenu);        { Setup the file submenu under main choice 1 }
  68. SetSub(2,ScrSubMenu);        { Setup the screen submenu under main choice 2 }
  69. SetSub(5,BoxSubMenu);        { Setup the box submenu under main choice 4}
  70. SetSub(4,MenuSubMenu);       { Setup the box submenu under main choice 5}
  71. Repeat Case PickMain of            { Get user's pick from the main menu}
  72. 'F' :  Begin                       { User picked F (file) from main menu}
  73.         Case PickSub(1) of         { now get user's pick from 1st submenu }
  74.         'D': Begin                 { User picked D (directory) from submenu }
  75.               ShowDir;
  76.               Pause;
  77.              End;
  78.         'C': Begin                 { User picked C from submenu }
  79.               ShowDir;
  80.               ChangePath;
  81.               Pause;
  82.              End;
  83.         'P': Begin                 { User picked P from submenu }
  84.               DummyFile := PickFile;
  85.               WriteSt('You picked file: '+DummyFile,1,24);
  86.               GoToXY(1,25);ClrEol;
  87.               Pause;
  88.              End;
  89.         'Q': Exit;                 { User picked Q from submenu }
  90.         End; {case}
  91.        End;
  92.  
  93. 'S' :  Begin                          { User picked S from main menu }
  94.         WriteSt('╒════════════════════════════════════════════╕',33,7);
  95.         WriteSt('│ Note that this submenu behaves differently │',33,8);
  96.         WriteSt('│ than the rest.  Control is retained by the │',33,9);
  97.         WriteSt('│ submenu until you hit escape or up arrow.  │',33,10);
  98.         WriteSt('╘════════════════════════════════════════════╛',33,11);
  99.         Repeat
  100.          ScreenPick := PickSub(2);       { Get user's pick from submenu 2 }
  101.          Case ScreenPick of
  102.         'S': Begin                       { User picked S from submenu }
  103.               SetChooseColor(40,12);     { Set the location of the color smorgasbord }
  104.               ChooseColor(Fore,Back);    { Let user select color }
  105.               SetColor(Fore,Back);       { set the color }
  106.              End;
  107.  
  108.         'C': Begin                       { User picked C from submenu }
  109.               ClrScr;
  110.               SaveWorkScreen;
  111.              End;
  112.  
  113.         'A': Begin                       { User picked A from submenu }
  114.               SetChooseASCII(32,3);      { set the location of the ASCII selector }
  115.               ChASCII := ChooseASCII;         { Let user choose ASCII character }
  116.              End;
  117.  
  118.         'F': Begin
  119.               FillScr(ChASCII);               { Fill the screen with the character }
  120.               SaveWorkScreen;
  121.              End;
  122.         End; {case}
  123.        Until ScreenPick = Abort;            { Remain in menu until user hits esc }
  124.        End;
  125.  
  126. 'M' :  Begin
  127.         Case PickSub(4) of
  128.         'B' : Begin
  129.                WriteSt('╒════════════════════════════════════════════╕',3,21);
  130.                WriteSt('│ Box menus are little popup menus that are  │',3,22);
  131.                WriteSt('│ easy to setup and use.  Try this one out.  │',3,23);
  132.                WriteSt('╘════════════════════════════════════════════╛',3,24);
  133.                SetMenuBox(10,10,'Crawl like a baby/Walk like a man/Run like the devil/'+
  134.                                 'Fly like an eagle/Warp 5/');
  135.                Result := PickMenuBox;
  136.               End;
  137.         '1' : Begin
  138.                WriteSt('╒════════════════════════════════════════════╕',3,21);
  139.                WriteSt('│ 123 menus are bar menus that also are easy │',3,22);
  140.                WriteSt('│ to setup and use.  Try this one out.       │',3,23);
  141.                WriteSt('╘════════════════════════════════════════════╛',3,24);
  142.                SetMenu123(1,10,'Crawl/Walk/Run/Fly/Warp 5/');
  143.                Result := PickMenu123;
  144.               End;
  145.  
  146.         'P' : Begin
  147.                WriteSt('╒══════════════════════════════════════════════════════════════════╕',5,10);
  148.                WriteSt('│ Pulldown Menus are sophisticated, two-level menus that work like │',5,11);
  149.                WriteSt('│ the menus in Turbo Pascal 4.O edit.  Pulldown menus, because they│',5,12);
  150.                WriteSt('│ are so powerful and flexible, are also more complicated to use.  │',5,13);
  151.                WriteSt('│                                                                  │',5,14);
  152.                WriteSt('│ For example the programmer must assist the menu routines in      │',5,15);
  153.                WriteSt('│ knowing when to rebuild the menus over a new screen or when to   │',5,16);
  154.                WriteSt('│ just refresh the old screen.  The results are stunning however.  │',5,17);
  155.                WriteSt('│ The menus in this demonstration use the Pulldown routines.       │',5,18);
  156.                WriteSt('╘══════════════════════════════════════════════════════════════════╛',5,19);
  157.                Pause;
  158.               End;
  159.  
  160.          End; {case}
  161.        End;
  162.  
  163. 'B' :  Begin
  164.         Case PickSub(5) of
  165.         'D' : Begin
  166.                RestoreWorkScreen;
  167.                WriteSt('Use the arrow keys to draw a box on the screen.',1,23);
  168.                WriteSt('Draw a line over another line to see the intersection',1,24);
  169.                Box(X,Y);                  { Let user draw box }
  170.                SaveWorkScreen;
  171.               End;
  172.         'B' : Begin
  173.                RestoreWorkScreen;
  174.                For II := 1 to 4 do Border(10-II,10-II,30+II,15+II,'');
  175.                                    Border(5,5,35,20,'Double-line');
  176.                For II := 1 to 4 do SBorder(41-II,10-II,61+II,15+II,'');
  177.                                    SBorder(36,5,66,20,'Single-line');
  178.                SaveWorkScreen;
  179.               End;
  180.          End; {case}
  181.        End;
  182.  
  183. 'G' : Begin
  184.         WriteSt('╒════════════════════════════════════════════╕',30,3);
  185.         WriteSt('│ GetLine allows the user to edit a field    │',30,4);
  186.         WriteSt('│ and then returns the resulting string.     │',30,5);
  187.         WriteSt('│ All the usual editing keys work including  │',30,6);
  188.         WriteSt('│ insert.  If your first key is a letter the │',30,7);
  189.         WriteSt('│ routine assumes you want to start over.    │',30,8);
  190.         WriteSt('│ For example:                               │',30,9);
  191.         WriteSt('╘════════════════════════════════════════════╛',30,10);
  192.         SetColor(Yellow,Magenta);                  { Reverse colors }
  193.         WriteSt('                    ',45,9); { Write a blank area }
  194.         TempStr := 'Some Stuff';              { Set default string }
  195.         TempStr :=  GetStr(45,9,20,TempStr);  { Read string at location }
  196.                                               { 45,9 length 20 with default }
  197.                                               { set initially to TempStr    }
  198.         WriteSt('You entered ['+TempStr+'] -- Hit any key to proceed',1,24);Clreol;
  199.         SetColor(Fore,Back);
  200.         PCh := Readkey;
  201.         RestoreWorkScreen;
  202.         SaveWorkScreen;    { Restore then Save to trigger menu rewrite }
  203.        End;
  204.  
  205. 'I': Begin
  206.      ClrScr;
  207.       WriteSt('This program demonstrates a few high points from the Turbo Overdrive',3,6);
  208.       WriteSt('routines.  Just pick an item from the menu (which is itself an Overdrive',3,7);
  209.       WriteSt('routine) using the reverse video cursor and hit enter.  Or simply hit',3,8);
  210.       WriteSt('the first letter of the menu item you want to activate.',3,9);
  211.  
  212.       WriteSt('All Turbo Overdrive routines are written in straightforward Turbo',3,11);
  213.       WriteSt('Pascal 4.0 so that you can understand them and modify them to your',3,12);
  214.       WriteSt('liking.  Inline routines have been avoided whenever possible (there''s',3,13);
  215.       WriteSt('just one in the whole package).  All of the units are extremely well',3,14);
  216.       WriteSt('thought out and quite simple to use.  ',3,15);
  217.  
  218.       WriteSt('The Turbo Overdrive Package is being distributed under the user-supported',3,17);
  219.       WriteSt('concept.  You may freely copy the TOP disk for your evaluation and for the',3,18);
  220.       WriteSt('evaluation of others so long as no price or other consideration is charged.',3,19);
  221.       WriteSt('If you find the package useful we ask that you register as a Turbo Overdrive',3,20);
  222.       WriteSt('Package user by sending $20 to:',3,21);
  223.  
  224.      WriteSt(' Nescatunga Software ',55,22);
  225.      WriteSt(' Box 5942 ',55,23);
  226.      WriteSt(' Katy, TX 77450. ',55,24);
  227.      SaveWorkScreen;
  228.      End;
  229. #0 :  ExitNow := true;
  230. End;{case Pick}
  231.  
  232. Until ExitNow;          { Keep repeating big menu case until user exits }
  233.  
  234. END.
  235.