SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00002 MENU MANAGEMENT ROUTINES 1 05-28-9313:51ALL SWAG SUPPORT TEAM MENUDEMO.PAS IMPORT 18 Program Menu; Uses Crt;ππConstπ MenuChoice : Array[1..3] of String[9] = ('Choice #1', 'Choice #2',π 'Choice #3');π MenuPosX = 35; MenuPosY = 10;π NumberChoices = 3;ππTypeπ keys = (ReturnKey,Up,Down,Escape);ππVarπ Key : keys;π fk : Boolean;π ch : Char;π x, y, CurrentChoice : Integer;ππProcedure SetChoiceColor(back,Fore : Integer);πbeginπ TextBackGround(back);π TextColor(Fore);πend;ππProcedure GetKey;πbeginπ fk := False;π ch := ReadKey;π if ch = #0 thenπ beginπ fk := True;π ch := ReadKey;π end;π if fk thenπ beginπ Case ord(ch) ofπ 72 : key := Up;π 80 : key := Down;π end; end;π if not fk thenπ beginπ Case ord(ch) ofπ 13 : key := ReturnKey;π 27 : key := Escape;π end;π end;π end;ππbeginπ SetChoiceColor(7,0); {.. reverse vid black on white }π For x := 1 to NumberChoices doπ begin {.. Write menu options }π GotoXY(MenuPosX,MenuPosY+x-1);π if x > 1 then SetChoiceColor(0,7); {..turn reverse off after }π Write(MenuChoice[x]); { first option written }π end;π GotoXY(MenuPosX,MenuPosY); {..position curosr on 1st option }π CurrentChoice := 1;ππ Repeatπ GetKey; {..wait For a key to be pressed }π SetChoiceColor(0,7); {..reverse vid white on black }π Write(MenuChoice[CurrentChoice]); {..un-highlight current option }ππ Case key ofπ Up : if CurrentChoice > 1 then dec(CurrentChoice)π else CurrentChoice := NumberChoices;π Down : if CurrentChoice < 3 then inc(CurrentChoice)π else CurrentChoice := 1;π end;ππ SetChoiceColor(7,0); {..reverse vid black/white }π GotoXY(MenuPosX,MenuPosY+CurrentChoice-1);π Write(MenuChoice[CurrentChoice]); {..highlight new option }π GotoXY(MenuPosX,MenuPosY+CurrentChoice-1);π Until (Key = ReturnKey) or (Key = Escape);ππ SetChoiceColor(0,7);ππ Case CurrentChoice ofπ 1 : Writeln('Helloo 1');π end;ππend.π 2 05-28-9313:51ALL SWAG SUPPORT TEAM MENUUNIT.PAS IMPORT 43 {πThis is Turbo Pascal Unit is sent in reply to uuj@ufu107.phys.ufl.edu inπrequest For help on menu's. I was purely fed up With the TMenu options,πand so I created my own menu Unit. Although it is space consuming in dataπinitialization, this Unit enables Programmers to enhance their Programs. Ifπuser defined menus are required For your Program, a Text Program can beπcreated from the Program containing the initialization information. A simpleπcall can clear the screen and push the menu onto your screen. The info forπusage all exists within the Interface portion of the Unit, so I won't troubleπmyself With typing everything down. If this Unit is indeed helpful, pleaseπsend me a copy of the end product so I can view the work of which thisπnineteen year old Programmer has helped with...π L. Saxon Joseph Ralph Lewisπ}πππUnit JMenu;ππInterfaceππUsesπ Crt;ππTypeπ WinCord = Recordπ Xa : Byte;π Xb : Byte;π Ya : Byte;π Yb : Byte;π end;π MenuList = Recordπ MenuLink : Integer;π MenuName : String;π Question : String;π OpenState : String;π NumItems : Integer;π Items : Array [1..15] of String;π ItemCode : Array [1..15] of Char;π end;ππVarπ Win : WinCord;π List : MenuList;π Xdc,π Ydc : Integer;π Code : Char;ππProcedure Border(X, Y : Integer; BackGround : Integer; Color : Integer);πProcedure MenuScr(X, Y : Integer; BackGround : Integer; Color : Integer);πProcedure Println(PStr : String);πProcedure Print(PStr : String);πFunction SrchErr(Cher : Char; List : MenuList) : Boolean;πProcedure ShowError;πProcedure Menu(X, Y :Integer; BackGround : Integer; Color : Integer;π List : MenuList);πProcedure Command(X, Y :Integer; BackGround : Integer; Color : Integer;π List : MenuList);πProcedure InitMenu(Var List : MenuList);πππImplementationππProcedure Border(X,Y : Integer; BackGround : Integer; Color : Integer);πVarπ Xdc, Ydc : Integer;πbeginπ For Xdc := 2 to (X - 2) doπ beginπ GotoXY(Xdc + 1, 1);π Write(chr(205));π GotoXY(Xdc + 1, Y);π Write(chr(205));π end;π For Ydc := 2 to (Y - 3) doπ beginπ GotoXY(1, Ydc + 1);π Write(chr(186));π GotoXY(X, Ydc + 1);π Write(chr(186));π end;π GotoXY(2, 1);π Write(chr(201));π GotoXY(1, 2);π Write(chr(201));π GotoXY(2, 2);π Write(chr(188));π GotoXY(X - 1, 1);π Write(chr(187));π GotoXY(X, 2);π Write(chr(187));π GotoXY(X - 1, 2);π Write(chr(200));π GotoXY(1, Y - 1);π Write(chr(200));π GotoXY(2, Y);π Write(chr(200));π GotoXY(2, Y - 1);π Write(chr(187));π GotoXY(X, Y - 1);π Write(chr(188));π GotoXY(X - 1, Y);π Write(chr(188));π GotoXY(X - 1, Y - 1);π Write(chr(201)); {188}πend;ππProcedure MenuScr(X,Y : Integer; BackGround : Integer; Color : Integer);πbeginπ Window(1, 1, 80, 25);π TextBackground(Black);π ClrScr;π Win.Xa := 40 - Round(X / 2);π Win.Xb := 40 + Round(X / 2);π Win.Ya := 12 - Round(Y / 2);π Win.Yb := 12 + Round(Y / 2);π X := X + 1;π Y := Y + 1;π Window(Win.Xa, Win.Ya, Win.Xb, WIn.Yb);π TextBackground(BackGround);π TextColor(Color);π ClrScr;π Border(X, Y, BackGround, Color);π GotoXY(3, 3);πend;ππProcedure Println(PStr : String);πVarπ Xdc : Integer;πbeginπ If Length(PStr) > (Win.Xb - Win.Xa - 4) thenπ beginπ Writeln('Menu too small...');π Haltπ end;π Write(Pstr);π Xdc := WhereY;π GotoXY(3, Xdc + 1);πend;ππProcedure Print(PStr : String);πVarπ Xdc : Integer;πbeginπ If Length(PStr) > (Win.Xb - Win.Xa - 4) thenπ beginπ Writeln('Menu too small...');π Haltπ end;π Write(Pstr);πend;ππFunction SrchErr(Cher : Char; List : MenuList) : Boolean;πbeginπ SrchErr := True;π For Xdc := 1 to List.NumItems doπ If Cher = List.ItemCode[Xdc] Thenπ SrchErr := False;πend;ππProcedure ShowError;πVarπ Me : Char;π T, H : Integer;πbeginπ MenuScr(42, 8, Red, Yellow);π Println('An Error has been detected.');π Println('Please be careful in your');π Println('Value Entering...');π Print(' [Press Any Key to Continue]');π Me := ReadKey;π TextBackground(Black);π ClrScr;πend;ππProcedure Menu(X, Y : Integer; BackGround : Integer; Color : Integer;π List : MenuList);πVarπ PrnStr : String;π Cord : Char;πbeginπ MenuScr(X, Y, Background, Color);π Xdc := Round(X / 2) - round(Length(List.MenuName) / 2);π GotoXY(Xdc, 2);π Println(List.MenuName);π GotoXY(3, 4);π Println(List.OpenState);π For Xdc := 1 to List.NumItems doπ beginπ PrnStr := Concat(' ', List.ItemCode[Xdc], ' : ', List.Items[Xdc]);π Println(PrnStr);π end;π GotoXY(WhereX, WhereY + 1);π Print(List.Question);πend;ππProcedure Command(X, Y : Integer; BackGround : Integer; Color : Integer;π List : MenuList);πVarπ PrnStr : String;π Cord : Char;πbeginπ MenuScr(X, Y, Background, Color);π Xdc := Round(X / 2) - round(Length(List.MenuName) / 2);π GotoXY(Xdc, 2);π Println(List.MenuName);π GotoXY(3, 3);π Print(List.Question);πend;ππProcedure InitMenu(Var List : MenuList);πbeginπ TextBackGround(Black);π Window(1, 1, 80, 25);π ClrScr;π List.MenuName := '';π List.OpenState := '';π List.NumItems := 0;π For Xdc := 1 to 15 doπ List.Items[Xdc] := '';π For Xdc := 1 to 15 doπ List.Itemcode[Xdc] := ' ';π List.Question := '';πend;ππend.π
