home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / PROGJRN / PJ_6_4.ARC / DEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-05-01  |  2.7 KB  |  119 lines
  1. Program MouseMenuDemo;
  2.  
  3. Uses Crt,Dos,Mouse;
  4. Type
  5.   Str30 = string[30];
  6.  
  7. Var
  8.   Result : byte;
  9.   i : integer;
  10.  
  11. Const
  12.   MaxItems = 5;
  13.   UpArrow = #200;         {Up arrow OR $80}
  14.   DownArrow = #208;       {Down arrow OR $80}
  15.   Home  = #199;           {Home OR $80}
  16.   EndKey = #207;          {End OR $80}
  17.   Inverse = $70;
  18.   Normal = $0E;
  19.   LB  = 1;
  20.   RB  = 2;
  21.   LRB = 3;
  22.   MB  = 4;
  23.   LMB = 5;
  24.   MRB = 6;
  25.   LMR = 7;
  26.   MenuItem : array[1..MaxItems] of str30 =
  27.      (' Menu Item #1 ',
  28.       ' Menu Item #2 ',
  29.       ' Menu Item #3 ',
  30.       ' Menu Item #4 ',
  31.       ' Menu Item #5 ');
  32.  
  33. Function GetAKey : byte;
  34. Var X1,Y1,x,y,Button,SaveAttr,Item : integer;
  35.     KeyPress : boolean;
  36.     Ch : char;
  37. Const
  38.     HiLimit = 16;
  39.     LoLimit = 8;
  40. Label Top;
  41. begin
  42.   x := 30;
  43.   y := 9;
  44.   Top:
  45.   if MouseAvail then
  46.     begin
  47.       SetMousePosition(40,12);
  48.       MickeyToPixelRatio(40,8);
  49.     end;
  50.     Button := 0;
  51.     Repeat
  52.       gotoxy(x,y);
  53.       TextAttr := inverse;
  54.       write(MenuItem[y-8]);
  55.       KeyPress := Keypressed;
  56.       If (not keypress) and MouseAvail then Button := ReadMousePosition(X1,Y1);
  57.     Until Keypress or (Button > 0) or (Y1 < LoLimit) or (Y1 > HiLimit);
  58.     If Button > 0 then
  59.      case Button of
  60.        LB : Ch := chr(y-8);
  61.        MB : Ch := Home;
  62.        RB : Ch := #255;
  63.      end
  64.     else if (not KeyPress) and MouseAvail then
  65.       begin
  66.         if y1 > HiLimit then ch := DownArrow;
  67.         if y1 < LoLimit then ch := UpArrow;
  68.         delay(200);
  69.       end
  70.     else
  71.       begin
  72.        if button = 0 then Ch := ReadKey;
  73.        if button = 0 then if Ch = #0 then Ch := Chr(Ord(ReadKey) or $80);
  74.       end;
  75.     TextAttr := Normal;
  76.     gotoxy(x,y);
  77.     write(MenuItem[y-8]);
  78.     case ch of
  79.       DownArrow : if y < 13 then y := succ(y) else y := 9;
  80.       UpArrow   : if Y > 9 then y := pred(y) else y := 13;
  81.       #13       : ch := chr(y-8);
  82.       Home      : begin
  83.                     y := 9;
  84.                     goto top;
  85.                   end;
  86.       EndKey    : begin
  87.                     y := 13;
  88.                     goto top;
  89.                   end;
  90.     end;
  91.     if ch in [UpArrow,DownArrow] then goto top;
  92.     GetAKey := ord(ch);
  93.   end;
  94.  
  95. Procedure Action(Item : byte);
  96. begin
  97.   clrscr;
  98.   gotoxy(10,10);
  99.   write('Menu item ',item,' was selected');
  100.   repeat until keypressed;
  101. end;
  102.  
  103. begin
  104.   TextAttr := Normal;
  105.   clrscr;
  106.   DefineTextCursor(1,9,0);  {Hide the cursor on a CGA}
  107.   for i := 1 to 5 do
  108.     begin
  109.       gotoxy(30,i+8);
  110.       write(MenuItem[i]);
  111.     end;
  112.   repeat
  113.     Result := GetAKey;
  114.     gotoxy(1,25);
  115.     if result in [1..5] then Action(result);
  116.   until (Result in [1..5]) or (result = 27);
  117.   DefineTextCursor(1,7,8);
  118. end.
  119.