Chip 1999 September/Chip_1999-09_cd.bin/internet/Jeremy/tp/downloads/menuq.pas

Pascal/Delphi Source File | 1999-08-03 | 5KB | 213 lines

Unit Menuq;
interface

 const MEnable=true;
       MDisable=false;

 procedure MReadItems(IJmeno: string; IPrikaz: word; IPlatna: boolean;
                      IText: string);
 function OpenMenu(x,y: byte;MName: string): word;

implementation
 uses crt,savewind,vstupy;

 type MenuItems=array[1..20] of record
                                jmeno: string;
                                prikaz: word;
                                platna: boolean;
                                text: string;
                                end;

 var
      MNormal,
      MSelect,
      MSelDis,
      MInfo,
      MTitle,
      MFramS: byte;

 var
    MItems: MenuItems;
    MCount, MPos, MLast,MWidth: byte;
    Menux, Menuy, MOldx, MOldy: byte;
    OldAttr: byte;
    MPlace: pbuf;

procedure MNul;
begin
     MPos:=1;
     MLast:=1;
     oldattr:=textattr;
     textattr:=MNormal;
     MCount:=0;
     MWidth:=0;
end;

procedure MFrame(x1,y1,x2,y2: byte);
var I: byte;
begin
     textattr:=MNormal;
     gotoxy(x1-1,y1-1);
     write('┌');
     for I:=x1 to x2 do write('─');
     textattr:=MFramS;
     write('┐');
     textattr:=MNormal;
     for I:=y1 to y2 do
      begin
           gotoxy(x1-1,i);
           write('│');
      end;
     textattr:=MFramS;
     for I:=y1 to y2 do
      begin
           gotoxy(x2+1,i);
           write('│');
      end;
     textattr:=MNormal;
     gotoxy(x1-1,y2+1); write('└');
     textattr:=MFramS;
     for I:=x1 to x2 do write('─');
     write('┘');
end;

function InfoLn(S: string): string;
var I: integer;
begin
     for I:=1 to 36-(length(S) div 2) do s:=concat(' ',s,' ');
     Infoln:=s;
end;

procedure CloseMenu;
begin
     restorewin(menux-1,menuy-1,menux+MWidth,menuy+MCount,MPlace);
     MNul;
end;

procedure MReadItems(IJmeno: string; IPrikaz: word; IPlatna: boolean;
                     IText: string);
begin
     MCount:=MCount+1;
     MItems[MCount].jmeno:=IJmeno;
     MItems[MCount].prikaz:=IPrikaz;
     MItems[MCount].platna:=IPlatna;
     MItems[MCount].text:=IText;
end;

procedure MLongItem;
const Q: byte = 0;
var I,J: byte;
begin
     for I:=1 to MCount do
      if Q<(Length(MItems[i].jmeno)) then Q:=Length(MItems[i].jmeno);

     MWidth:=Q;

     for I:=1 to MCount do
      begin
           for J:=Ord(MItems[i].jmeno[0]) to MWidth-1 do
            MItems[i].jmeno:=MItems[i].jmeno+' ';
      end;
end;

function OpenMenu(x,y: byte;MName: string): word;
label 1;
var I: byte;
    key: char;
begin
     menux:=x;
     menuy:=y;
     MPos:=1;
     MLongItem;
     Savewin(menux-1,menuy-1,menux+MWidth,menuy+MCount,MPlace);
     MFrame(menux,menuy,menux+MWidth-1,menuy+MCount-1);
     gotoxy(x+(MWidth div 2)-(Length(MName) div 2)-1,menuy-1);
     textattr:=MTitle;
     write(' ',MName,' ');
     for I:=0 to MCount-1 do
      begin
           gotoxy(menux,menuy+i);
           textattr:=MNormal;
           if i+1 = MPos then
            begin
                 textattr:=MSelect;
                 write(MItems[i+1].jmeno);
                 MOldx:=wherex;
                 MOldy:=wherey;
                 textattr:=MInfo;
                 gotoxy(4,23);
                 write(infoln(MItems[i+1].text));
                 gotoxy(moldx,moldy);
            end
           else
               begin
                    if MItems[i+1].platna=MDisable then textattr:=MInfo;
                    write(MItems[i+1].jmeno);
               end;
      end;
1:
      repeat
            key:=GetLegalKey([Up, Down, CR]);
            case key of
            Up:
               begin
                    MLast:=Mpos;
                    MPos:=Mpos-1;
                    if MPos=0 then MPos:=MCount;
               end;
            Down:
                 begin
                      MLast:=MPos;
                      MPos:=Mpos+1;
                      if MPos=Mcount+1 then Mpos:=1;
                 end;
            end;

      gotoxy(menux,menuy+mLast-1);
      textattr:=MNormal;
      if MItems[MLast].platna=MDisable then textattr:=MInfo;
      write(MItems[MLast].jmeno);

      gotoxy(menux,menuy+MPos-1);
      textattr:=MSelect;
      if MItems[MPos].platna=MDisable then textattr:=MSelDis;
      write(MItems[MPos].jmeno);
      moldx:=wherex;
      moldy:=wherey;
      gotoxy(4,23);
      textattr:=MInfo;
      write(infoln(Mitems[Mpos].text));
      gotoxy(moldx,moldy);

     until key=CR;

     if MItems[MPos].platna=MEnable then
      OpenMenu:=Mitems[Mpos].prikaz
     else goto 1;

     CloseMenu;
end;

var dosmode: byte absolute $0000:$0449;

BEGIN
      if dosmode<>7 then
       begin
      MNormal:=16*lightgray+black;
      MSelect:=16*blue+yellow;
      MSelDis:=16*blue+lightgray;
      MInfo:=16*lightgray+darkgray;
      MFramS:=16*lightgray+white;
      MTitle:=16*lightgray+blue;
       end
      else
       begin
       MNormal:=16*lightgray+black;
       MSelect:=16*black+white;
       MSelDis:=16*black+green;
       MInfo:=16*lightgray+black;
       MFramS:=16*lightgray+black;
       MTitle:=16*lightgray+black;
      end;
END.