home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / menu.swg / 0002_MENUUNIT.PAS.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-28  |  5.4 KB  |  226 lines
  1. {
  2. This is Turbo Pascal Unit is sent in reply to uuj@ufu107.phys.ufl.edu in
  3. request For help on menu's.  I was purely fed up With the TMenu options,
  4. and so I created my own menu Unit.  Although it is space consuming in data
  5. initialization, this Unit enables Programmers to enhance their Programs.  If
  6. user defined menus are required For your Program, a Text Program can be
  7. created from the Program containing the initialization information.  A simple
  8. call can clear the screen and push the menu onto your screen.  The info for
  9. usage all exists within the Interface portion of the Unit, so I won't trouble
  10. myself With typing everything down.  If this Unit is indeed helpful, please
  11. send me a copy of the end product so I can view the work of which this
  12. nineteen year old Programmer has helped with...
  13.                                         L. Saxon Joseph Ralph Lewis
  14. }
  15.  
  16.  
  17. Unit JMenu;
  18.  
  19. Interface
  20.  
  21. Uses
  22.   Crt;
  23.  
  24. Type
  25.   WinCord = Record
  26.     Xa : Byte;
  27.     Xb : Byte;
  28.     Ya : Byte;
  29.     Yb : Byte;
  30.   end;
  31.   MenuList = Record
  32.     MenuLink  : Integer;
  33.     MenuName  : String;
  34.     Question  : String;
  35.     OpenState : String;
  36.     NumItems  : Integer;
  37.     Items     : Array [1..15] of String;
  38.     ItemCode  : Array [1..15] of Char;
  39.   end;
  40.  
  41. Var
  42.   Win  : WinCord;
  43.   List : MenuList;
  44.   Xdc,
  45.   Ydc  : Integer;
  46.   Code : Char;
  47.  
  48. Procedure Border(X, Y : Integer; BackGround : Integer; Color : Integer);
  49. Procedure MenuScr(X, Y : Integer; BackGround : Integer; Color : Integer);
  50. Procedure Println(PStr : String);
  51. Procedure Print(PStr : String);
  52. Function  SrchErr(Cher : Char; List : MenuList) : Boolean;
  53. Procedure ShowError;
  54. Procedure Menu(X, Y :Integer; BackGround : Integer; Color : Integer;
  55.                List : MenuList);
  56. Procedure Command(X, Y :Integer; BackGround : Integer; Color : Integer;
  57.                   List : MenuList);
  58. Procedure InitMenu(Var List : MenuList);
  59.  
  60.  
  61. Implementation
  62.  
  63. Procedure Border(X,Y : Integer; BackGround : Integer; Color : Integer);
  64. Var
  65.   Xdc, Ydc : Integer;
  66. begin
  67.   For Xdc := 2 to (X - 2) do
  68.   begin
  69.     GotoXY(Xdc + 1, 1);
  70.     Write(chr(205));
  71.     GotoXY(Xdc + 1, Y);
  72.     Write(chr(205));
  73.   end;
  74.   For Ydc := 2 to (Y - 3) do
  75.   begin
  76.     GotoXY(1, Ydc + 1);
  77.     Write(chr(186));
  78.     GotoXY(X, Ydc + 1);
  79.     Write(chr(186));
  80.   end;
  81.   GotoXY(2, 1);
  82.   Write(chr(201));
  83.   GotoXY(1, 2);
  84.   Write(chr(201));
  85.   GotoXY(2, 2);
  86.   Write(chr(188));
  87.   GotoXY(X - 1, 1);
  88.   Write(chr(187));
  89.   GotoXY(X, 2);
  90.   Write(chr(187));
  91.   GotoXY(X - 1, 2);
  92.   Write(chr(200));
  93.   GotoXY(1, Y - 1);
  94.   Write(chr(200));
  95.   GotoXY(2, Y);
  96.   Write(chr(200));
  97.   GotoXY(2, Y - 1);
  98.   Write(chr(187));
  99.   GotoXY(X, Y - 1);
  100.   Write(chr(188));
  101.   GotoXY(X - 1, Y);
  102.   Write(chr(188));
  103.   GotoXY(X - 1, Y - 1);
  104.   Write(chr(201)); {188}
  105. end;
  106.  
  107. Procedure MenuScr(X,Y : Integer; BackGround : Integer; Color : Integer);
  108. begin
  109.   Window(1, 1, 80, 25);
  110.   TextBackground(Black);
  111.   ClrScr;
  112.   Win.Xa := 40 - Round(X / 2);
  113.   Win.Xb := 40 + Round(X / 2);
  114.   Win.Ya := 12 - Round(Y / 2);
  115.   Win.Yb := 12 + Round(Y / 2);
  116.   X := X + 1;
  117.   Y := Y + 1;
  118.   Window(Win.Xa, Win.Ya, Win.Xb, WIn.Yb);
  119.   TextBackground(BackGround);
  120.   TextColor(Color);
  121.   ClrScr;
  122.   Border(X, Y, BackGround, Color);
  123.   GotoXY(3, 3);
  124. end;
  125.  
  126. Procedure Println(PStr : String);
  127. Var
  128.   Xdc : Integer;
  129. begin
  130.   If Length(PStr) > (Win.Xb - Win.Xa - 4) then
  131.   begin
  132.     Writeln('Menu too small...');
  133.     Halt
  134.   end;
  135.   Write(Pstr);
  136.   Xdc := WhereY;
  137.   GotoXY(3, Xdc + 1);
  138. end;
  139.  
  140. Procedure Print(PStr : String);
  141. Var
  142.   Xdc : Integer;
  143. begin
  144.   If Length(PStr) > (Win.Xb - Win.Xa - 4) then
  145.   begin
  146.     Writeln('Menu too small...');
  147.     Halt
  148.   end;
  149.   Write(Pstr);
  150. end;
  151.  
  152. Function SrchErr(Cher : Char; List : MenuList) : Boolean;
  153. begin
  154.   SrchErr := True;
  155.   For Xdc := 1 to List.NumItems do
  156.     If Cher = List.ItemCode[Xdc] Then
  157.       SrchErr := False;
  158. end;
  159.  
  160. Procedure ShowError;
  161. Var
  162.   Me   : Char;
  163.   T, H : Integer;
  164. begin
  165.   MenuScr(42, 8, Red, Yellow);
  166.   Println('An Error has been detected.');
  167.   Println('Please be careful in your');
  168.   Println('Value Entering...');
  169.   Print('  [Press Any Key to Continue]');
  170.   Me := ReadKey;
  171.   TextBackground(Black);
  172.   ClrScr;
  173. end;
  174.  
  175. Procedure Menu(X, Y : Integer; BackGround : Integer; Color : Integer;
  176.                List : MenuList);
  177. Var
  178.   PrnStr : String;
  179.   Cord   : Char;
  180. begin
  181.   MenuScr(X, Y, Background, Color);
  182.   Xdc := Round(X / 2) - round(Length(List.MenuName) / 2);
  183.   GotoXY(Xdc, 2);
  184.   Println(List.MenuName);
  185.   GotoXY(3, 4);
  186.   Println(List.OpenState);
  187.   For Xdc := 1 to List.NumItems do
  188.   begin
  189.     PrnStr := Concat('   ', List.ItemCode[Xdc], ' :  ', List.Items[Xdc]);
  190.     Println(PrnStr);
  191.   end;
  192.   GotoXY(WhereX, WhereY + 1);
  193.   Print(List.Question);
  194. end;
  195.  
  196. Procedure Command(X, Y : Integer; BackGround : Integer; Color : Integer;
  197.                   List : MenuList);
  198. Var
  199.   PrnStr : String;
  200.   Cord   : Char;
  201. begin
  202.   MenuScr(X, Y, Background, Color);
  203.   Xdc := Round(X / 2) - round(Length(List.MenuName) / 2);
  204.   GotoXY(Xdc, 2);
  205.   Println(List.MenuName);
  206.   GotoXY(3, 3);
  207.   Print(List.Question);
  208. end;
  209.  
  210. Procedure InitMenu(Var List : MenuList);
  211. begin
  212.   TextBackGround(Black);
  213.   Window(1, 1, 80, 25);
  214.   ClrScr;
  215.   List.MenuName  := '';
  216.   List.OpenState := '';
  217.   List.NumItems  := 0;
  218.   For Xdc := 1 to 15 do
  219.     List.Items[Xdc] := '';
  220.   For Xdc := 1 to 15 do
  221.     List.Itemcode[Xdc] := ' ';
  222.   List.Question := '';
  223. end;
  224.  
  225. end.
  226.