{
-------------------------------------------------------------------------
Pascal code for creating a menu-bar
(Probably not the most optimied thing around, but it does the job)
All code by me except the Save_Screen/Restore_Screen and
HideCursor/ShowCursor procedures that I found in SWAG.
This thing can off course be expanded to include shortcuts to menus and
so on, use your imagination!
Needed files:
menuunit.pas - menu-system unit
menusys.pas - example program
-------------------------------------------------------------------------
(c) Anders Gardebring 27/1 1997
Contact me at:
Email:
khaan@algonet.se
www:
[Bu Adresi (link) Görme Yetkiniz Yok BEDAVA'ya Üye Ol Sitemizden Faydalan....]
-------------------------------------------------------------------------
This code is almost Public Domain.
It may be freely copied, altered and included in any program of
any kind as long as credit is given to the author.
This program is used to create a menu like the ones you can find in
MS-DOS editor, or Turbo Pascal.
See menusys.pas for an example program!
-------------------------------------------------------------------------
}
unit menuunit;
interface
uses crt;
const MaxHead = 10; {Max number of mainmenus}
MaxSub = 20; {Max number of submenus}
{ End of constant declarations ---------------------------------}
var Loop, Loop2 : Byte;
ch : char;
TmpStr : String;
MenuText : Array [1..MaxHead, 1..MaxSub] of String [40];
{Text in menus}
HeadPos : Array [1..MaxHead] of Byte;
{X-Position of the different main-menus}
MenuPos_X, {x and}
MenuPos_Y : Byte; {y position for the menu}
Activated_Main, {Activated Main-menu}
Activated_Sub : Byte; {Activated sub-menu}
C_MenuBack,
C_MenuText,
C_Disabled,
C_HighBack,
C_HighText,
C_HighDisabled: Byte; {Colors for the menu system}
Max_X, Max_Rows: Byte;
Selected_Main,
Selected_Sub: Byte; {Used to detect activated menu}
Buffer : Array[1..4000] of Byte;
{Used for Save_Screen and Restore_Screen}
{ End of variable declarations ---------------------------------}
Procedure HideCursor;
Procedure ShowCursor;
Procedure Save_Screen; {Save Text Screen}
Procedure Restore_Screen; {Restore Text Screen}
Procedure Draw_Box (x1, y1, x2, y2: Byte);
Procedure Draw_Shadow_Box (x1, y1, x2, y2: Byte);
Procedure Start_Menu_Sys;
Procedure Add_Menu (Txt: String; Head, Sub: Byte); {Add a menu}
Procedure Bottom_Bar (Txt: String);
Procedure Reset_Menu;
Procedure Create_Menu (x, y, MenuLen: Byte);
function Selected (head, sub: Byte): Boolean;
Procedure Clear_Selected;
implementation
Procedure Clear_Selected;
Begin
Selected_Main := 0;
Selected_Sub := 0;
End;
function Selected (head, sub: Byte): Boolean;
{Used to determine which menu has been selected, see
menusys.pas}
Begin
Selected := False;
If (Selected_Main = head) And (Selected_Sub = sub) Then
Selected := True;
End; {selected}
Procedure HideCursor; Assembler;
Asm
mov ax, 0100h
mov cx, 2607h
int 10h
end; {HideCursor}
Procedure ShowCursor; Assembler;
Asm
mov ax, 0100h
mov cx, 0506h
int 10h
end; {ShowCursor}
Procedure Save_Screen; {Save Text Screen}
begin
Move(Mem[$B800:0000],Buffer,4000);
end; {Save_Screen}
Procedure Restore_Screen; {Restore Text Screen}
begin
Move(Buffer,Mem[$B800:0000],4000);
end; {Restore_Screen}
Procedure Draw_Box (x1, y1, x2, y2: Byte); {Draw a box with current colors}
var D_Loop, D_Loop2: Byte;
Begin
Window (x1, y1, x2, y2); {Fix the background of the box}
ClrScr;
Window (1, 1, 80, 25);
{Draw Lines at the corners of the box:}
For D_Loop := x1 + 1 to x2 - 1 do
Begin
GotoXy (D_Loop, y1);
Write ('Ä');
GotoXy (D_Loop, y2);
Write ('Ä');
End;
For D_Loop := y1 + 1 to y2 - 1 do
Begin
GotoXy (x1, D_Loop);
Write ('³');
GotoXy (x2, D_Loop);
Write ('³');
End;
GotoXy (x1, y1);
Write ('Ú');
GotoXy (x2, y1);
Write ('¿');
GotoXy (x1, y2);
Write ('À');
GotoXy (x2, y2);
Write ('Ù');
End; {Draw_Box}
Procedure Draw_Shadow_Box (x1, y1, x2, y2: Byte);
{Draw a box with a shadow}
Begin
Draw_Box (x1, y1, x2, y2);
TextColor (0);
For Loop := y1 + 1 to y2 do
Begin
GotoXy (x2 + 1, Loop);
Write ('ÛÛ');
End;
For Loop := x1 + 2 to x2 + 2 do
Begin
GotoXy (Loop, y2 + 1);
Write ('Û');
End;
End; {Draw_Shadow_Box}
Procedure Draw_Sub_Menu (Number: Byte); {Draw a submenu}
Procedure Draw_Sub_Text; {Print menu text}
Begin
For Loop := 1 to Max_Rows do
Begin
TextColor (C_MenuText);
TextBackGround (C_MenuBack);
If (Loop = Activated_Sub) and (Number = Activated_Main) Then
Begin
TextColor (C_HighText);
TextBackGround (C_HighBack);
GotoXy (MenuPos_X + HeadPos [Number] - 1, MenuPos_Y + Loop + 1);
TmpStr := '';
For Loop2 := 1 to Max_X + 2 do
TmpStr := TmpStr + ' ';
Write (TmpStr);
End;
GotoXy (MenuPos_X + HeadPos [Number], MenuPos_Y + Loop + 1);
If MenuText [Number, Loop + 1] <> '-' Then
{Is current menu a separator?}
Begin {No, it ain't}
Write (MenuText [Number, Loop + 1]);
End
Else {Current menu is a separator}
Begin
TmpStr := '';
For Loop2 := 1 to Max_x + 2 do
TmpStr := TmpStr + 'Ä';
TmpStr := 'Ã' + TmpStr + '´';
GotoXy (MenuPos_X + HeadPos [Number] - 2, MenuPos_Y + Loop + 1);
Write (TmpStr);
end;
End;
TextColor (C_MenuText);
TextBackGround (C_MenuBack);
End; {Draw_Sub_Text}
Begin
TextBackGround (C_MenuBack); {Set colors}
TextColor (C_MenuText);
Max_X := 0;
Max_Rows := 0;
{Get number of rows in this submenu:}
For Loop := 1 to MaxSub do
If MenuText [Number, Loop] <> '' Then
Inc (Max_Rows);
{Calculate the longest string in this menu:}
For Loop := 1 to Max_Rows do
Begin
If Length (MenuText [Number, Loop]) >Max_X Then
Max_X := Length (MenuText [Number, Loop]);
End;
{Draw a box for this submenu}
Draw_Shadow_Box (MenuPos_X + HeadPos [Number] - 2, MenuPos_y + 1,
MenuPos_X + HeadPos [Number] + 1 + Max_X, MenuPos_y + 1 + Max_Rows);
Draw_Sub_Text; {Print text for this submenu}
End; {Draw_Sub_Menu}
Procedure Draw_Menu_Bar (x, y: Byte); {Draw the mainmenu}
Var Pos: Byte;
Begin
TextBackGround (c_MenuBack); {Set colors}
TextColor (c_MenuText);
MenuPos_X := x;
MenuPos_Y := y;
GotoXy (x, y);
Write (' ');
pos := 2;
For Loop := 1 to MaxHead do
Begin
If MenuText [Loop, 1] <> '' Then
Begin
Write (MenuText [Loop, 1], ' ');
HeadPos [Loop] := Pos;
Inc (Pos, Length (MenuText [Loop, 1]) + 2);
End;
End;
End; {Draw_Menu_Bar}
Procedure Create_Menu (x, y, MenuLen: Byte); {Create a new menu from
specified values at
position x, y}
Begin
Window (x, y, x+ MenuLen, y);
TextBackGround (C_MenuBack);
ClrScr;
Window (1, 1, 80, 25);
Draw_Menu_Bar (x, y);
End; {Create_Menu}
Procedure Reset_Menu; {Clear all menu values}
Begin
Activated_Main := 0;
Activated_Sub := 0;
MenuPos_X := 0;
MenuPos_Y := 0;
For Loop := 1 to MaxHead do
Begin
HeadPos [Loop] := 0;
For Loop2 := 1 to MaxSub do
MenuText [Loop, Loop2] := '';
End;
End; {Reset_Menu}
Procedure Add_Menu (Txt: String; Head, Sub: Byte); {Add a menu}
Begin
MenuText [Head, Sub] := Txt;
End; {Add_Menu}
Procedure Bottom_Bar (Txt: String);
Begin
TextBackGround (C_MenuBack);
Window (1, 25, 80, 25);
ClrScr;
TextColor (C_MenuText);
Write (' ' + Txt);
Window (1, 1, 80, 25);
End; {Bottom_Bar}
Procedure Start_Menu_Sys;
Procedure Do_Menu;
Begin
Draw_Sub_Menu (Activated_Main);
End; {Do_Menu}
Procedure Do_Menu2;
Begin
Save_Screen;
TextBackGround (C_HighBack);
TextColor (C_HighText);
GotoXy (MenuPos_X + HeadPos [Activated_Main] - 1, MenuPos_Y);
Write (' ' + MenuText [Activated_Main, 1] + ' ');
Do_Menu
End; {Do_Menu2}
Begin
Activated_Main := 1; {Standard menu selected at menu startup}
Activated_Sub := 1;
Do_Menu2;
Selected_Main := 0;
Selected_Sub :=0;
Repeat
ch := ReadKey;
If ch = #13 Then
Begin
Selected_Main := Activated_Main;
Selected_Sub := Activated_Sub + 1;
End;
If ch = #0 Then {Right button pressed}
Begin
ch := ReadKey;
If ch = #77 Then
Begin
Restore_Screen;
Inc (Activated_Main);
If MenuText [Activated_Main, 1] = '' Then Dec (Activated_Main);
Activated_Sub := 1;
Do_Menu2;
End;
If ch = #75 Then {Left button pressed}
Begin
Restore_Screen;
Dec (Activated_Main);
If Activated_Main = 0 Then Activated_Main := 1;
Activated_Sub := 1;
Do_Menu2;
End;
If ch = #72 Then {Up key pressed}
Begin
Dec (Activated_Sub);
If MenuText [Activated_Main, Activated_Sub + 1] = '-' Then Dec(Activated_Sub);
If MenuText [Activated_Main, Activated_Sub] = '' Then Activated_Sub := Max_Rows - 1;
Do_Menu;
End;
If ch = #80 Then {Down key pressed}
Begin
Inc (Activated_Sub);
If MenuText [Activated_Main, Activated_Sub + 1] = '-' Then Inc(Activated_Sub);
If MenuText [Activated_Main, Activated_Sub + 1] = '' Then Activated_Sub := 1;
Do_Menu;
End;
End;
Until (ch = #27) or (ch = #13);
Restore_Screen;
End;
begin
end.
görsel menu
Normal
