home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TPPOPUPS.ZIP / POPDEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-08-25  |  9.2 KB  |  369 lines
  1. Program Popdemo;
  2.  
  3.   (* Demonstration of POPUPS unit *)
  4.  
  5. USES crt, popups;
  6.  
  7. {* Define menuBar *}
  8.  
  9. CONST MainMenu : menuRec = (
  10.             row : 1; interval : 26; fore : White; back :Green);
  11.       MainmenuText : string [67] = 'Demos                          Run                          Thru';
  12.  
  13. {* Define pull-down menus *}
  14.  
  15.       DemoMenu : popRec = (
  16.             left : 1; top : 3; right : 14; bottom : 7; style : 1;
  17.             normal : LightGray; hilite : LightGray;
  18.             normback : Blue; hiback : Magenta; border : Cyan);
  19.       DemoMenuText : string[33] =
  20.             'Show file   Walk popup  Graphics';
  21.  
  22.       RunMenu : popRec =(
  23.             left : 28; top : 3; right : 40; bottom : 6; style : 1;
  24.             normal : Yellow; hilite : Yellow;
  25.             normback : Blue; hiback : Magenta; border : White);
  26.       RunMenuText : string [21] = 'All Demos  Exit Menu';
  27.  
  28.       QuitMenu : popRec =(
  29.             left : 53; top : 3; right : 70; bottom : 6; style : 2;
  30.             normal : LightGray; hilite: LightGray;
  31.             normback : Red; hiback : Cyan; border : White);
  32.             QuitMenuText : string [31] = 'Quit Program    Exit This Menu';
  33.  
  34. {* Define windows for demos *}
  35.  
  36.        FileWindow : popRec =(
  37.              left : 2; top : 5; right : 75; bottom : 25; style : 2;
  38.              normal : LightGray; hilite : LightGray;
  39.              normback : Magenta; hiback : 0; border :LightBlue);
  40.  
  41.        Walker : popRec =(
  42.              left : 60; top : 1; right : 79; bottom : 6; style : 2;
  43.              normal : Red; hilite :0;
  44.              normback : Cyan; hiback : 0; border : Blue);
  45.        WalkerText : string [48] =
  46.              'This pop-up moves down by changing  top, bottom';
  47.  
  48.        SalesChart : popRec =(
  49.              left : 51; top : 9; right : 72; bottom : 22; style : 2;
  50.              normal : Cyan; hilite : 0;
  51.              normback : LightGray; hiback : 0; border : Blue);
  52.  
  53. {* -------------------------DEMO ROUTINES-------------------------- *}
  54.  
  55. PROCEDURE Showfile;
  56.  
  57.       { List the source of this program in FileWindow }
  58.       { Leave the window open afterwards }
  59.  
  60. VAR  ThisFile : TEXT;
  61.      Line     : string [80];
  62.  
  63. BEGIN
  64.   popShow (FileWindow);
  65.   Assign (ThisFile, 'SAILING.TXT');
  66.   Reset (ThisFile);
  67.   WHILE NOT eof (ThisFile) DO BEGIN
  68.     Readln (ThisFile, line);
  69.     Writeln (Line);
  70.   END;
  71.   Close (ThisFile);
  72. END;
  73.  
  74. {* -------------------------- *}
  75.  
  76. PROCEDURE WalkPopup;
  77.  
  78.       { Walk a pop-up down the right side of the display }
  79.       { Moves by successively incrementing top and bottom }
  80.  
  81. VAR   TopRow : INTEGER;
  82.  
  83. BEGIN
  84.   popShow (Walker);
  85.   FOR  TopRow := 2 to 19 DO BEGIN
  86.     popErase (walker);
  87.     Walker.top := TopRow;
  88.     Walker.bottom := TopRow + 5;
  89.     popShow (Walker);
  90.   END;
  91. END;
  92.  
  93. {* -------------------------- *}
  94.  
  95. PROCEDURE TextChart;
  96.  
  97.       { Simulate a sales results chart using simple text graphics }
  98.  
  99. CONST block = #219;
  100.  
  101.  
  102.   PROCEDURE DrawBar (column, height : INTEGER);
  103.  
  104.   VAR y : INTEGER;
  105.   BEGIN
  106.     FOR y := 10 DOWNTO (10 - height) DO BEGIN
  107.     GotoXY (column, y);
  108.     Write (block);
  109.   END;
  110. END;
  111.  
  112. BEGIN
  113.   popShow (SalesChart);
  114.   popCenter (SalesChart, 1, 'Sales Results');
  115.   TextColor (Green);
  116.   GotoXY (2,12); Write ('Projected');
  117.   DrawBar ( 2, 6);
  118.   DrawBar ( 7, 7);
  119.   DrawBar (12, 5);
  120.   DrawBar (17, 6);
  121.   TextColor (Red);
  122.   GotoXY (14, 12); Write ('Actual');
  123.   DrawBar ( 4, 5);
  124.   DrawBar ( 9, 6);
  125.   DrawBar (14, 7);
  126.   DrawBar (19, 8);
  127. END;
  128.  
  129. {* ------------------------CONTROL ROUTINES------------------------ *}
  130.  
  131. FUNCTION DemoResult : CHAR;
  132.  
  133.     { Pull down and act on Demos Menu }
  134.  
  135. VAR  key, wait : CHAR;
  136.      pick      : INTEGER;
  137.      exiting   : BOOLEAN;
  138.  
  139. BEGIN
  140.   pick := 1;
  141.   exiting := FALSE;
  142.   popShow (DemoMenu);
  143.   popHilite (DemoMenu, 1);
  144.   REPEAT
  145.  
  146.     { Get menu selection }
  147.     key := Keystroke;
  148.     popNormal (DemoMenu, pick);                    { remove hilite bar }
  149.     CASE key OF
  150.       'S'        : pick := 1;
  151.       'W'        : pick := 2;
  152.       'G'        : pick := 3;
  153.       DownCursor : BEGIN
  154.                      Inc (pick);
  155.                      If pick > 3 THEN pick := 1;     { wrap to top row }
  156.                    END;
  157.       UpCursor   : BEGIN
  158.                      Dec (pick);
  159.                      If pick = 0 THEN pick := 3;
  160.                    END;
  161.       LeftCursor : exiting := TRUE;
  162.       RiteCursor : exiting := TRUE;
  163.       Enter      : CASE pick OF          { Selection by cursor + enter }
  164.                      1 :key := 'S';
  165.                      2 :key := 'W';
  166.                      3 :key := 'G';
  167.                    END;
  168.       ELSE exiting := TRUE;                      { Pass back keystroke }
  169.     END;
  170.     popHilite (DemoMenu, pick);                      { hilite new pick }
  171.  
  172.     { Do demo if selected }
  173.     IF key IN ['S', 'W', 'G'] THEN BEGIN
  174.       CASE key OF
  175.         'S' : BEGIN
  176.                 ShowFile;
  177.                 wait := ReadKey;
  178.                 popErase (FileWindow);
  179.               END;
  180.         'W' : BEGIN
  181.                 WalkPopup;
  182.                 wait := ReadKey;
  183.                 popErase (walker);
  184.               END;
  185.         'G' : BEGIN
  186.                 TextChart;
  187.                 wait := ReadKey;
  188.                 popErase (SalesChart);
  189.               END;
  190.        END;
  191.      END;
  192.    UNTIL exiting;
  193.    popErase (DemoMenu);
  194.    DemoResult := key;
  195. END;
  196. {* -------------------------- *}
  197.  
  198. FUNCTION RunResult : CHAR;
  199.  
  200.       { Pull down and act on Run Menu }
  201.  
  202. VAR  key, wait  : CHAR;
  203.      pick       : INTEGER;
  204.      exiting    : BOOLEAN;
  205.  
  206. BEGIN
  207.   pick    := 1;
  208.   exiting := FALSE;
  209.   popShow (RunMenu);
  210.   popHilite (RunMenu,1);
  211.   REPEAT
  212.     key := Keystroke;                               { remove hilite }
  213.     popNormal (RunMenu, pick);
  214.     CASE key OF
  215.       DownCursor  : IF pick = 1 THEN pick := 2  ELSE pick := 1;
  216.       UpCursor    : IF pick = 1 Then pick := 2  ELSE pick := 1;
  217.       'E'         : exiting := TRUE;
  218.       LeftCursor  : exiting := TRUE;
  219.       RiteCursor  : exiting := TRUE;
  220.       Enter       : IF pick = 1 THEN key := 'A'
  221.                     ELSE BEGIN
  222.                       exiting := TRUE;
  223.                       key := 'E';
  224.                     END;
  225.       ELSE exiting := TRUE;                   { pass back keystroke }
  226.     END;
  227.     popHilite  (RunMenu, pick);                   { Hilite new pick }
  228.  
  229.     IF key = 'A' THEN BEGIN                   { Do all demos on 'A' }
  230.       ShowFile;
  231.       TextChart;
  232.       WalkPopup;
  233.       wait := ReadKey;                       { Wait for a keystroke }
  234.       popErase (Walker);                   { Retreat through popups }
  235.       popErase (SalesChart);
  236.       popErase (FileWindow);
  237.     END;
  238.  
  239.   UNTIL exiting;
  240.   popErase (RunMenu);
  241.   RunResult := key;
  242. END;
  243.  
  244. {* -------------------------- *}
  245.  
  246. FUNCTION QuitResult : CHAR;
  247.  
  248.       { Pull down and act on Quit Menu }
  249.  
  250. VAR  key     : CHAR;
  251.      pick    : INTEGER;
  252.      exiting : BOOLEAN;
  253.  
  254. BEGIN
  255.   pick := 1;
  256.   exiting := FALSE;
  257.   PopShow (QuitMenu);
  258.   popHilite (QuitMenu, 1);
  259.   REPEAT
  260.     key := Keystroke;
  261.     popNormal (QuitMenu, pick);
  262.     CASE key OF
  263.       DownCursor  : IF pick = 1 THEN pick := 2 ELSE pick := 1;
  264.       UpCursor    : IF pick = 1 THEN pick := 2 ELSE pick := 1;
  265.       'Q'         : exiting := TRUE;
  266.       'E'         : exiting := TRUE;
  267.       LeftCursor  : exiting := TRUE;
  268.       RiteCursor  : exiting := TRUE;
  269.       Enter       : BEGIN
  270.                       IF pick =1 THEN key := 'Q' ELSE key := 'E';
  271.                       exiting := TRUE;
  272.                     END;
  273.  
  274.      ELSE exiting := TRUE;                            { Pass back keystroke }
  275.    END;
  276.    popHilite (QuitMenu, pick);
  277.  UNTIL exiting;
  278.  popErase (QuitMenu);
  279.  QuitResult := key;
  280. END;
  281.  
  282. {* -------------------------- *}
  283.  
  284. PROCEDURE DoMainMenu;
  285.  
  286.       { Manages pull down menu selection }
  287.  
  288. TYPE MenuUp = ( Demos, Run, Thru);
  289.  
  290. VAR  quitting   : BOOLEAN;
  291.      MMsel      : MenuUp;
  292.      UserKey    : CHAR;
  293.  
  294. BEGIN
  295.   Quitting := FALSE;
  296.   MMsel    := Demos;
  297.   REPEAT
  298.     UserKey := chr (0);
  299.  
  300.     { Act on selected pull down }
  301.     CASE MMsel OF
  302.       Demos   : UserKey := DemoResult;
  303.       Run     : UserKey := RunResult;
  304.       Thru    : UserKey := QuitResult;
  305.     END;
  306.  
  307.     { Act on returned keystroke }
  308.     CASE UserKey OF
  309.       'E'        : MMsel := Demos;
  310.       'D'        : MMsel := Demos;
  311.       'R'        : MMsel := Run;
  312.       'T'        : MMsel := Thru;
  313.       'Q'        : Quitting := TRUE;
  314.       LeftCursor : IF MMsel = Demos THEN
  315.                      MMsel  := Thru
  316.                    ELSE
  317.                      Dec (MMsel);
  318.  
  319.       RiteCursor : IF MMSEL = Thru THEN
  320.                      MMsel  := Demos
  321.                    ELSE
  322.                      Inc (MMsel);
  323.       END;
  324.    UNTIL quitting;
  325.  END;
  326.  
  327. {* ----------------------------------------------------------------- *}
  328.  
  329. BEGIN      { *** Main Program *** }
  330.  
  331.   { Initialize object text pointers }
  332.   MainMenu.choice   := @MainMenuText;
  333.   DemoMenu.contents := @DemoMenuText;
  334.   RunMenu.contents  := @RunMenuText;
  335.   QuitMenu.contents := @QuitMenuText;
  336.   Walker.contents   := @WalkerText;
  337.  
  338.   { Set up screen and go }
  339.   ClrScr;
  340.   Cursoff;
  341.   showMenubar (MainMenu);
  342.   DoMainMenu;
  343.  
  344.   { Make sure cursor is on before quitting }
  345.   Curson;
  346.   ClrScr;
  347.  END.
  348.  
  349.  
  350.  
  351.  
  352.  
  353.  
  354.  
  355.  
  356.  
  357.  
  358.  
  359.  
  360.  
  361.  
  362.  
  363.  
  364.  
  365.  
  366.  
  367.  
  368.  
  369.