Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Центр помощи > [Pascal]Световое меню.


Автор: Dwane 17.3.2009, 18:46
Доброго времени суток.
Решал интересную задачу и столкнулся с такой проблеммой,не получается создать световое меню(light bar) т.е чтобы при нажатие стрелок(#72 #80) двигался премоуголник и выделял пункт.
Когда же меню удалось(кое как) не получилось им пользоватся.
Помогите пожалуйста кодом и если не трудно хотябы 1 пункт меню чтобы вызывал процедуру какую либо и возвращася послнее нее обратно в меню.
Заранее благодарен.

Автор: Al47 17.3.2009, 19:00
Вот такой пример нашел с ооп:
MENUUNIT:
Код

UNIT MenuUnit;
Interface
USES CRT;
CONST MaxMsgLen = 32;
TYPE
  MessageString = String[MaxMsgLen];

  EntryPointer = ^EntryType;
  EntryType = Object
    Prev, Next          : EntryPointer;
    XCor, YCor, ChoiceNo: Integer;
    Message             : MessageString;
    Constructor Init(ipr, inx: EntryPointer;
                      ix, iy, ic: Integer; im: MessageString);
    Procedure Draw(Selected: Boolean);
    Function GetChoice: Integer;
  END;

  BBMenu = Object
    XCor, YCor, Wid, Choices: Integer;
    FirstEntry, CurEntry    : EntryPointer;
    Constructor Init(ix, iy, iw: Integer);
    Destructor Done;
    Procedure AddPrompt(im: MessageString);
    Procedure Draw;
    Function GetChoice: Integer;
  END;

IMPLEMENTATION
  Constructor BBMenu.Init(ix, iy, iw: Integer);
  BEGIN
    XCor:= ix;
    YCor:= iy;
    Wid:= iw;
    IF Wid > MaxMsgLen THEN Wid:= MaxMsgLen;
    IF XCor + Wid > 80 THEN Wid:= 80 - XCor;
    FirstEntry:= NIL;
    Choices:= 0;
  END;

  Destructor BBMenu.Done;
  BEGIN
    IF FIrstEntry <> NIL THEN
    BEGIN
      FirstEntry^.Prev^.Next:= NIL;
      REPEAT
        CurEntry:= FirstEntry;
        FirstEntry:= FirstEntry^.Next;
        Dispose(CurEntry);
      UNTIL FirstEntry = NIL;
    END;
  END;

  Procedure BBMenu.AddPrompt(im: MessageString);
  VAR EP: EntryPointer;
  BEGIN
    INC(Choices);
    FillChar(im[Length(im) + 1], Wid - Length(im), ' ' );
    Im[0]:= Char(Wid);
    IF FirstEntry = NIL THEN
      BEGIN
        FirstEntry:= NEW(EntryPointer, INIT(NIL,
                         NIL, XCor, YCor + Choices - 1,
                         Choices, im));
        FirstEntry^.Next:= FirstEntry;
        FirstEntry^.Prev:= FirstEntry;
      END
    ELSE
      BEGIN
        EP:= NEW( EntryPointer, Init(FirstEntry^.Prev,
                  FirstEntry, XCor, YCor + Choices - 1,
                  Choices, Im));
        FirstEntry^.Prev^.Next:= EP;
        FirstEntry^.Prev:= EP;
      END;
    END;

  Procedure BBMenu.Draw;
  VAR ro, Co: BYTE;
  BEGIN
    GotoXY(XCor - 1, YCor - 1);      Write(#218);
    FOR Co:= 1 TO Wid DO Write(#196); Write(#191);
    FOR Ro:= YCor TO YCor + Choices - 1 DO
      BEGIN
        GotoXY(XCor - 1, ro);   Write(#179);
        GotoXY(XCor + Wid, ro); Write(#179);
      END;
    GotoXY(XCor - 1, YCor + Choices); Write(#192);
    FOR Co:= 1 to Wid DO Write(#196); Write(#217);
    CurEntry:= FirstEntry;
    REPEAT
      CurEntry^.Draw(False);
      CurEntry:= CurEntry^.Next;
    UNTIL CurEntry = FirstEntry;
  END;

  CONST
    KEnter = $000D;   KEsc   = $001B;
    KHome  = $4700;   KEnd   = $4F00;
    KLeft  = $4B00;   KRight = $4D00;
    KDown  = $5000;   KUp    = $4800;

  Function BBMenu.GetChoice: Integer;
  VAR
    SaveX, SaveY: Integer;
    Finished: Boolean;
    InChar: Char;
    Inword: Word;
  BEGIN
    SaveX:= WhereX;
    SaveY:= WhereY;
    Draw;
    Finished:= False;
    REPEAT
      CurEntry^.Draw(True);
      InChar:= ReadKey;
      IF (InChar = #0) AND KeyPressed THEN
        BEGIN
          InChar:= ReadKey;
          InWord:= Word(InChar) SHL 8;
        END
      ELSE InWord:= ORD(InChar);
      CurEntry^.Draw(False);
      CASE InWord OF
        KLeft, KUp   : CurEntry:= CurEntry^.Prev;
        KRight, KDown: CurEntry:= CurEntry^.Next;
        KHome        : CurEntry:= FirstEntry;
        KEnd         : CurEntry:= FirstEntry^.Prev;
        KEsc         : BEGIN
                         Finished:= True;
                         GetChoice:= 0;
                       END;
        KEnter       : BEGIN
                         Finished:= True;
                         GetChoice:= CurEntry^.GetChoice;
                       END;
      END;
    UNTIL Finished;
    GotoXY( SaveX, SaveY);
  END;

  CONSTRUCTOR EntryType.Init(ipr, inx: EntryPointer;
                             ix, iy, ic: Integer;
                             im: MessageString);
  BEGIN
    Prev    := ipr;
    Next    := inx;
    XCor    := ix;
    YCor    := iy;
    ChoiceNo:= ic;
    Message := im;
  END;

  Procedure EntryType.Draw(Selected: Boolean);
  BEGIN
    IF Selected THEN TextAttr:= $70
    ELSE TextAttr:= $07;
    GotoXY(XCor, YCor);
    Write(Message);
  END;

  Function EntryType.GetChoice: Integer;
  Begin
    GetChoice:= ChoiceNo;
  END;
END.

MENUDEMO:
Код

Program MenuDemo;
Uses MenuUnit, Crt;
Var
  Choice: Integer;
  M: BBMenu;
BEGIN
  CLRSCR;
  M.Init( 25, 7, 18);
  M.AddPrompt('Open a New File');
  M.AddPrompt('Existing File');
  M.AddPrompt('Close A File');
  M.AddPrompt('Quit');
  Choice:= M.GetChoice;
  GotoXY(1, 24); ClrEol;
  Case Choice OF
    0: Writeln('No Choice Was Made');
    1: Writeln('Procedure NewFile Should Be Called');
    2: Writeln('Procedure ExistingFile Should Be Called');
    3: Writeln('Procedure CloseFile Should Be Called');
    4: Writeln('Quitting ...');
  END;
  M.Done;
END.


Добавлено через 2 минуты и 5 секунд
Вот попроще пример, без ооп:
Код

uses crt;
const
   menu     :array[1..5] of string=(
   ' .:[ Choice 1 ]:. ',
   ' .:[ Choice 2 ]:. ',
   ' .:[ Choice 3 ]:. ',
   ' .:[ Choice 4 ]:. ',
   ' .:[   Quit   ]:. ');
var
   curchoice :byte;
   status    :byte;
   temp      :byte;
   ch        :char;

begin
  clrscr;
  curchoice:=1; status:=128; asm mov ah,01; mov cx,$2000; int $10; end;
  textcolor(7); for temp:=1 to 5 do writeln(menu[temp]);
  repeat
    gotoxy(1,curchoice); textcolor(15); textbackground(7); write(menu[curchoice]);
    gotoxy(76,1); textbackground(0); write(curchoice);
    gotoxy(76,2); write('   '); gotoxy(76,2); write(status);
    if keypressed then
      case readkey of
       #72: if curchoice>1 then begin
           textcolor(7); textbackground(0); gotoxy(1,curchoice);
           write(menu[curchoice]); dec(curchoice);
         end;
       #80: if curchoice<5 then begin
           textcolor(7); textbackground(0); gotoxy(1,curchoice);
           write(menu[curchoice]); inc(curchoice);
         end;
       #27: status:=5;
       #13: status:=curchoice;
      end;
  until status=5;
  asm mov ah,01; mov cx,$0E0D; int $10; end; textcolor(7); textbackground(0);
end.

Автор: Dwane 17.3.2009, 19:09
Вот первый вобще не катит.
А второй я находил и в нем сильно не смог разобатся

Он выводится в левом верхнем углу экрана а мне нужно бы по середине.По оси Х я его смог подвинуть а по У никак.

И еще в нем не получилось выйдти из процедуры не знаю почему.

Если можешь разбери его.

Автор: Al47 17.3.2009, 19:14
Ну с перемещение просто все, вроде... у нас же банально две координаты, просто в Y надо везде curchoice оставить а к нему уже своё число прибавить, например... Процедур вроде как тут нету, что имелось в виду?

Добавлено @ 19:16
Про перемещение глупость кончено написал, там курсов можно промотать... smile

Добавлено @ 19:22
Да, по идее пропускаем сначала несколько строк, а постом уже в цикле меняем координаты... 

Автор: Dwane 17.3.2009, 19:23
Имелось в виду что меню зачем?Чтобы выбирать программы.Вот у меня каждая програма которая в этом меню в виде  Procedure. И он почему то из нее не выходит.Ну например

Код

Procedure ab;
const
a=5
b=6
var
c:real;
begin
C:=a+b
write©;
readkey;
exit;
end;

Запрашиваю я ее в меню так

Код

case status of
1: ab;
end;


Он запускает процедуру но когда она заканчивается из нее не выходит.

Автор: Al47 17.3.2009, 19:28
Ну как-то, на вскидку, я паскаля совсем не знаю smile 
Код

uses crt;
const
   menu     :array[1..5] of string=(
   '                             .:[ Choice 1 ]:. ',
   '                             .:[ Choice 2 ]:. ',
   '                             .:[ Choice 3 ]:. ',
   '                             .:[ Choice 4 ]:. ',
   '                             .:[   Quit   ]:. ');
var
   curchoice :byte;
   status    :byte;
   temp      :byte;
   ch        :char;

begin
  clrscr;
  writeln(' ');
  writeln(' ');
  writeln(' ');
  writeln(' ');
  writeln(' ');
  writeln(' ');
  writeln(' ');
  curchoice:=1; status:=128; asm mov ah,01; mov cx,$2000; int $10; end;
  textcolor(7);

  for temp:=1 to 5 do writeln(menu[temp]);
  repeat
    gotoxy(1,curchoice+7); textcolor(15); textbackground(7); write(menu[curchoice]);
    gotoxy(76,8); textbackground(0); write(curchoice);
    gotoxy(76,9); write('   '); gotoxy(76,9); write(status);
    if keypressed then
      case readkey of
       #72: if curchoice>1 then begin
           textcolor(7); textbackground(0); gotoxy(1,curchoice+7);
           write(menu[curchoice]); dec(curchoice);
         end;
       #80: if curchoice<5 then begin
           textcolor(7); textbackground(0); gotoxy(1,curchoice+7);
           write(menu[curchoice]); inc(curchoice);
         end;
       #27: status:=5;
       #13: status:=curchoice;
      end;
  until status=5;
  asm mov ah,01; mov cx,$0E0D; int $10; end; textcolor(7); textbackground(0);
end.


Добавлено через 1 минуту и 13 секунд
Цитата(Dwane @  17.3.2009,  19:23 Найти цитируемый пост)

Он запускает процедуру но когда она заканчивается из нее не выходит.


Ну так, это в процедуре надо предусмотреть выход, я думаю...

Добавлено через 6 минут и 39 секунд
Цитата(Al47 @  17.3.2009,  19:28 Найти цитируемый пост)
Ну так, это в процедуре надо предусмотреть выход, я думаю... 


В смысле метку, например, сделать, хотя метки это не хорошо...

Автор: Dwane 17.3.2009, 19:44
Ладно,спасибо с процедурой сам справлюсь.
А вот можно в этой проге от асебмлера избавится?
Вот строчка
Код

asm mov ah,01; mov cx,$2000; int $10; end;

как написано в коментарии скрывает курсор чтобы не носился по экрану в цикле.

А 
Код

asm mov ah,01; mov cx,$0E0D; int $10; end;


что делате?

Просто я асемблер не знаю и если избавится от него было бы хорошо.

Автор: Al47 17.3.2009, 19:45
Ну вот так процедура работает... Но опять таки всё ужасно не красиво написано smile 
Код

uses crt;
const
   menu     :array[1..5] of string=(
   '                             .:[ Choice 1 ]:. ',
   '                             .:[ Choice 2 ]:. ',
   '                             .:[ Choice 3 ]:. ',
   '                             .:[ Choice 4 ]:. ',
   '                             .:[   Quit   ]:. ');
var
   curchoice :byte;
   status    :byte;
   temp      :byte;
   ch        :char;

Procedure ab;
const
a=5 ;
b=6;
var
c:real;
begin
C:=a+b;
write(c);
exit;
end;

begin
  clrscr;
  writeln(' ');
  writeln(' ');
  writeln(' ');
  writeln(' ');
  writeln(' ');
  writeln(' ');
  writeln(' ');
  curchoice:=1; status:=128; asm mov ah,01; mov cx,$2000; int $10; end;
  textcolor(7);

  for temp:=1 to 5 do writeln(menu[temp]);
  repeat
    gotoxy(1,curchoice+7); textcolor(15); textbackground(7); write(menu[curchoice]);
    gotoxy(76,8); textbackground(0); write(curchoice);
    gotoxy(76,9); write('   '); gotoxy(76,9); write(status);
    if keypressed then
      case readkey of
       #72: if curchoice>1 then begin
           textcolor(7); textbackground(0); gotoxy(1,curchoice+7);
           write(menu[curchoice]); dec(curchoice);
         end;
       #80: if curchoice<5 then begin
           textcolor(7); textbackground(0); gotoxy(1,curchoice+7);
           write(menu[curchoice]); inc(curchoice);
         end;
       #27: status:=5;
       #13: status:=curchoice;
      end;
      if status=1 then begin ab; status:=0; end;
  until status=5;
  asm mov ah,01; mov cx,$0E0D; int $10; end; textcolor(7); textbackground(0);
end.


Добавлено через 10 минут и 41 секунду
Цитата(Dwane @  17.3.2009,  19:44 Найти цитируемый пост)
как написано в коментарии скрывает курсор чтобы не носился по экрану в цикле.


Ну оно просто курсор убирает... я с паскалем плохо вообще знаком... можно оставить безобидный носящийся курсов, в принципе, а так для использования этой функции не обязательно асемблер же знать...

Автор: Dwane 17.3.2009, 20:45
Что-то не очень получается то что я хотел.
Если у кого есть варианты.Предлогайте

Автор: volvo877 17.3.2009, 22:15
Цитата(Dwane @  17.3.2009,  19:45 Найти цитируемый пост)
Если у кого есть варианты.Предлогайте 
Зайди вот сюда: http://volvo71.narod.ru/menus.htm , я специально выложил несколько вариантов построения меню...

И, на будущее, если получается не то, что ты хотел - может тебе стоит объяснить конкретнее, чего именно ты хочешь?

Автор: Dwane 18.3.2009, 08:13
volvo877
Спасибо. Вот пример графического меню довольно интересный попытаюсь разобратся.

А насчет точной формулировки я постораюсь описать подробнее.

Нужно меню.Чем проще чем лучше.Управление стрелками.Выбор enter'ом.И в нем должен быть хоть 1 рабочий пункт вызывающий процседуру созданную пользователем, которая бы очишала экран выполнялась на нем и возвращалось в меню.

Вот.

Ладно.Вопрос снят.Пример графического меню очень отичный.
Огромное спасибо volvo877.

Автор: Dwane 25.3.2009, 09:37
Вот,помогите найти ошибку в коде,не работает когда двигается вверх.

Код


Program Menu;
Uses Graph,Crt;
Var
X,X1,Y,Y1:Integer;{Координаты Прямоугольника который служит курсором}
PM,I:Word;{переменная определяющая номер пункта}
STOP:BOOLEAN;
Const
Massiv:Array [1..5] of string=('1','2','3','4','5');
kurs_up:=#72;
kurs_down:=#80;
Accept_Choise:=#13;
Procedure LG;
Var gDriver,gMode:integer;
Begin
 gDriver:=detect;
 InitGraph(gDriver,gMode,'c:\bgi');
 SetBkColor(0);
End;
 
Procedure HideMark;{Стирает курсор}
Begin
SetColor(0);
RectAngle(x,y,x1,y1);
End;

Procedure MarkGoOn1(Var x,y,z,p:integer;a:word);{Перемещает курсор на 1 пункт}
Begin
SetColor(15);
    y:=160;
    y1:=175;
    PM:=1;
    RectAngle(x,y,x1,y1);
End;
Procedure MarkGoDown(Var y,z:integer; a:Word);{Перемещая курсор на 1 пункт вниз}
Begin
SetColor(15);
    y:=y+50;
    y1:=y1+50;
    PM:=PM+1;
End;
 
Procedure MarkGoOn5(Var x,y,z,p:integer; a:word);{Перемещает на 5 пункт}
    Begin
    SetColor(15);
    Y:=360;
    Y1:=375;
    PM:=5;
    RectAngle(x,y,x1,y1);
    End;
Procedure MarkGoUp(y,z:integer;a:word);{Перемещает  на пункт вверх}
Begin
    SetColor(15);
    y:=y-50;
    y1:=y1-50;
    PM:=PM-1;
End;
 
Begin
Stop:=False;
LG;
SetColor(15);
PM:=1;
X:=220;
y:=160;
x1:=300;
y1:=175;
SetTextStyle(1,0,1);
For i:=1 to 5 do OutTextXY(x,y+(i*50)-55,massiv[i]);
 
Repeat
 
RectAngle(x,y,x1,y1);
 
Case ReadKey of
Kurs_Down:Begin
    HideMark;
    If PM=5 Then MarkGoOn1(x,y,x1,y1,pm)
    Else
    MarkGoDown(y,y1,pm);
    End;
Kurs_Up:Begin{Вот где-то сдесь ошибка}
    HideMark;
    If PM=1 Then MarkGoOn5(x,y,x1,y1,pm)
    Else
    MarkGoUp(y,y1,pm);
    End;
Accept_Choise:If PM=5 then Stop:=True;
End;
Until Stop=True;
End.

Автор: volvo877 25.3.2009, 11:30
Цитата(Dwane @  25.3.2009,  08:37 Найти цитируемый пост)
помогите найти ошибку в коде,не работает когда двигается вверх.

Код
Procedure MarkGoUp(VAR y,z:integer;a:word); { <--- VAR за тебя Пушкин будет добавлять? }
Begin
    SetColor(15);
    y:=y-50;
    y1:=y1-50;
    PM:=PM-1;
End;

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)