Program pr0;
Uses
PTCCrt,
Dos,
PTCGraph;
Const
DefBkColor = 7;
DefFont = 7;
DefColor = 8;
ChoiceColor = 1;
Var
Drv, Mode, Variant : integer;
OptionName : array [1..10] of WideString;
Step, OptionQuants : byte;
BreakFlag : boolean;
Procedure ReDraw(ActiveOption : ShortInt);
Begin
SetBkColor(DefBkColor);
SetTextStyle(DefFont, 0, 3);
for Step := 1 to OptionQuants do
Begin
if (Step = ActiveOption) then SetColor (ChoiceColor);
OutTextXY(
Round(GetMaxX / 2) - Round(TextWidth(OptionName[Step]) / 2),
Round(GetMaxY / 2) + TextHeight(OptionName[Step]) * (Step - Round(OptionQuants / 2) + 1),
OptionName[Step]
);
if (Step = ActiveOption) then SetColor(DefColor);
End;
End;
Function CallMenu : shortint;
Var
ActiveOption : ShortInt;
Key, QuitKey : Char;
Begin
ActiveOption := 1;
repeat
ReDraw(ActiveOption);
Key := ReadKey;
Case Key of
#72 : dec(ActiveOption);
#80 : inc(ActiveOption);
#27 : CloseGraph;
End;
if (ActiveOption < 1) then ActiveOption := OptionQuants;
if (ActiveOption > OptionQuants) then ActiveOption := 1;
Until Key = #13;
CallMenu := ActiveOption;
End;
Procedure ShowLesson(ActiveOption : ShortInt);
Var
Part : String;
PartQuants : integer;
Key : char;
Begin
ClearDevice;
str(ActiveOption, Part);
Part := 'selected #' + Part;
OutText(Part);
while NOT ((Key = #13) OR (Key = #81)) do
Begin
Key := Readkey;
if Key = #81 then BreakFlag := True;
End;
ClearDevice;
End;
Begin
Drv := VGA;
Mode := 2;
InitGraph(Drv, Mode, '');
OptionQuants := 5;
OptionName[1] := 'Выбрать лекцию №';
OptionName[2] := 'Открыть самую объемную лекцию';
OptionName[3] := 'Показать справку';
OptionName[4] := 'Показать лучший результат';
OptionName[5] := 'Выйти';
BreakFlag := false;
Repeat
ShowLesson(CallMenu);
Until BreakFlag = true;
CloseGraph;
end.
В SUN'овском - не могу исправить проблемы с ужасными шрифтами.