Паскаль / 2 семестр / курсач / CMENU

unit cmenu;

interface
type
MenuResult = Integer;
const
{Menu results - १г«мв вл ўлЎ®а  Їг­Є  ¬Ґ­о }
mrAboutProgramm : MenuResult = 1;
mrAboutStudent : MenuResult = 2;
mrFirstTask : MenuResult = 3; { ўлЇ®«­Ґ­ЁҐ ЇҐаў®Ј® § ¤ ­Ёп }
mrFirstTaskKeyboard : MenuResult = 4;
mrSecondTask : MenuResult = 5; { ўлЇ®«­Ґ­ЁҐ ўв®а®Ј® § ¤ ­Ёп }
mrSecondTaskKeyboard : MenuResult = 6;
mrExit : MenuResult = 7; { ўл室 Ё§ Їа®Ја ¬¬л }
dlgResultOk : integer = 1;
dlgResultCancel : integer = 2;

function ShowMenu (menuItem : MenuResult) : MenuResult;
function EnterString (var str : string; title : string) : integer;
procedure ShowString (str : string; topX, topY, botX, botY : byte; doReadKey : boolean);
procedure ShowCursor;
procedure HideCursor;

implementation
uses crt, dos;

type
TMenu = array [1..9] of string[31];
type
TDialog = array [1..6] of string[45];

const
{ Є®®а¤Ё­ вл ўҐае­ҐЈ® «Ґў®Ј® гЈ«  ¬Ґ­о }
baseX = 25;
baseY = 9;
{ ¬Ґ­о ў бва®Є®ў®¬ ЇаҐ¤бв ў«Ґ­ЁЁ }
MainMenu : TMenu = (
'ЙНННННННН ѓ« ў­®Ґ ¬Ґ­о ННННННН»',
'є Ћ Їа®Ја ¬¬Ґ є',
'є Ћ бв㤥­вҐ є',
'є ‡ ¤ ­ЁҐ 1 є',
'є ‡ ¤ ­ЁҐ 1 ўў®¤ б Є« ўЁ вгал є',
'є ‡ ¤ ­ЁҐ 2 є',
'є ‡ ¤ ­ЁҐ 2 ўў®¤ б Є« ўЁ вгал є',
'є ‚л室 є',
'ИНННННННННННННННННННННННННННННј');
const
dlgX = 18;
dlgY = 11;
strX = 2;
strY = 2;
emptyStr = ' ';
strOk = ' ЋЉ ';
strCancel = ' Ћв¬Ґ­  ';
btnOkX = 26;
btnCancelX = 35;
Dialog : TDialog = (
'ЙНННННННННН ‚ўҐ¤ЁвҐ Їгвм Є д ©«г ННННННННННН»',
'є є',
'є є',
'є є',
'є є',
'ИНННННННННННННННННННННННННННННННННННННННННННј');

{ --------------------- ”г­ЄжЁЁ ¤«п а Ў®вл б ¤Ё «®Ј®¬ ---------------------}

function readString (var str: string) : integer;
var
key : char;
maxLen, len : integer;
strToShow : string;
focus : integer;

procedure showString (activeItem : integer);
begin
if len > maxLen then
strToShow := Copy (str, len - maxLen + 1, maxLen)
else
strToShow := str;

if activeItem = 0 then
begin
TextBackground (Green);
showCursor;
end
else
begin
TextBackground (LightGray);
hideCursor;
end;
gotoXY (dlgX + strX, dlgY + strY);
write (emptyStr);
gotoXY (dlgX + strX, dlgY + strY);
write (strToShow);
end;

procedure showButtons (activeBtn : integer);
begin
TextColor (White);

if activeBtn = 1 then TextBackground (Green) else TextBackground (LightGray);
gotoXY (dlgX + btnOkX, dlgY + 4);
write (strOk);

if activeBtn = 2 then TextBackground (Green) else TextBackground (LightGray);
gotoXY (dlgX + btnCancelX, dlgY + 4);
write (strCancel);
end;
begin
maxLen := Length (emptyStr) - 1;
len := length (str);
focus := 0;
showButtons (focus);
showString (focus);

while (KeyPressed) do ReadKey;
repeat
key := ReadKey;
if key = #8 then
begin
if len > 0 then
begin
delete (str, len, 1);
dec (len);
end;
end
else if key = #9 then
begin
focus := focus + 1;
if focus > 2 then focus := 0;
showButtons (focus);
showString (focus);
end
else if (key <> #13) and (focus = 0) then
begin
str := str + key;
inc (len);
end;

if key <> #13 then showString(focus);
{write (ord (key));}
until (key = #13) and (focus > 0);

readString := focus;
end;

function EnterString (var str : string; title : string) : integer;
var
i : integer;
begin
{ ®зЁй Ґ¬ нЄа ­ }
TextBackground (Black);
ClrScr;

{ гбв ­®ўЁ¬ ­г¦­лҐ жўҐв  }
TextBackground (Blue);
TextColor (Yellow);

{ ®ваЁб㥬 бва®ЄЁ б гзҐв®¬ Ў §®ўле Є®®а¤Ё­ в }
for i:=1 to 6 do
begin
gotoXY (dlgX, dlgY + i - 1);
write (Dialog[i]);
end;

gotoXY (dlgX + strX, dlgY + strY - 1);
write (title);

TextBackground (Green);
TextColor (White);

EnterString := readString (str);

{ ў®бв ­®ўЁ¬ Ёб室­лҐ жўҐв  }
TextBackground (Black);
TextColor (White);
showCursor;
end;

{ ------------------------- ”г­ЄжЁЁ ¤«п а Ў®вл б ¬Ґ­о ---------------------}

{ Їа®жҐ¤га  ­ з «м­®© ®ваЁб®ўЄЁ ¬Ґ­о }
procedure drawMenu;
var
i : integer;
begin
{ гбв ­®ўЁ¬ ­г¦­лҐ жўҐв  }
TextBackground (Blue);
TextColor (Yellow);

{ ®ваЁб㥬 бва®ЄЁ ¬Ґ­о б гзҐв®¬ Ў §®ўле Є®®а¤Ё­ в }
for i:=1 to 9 do
begin
gotoXY (baseX, baseY + i - 1);
write (MainMenu[i]);
end;

{ ў®бв ­®ўЁ¬ Ёб室­лҐ жўҐв  }
TextBackground (Black);
TextColor (White);
end;

{ дг­ЄжЁп ¤«п ўЁ§г «м­®© ᬥ­л ўл¤Ґ«Ґ­­®Ј® н«Ґ¬Ґ­в  ¬Ґ­о }
procedure setSelectedMenuItem (selectedIndex : integer; prevIndex : integer);
begin
{ ­ ¤® § Єа бЁвм ў Ёб室­л© 梥⠯।л¤гйЁ© ўл¤Ґ«Ґ­­л© н«Ґ¬Ґ­в }
if prevIndex > 0 then
begin
TextBackground (Blue);
TextColor (Yellow);
gotoXY (baseX, baseY + prevIndex - 1);
write (MainMenu[prevIndex]);
end;

{ § Єа иЁў Ґ¬ ­®ўл© н«Ґ¬Ґ­в ў жўҐв  ўл¤Ґ«Ґ­Ёп }
TextBackground (Green);
TextColor (White);
gotoXY (baseX, baseY + selectedIndex - 1);
write (MainMenu[selectedIndex]);

{ ў®бв ­ ў«Ёў Ґ¬ Ёб室­лҐ жўҐв  }
TextBackground (Black);
end;

{ дг­ЄжЁп ®в®Ўа ¦ Ґв ¬Ґ­о ­  нЄа ­Ґ Ё Ї®§ў®«пҐв ўлЎа вм ®¤Ё­ Їг­Є
Ё ў®§ўа й Ґв  ©¤Ёи­ЁЄ ўлЎа ­­®Ј® Їг­Єв  }
function ShowMenu (menuItem : MenuResult) : MenuResult;
var
result : MenuResult;
selectedIndex : integer;
prevIndex : integer;
keyValue : char;
gotResult : boolean;
begin
result := mrExit;

{ ®зЁй Ґ¬ нЄа ­ Ё Їап祬 Єгаб®а }
TextBackground (Black);
ClrScr;
HideCursor;

{ ®ваЁб®ўлў Ґ¬ ¬Ґ­о Ё ўл¤Ґ«пҐ¬ ЇҐаўл© н«Ґ¬Ґ­в ў ­Ґ¬ }
drawMenu;
selectedIndex := menuItem + 1;
prevIndex := 1;
setSelectedMenuItem (selectedIndex, prevIndex);

{ ®зЁй Ґ¬ ЎгдҐа Є« ўЁ вгал }
while KeyPressed do ReadKey;
{ бзЁвлў Ґ¬ Є« ўЁил гЇа ў«Ґ­Ёп }
gotResult := false;
repeat
keyValue := ReadKey;
case keyValue of
{ ­ ¦ «Ё б⥫Єг ўўҐае - ­ ¤® ᬥ­Ёвм ўл¤Ґ«Ґ­­л© н«Ґ¬Ґ­в ¬Ґ­о }
#72: begin
if selectedIndex > 2 then
begin
prevIndex := selectedIndex;
dec (selectedIndex);
setSelectedMenuItem (selectedIndex, prevIndex);
end;
end;
{ ­ ¦ «Ё бв५Єг ў­Ё§ - ­ ¤® ᬥ­Ёвм ўл¤Ґ«Ґ­­л© н«Ґ¬Ґ­в ¬Ґ­о }
#80: begin
if selectedIndex < 8 then
begin
prevIndex := selectedIndex;
inc (selectedIndex);
setSelectedMenuItem (selectedIndex, prevIndex);
end;
end;
{ ­ ¦ «Ё ўў®¤ - § ўҐаи Ґ¬ а Ў®вг б ¬Ґ­о Ё ў®§ўа й Ґ¬  ©¤Ёи­ЁЄ
ўл¤Ґ«Ґ­­®Ј® н«Ґ¬Ґ­в  }
#13: begin
result := selectedIndex - 1;
gotResult := true;
end;
end;
until (gotResult); { ўл室Ё¬ Ї® ­ ¦ вЁо Є« ўЁил ўў®¤ }

{ Ї®Є §лў Ґ¬ Єгаб®а }
ShowCursor;

{ ў®§ўа й Ґ¬ १г«мв в }
ShowMenu := result;
end;

{ --------------------------- ђ Ў®в  б Єгаб®а®¬ -------------------------- }

procedure setCursorSize (begL, endL : byte);
var
regs : registers;
begin
with regs do
begin
Ah := $01;
Ch := begL;
Cl := endL;
end;
Intr ($10, regs);
end;

procedure ShowCursor;
begin
if Lastmode=mono then
setCursorSize ($0b, $0c)
else
setCursorSize ($06, $07);
end;

procedure HideCursor;
begin
setCursorSize ($20, $00);
end;

{ -------------------- ®Є®­з ­ЁҐ а Ў®вл б Єгаб®а®¬ ------------------------}

procedure ShowString (str : string; topX, topY, botX, botY : byte; doReadKey : boolean);
var
ptopX, ptopY, pbotX, pbotY : byte;

procedure createWindow;
var
delta : integer;
begin
delta := 0;
ptopX := lo (WindMin) + 1;
ptopY := hi (WindMin) + 1;
pbotX := lo (WindMax) + 1;
pbotY := hi (WindMax) + 1;
if doReadKey then delta := 1;
Window (topX + 1, topY + 1, botX - 1, botY - 1 - delta);
TextBackground (blue);
TextColor (white);
HideCursor;
end;
procedure restoreWindow;
begin
Window (ptopX, ptopY, pbotX, pbotY);
TextBackground (black);
TextColor (white);
ShowCursor;
end;
procedure drawBorder;
var
i : integer;
begin
TextBackground (blue);
TextColor (white);

gotoxy (topX, topY);
write ('Й');
for i:= 2 to botX - topX do
write ('Н');
write ('»');


gotoxy (topX, botY);
write ('И');
for i:= 2 to botX - topX do
write ('Н');
write ('ј');

for i:= 1 to botY - topY - 1 do
begin
gotoxy (topX, topY + i);
write ('є');
gotoxy (botX, topY + i);
write ('є');
end;

if doReadKey then
begin
gotoxy (topX + 1, botY - 1);
for i := 2 to botX - topX do
write (' ');
TextBackground (green);
gotoxy ((topX + (botX - topX - 8) div 2) + 1, botY - 1);
write (' OK ');
end;
end;
begin
drawBorder;
createWindow;
clrscr;

write (str);

if doReadKey then
begin
while keypressed do readkey;
readkey;
end;

restoreWindow;
end;

begin {unit}
end.