home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Pascal / MAXONPASCAL3.DMS / in.adf / DEMOS-OS1.3 / MenusDemo.p < prev    next >
Encoding:
Text File  |  1994-07-23  |  2.6 KB  |  81 lines
  1. Program MenusDemo;
  2.  
  3. { Demonstriert Benutzung des Units "Menus" }
  4.  
  5. { Jens Gelhar 1990 }
  6.  
  7. { MaxonPascal3-Anpassung / Test:  Falk Zühlsdorff (PackMAN) 1994 }
  8.  
  9. Uses Crt;
  10. From Windows Uses Menus;
  11.  
  12. Var c    : Char;
  13.     x, y : integer;
  14.  
  15. Begin
  16.   WindowTitles('Menü-Demo', Str(-1));
  17.   AddMenu(10, 'Projekt', true);
  18.     AddItem( 0, 0, 'Open',       ' ');
  19.     AddItem(12, 0, 'Close',      'S');
  20.     AddItem(24, 0, 'Quit',       'Q');
  21.   AddMenu(100, 'Edit', true);
  22.     AddItem( 0, 0, 'Cut',        'X');
  23.     AddItem(12, 0, 'Copy',       'C');
  24.     AddItem(24, 0, 'Paste',      'P');
  25.     AddItem(36, 0, 'Delete All', ' ');
  26.   AddMenu(200, 'Optionen', true);
  27.     AddItem( 0, 0, 'Farbe',      ' ');
  28.       AddSubItem( 0, CheckOff, '  Schwarz', '0'); MutualExclude(%1110);
  29.       AddSubItem(12, CheckOn,  '  Weiß',    '1'); MutualExclude(%1101);
  30.       AddSubItem(24, CheckOff, '  Blau',    '2'); MutualExclude(%1011);
  31.       AddSubItem(36, CheckOff, '  Rot',     '3'); MutualExclude(%0111);
  32.     AddItem(12, 0, 'Stil',       ' ');
  33.       AddSubItem( 0, 0,         'Normal',   'N'); MutualExclude(%110);
  34.       AddSubItem(12, ToggleOff, '  Fett'  , 'F'); MutualExclude(%001);
  35.       AddSubItem(24, ToggleOff, '  Kursiv', 'K'); MutualExclude(%001);
  36.   AddMenu(300, 'Special', true);
  37.     AddItem( 0, CheckOn, '  Himpelsoft', 'H');    MutualExclude(%110);
  38.     AddItem(12, CheckOff, '  Maxon',      ' ');   MutualExclude(%101);
  39.     AddItem(24, CheckOff, '  B**land',    ' ');   MutualExclude(%010);
  40.  
  41.   AddIDCMP(MOUSEBUTTONS);
  42.  
  43.   REPEAT
  44.  
  45.     c := ReadKey;
  46.     If MenuPicked Then
  47.       While MenuPicked Do
  48.         Begin
  49.           Writeln(PickedMenu:20, PickedItem:10, PickedSubItem:10 );
  50.  
  51.           If (PickedMenu=2) and (PickedItem=0) Then
  52.             { Untermenü "Farbe" }
  53.               Writeln('Farbwechsel: *****', #e, PickedSubItem+30,'m***');
  54.  
  55.           If (PickedMenu=2) and (PickedItem=1) Then
  56.             { Untermenü "Stil" }
  57.             Begin
  58.               Write(#e'0mStilwechsel: *****');        { Normalen Stil setzen }
  59.               If MenuChecked(2,1,1) Then Write(#e'1m'); { Fett }
  60.               If MenuChecked(2,1,2) Then Write(#e'3m'); { Kursiv }
  61.               Writeln ('*****')
  62.             End;
  63.  
  64.           NextPicked
  65.         End
  66.  
  67.     Else
  68.     If MouseClicked Or RightButtonPressed Then
  69.       Begin
  70.         x := MouseX;
  71.         y := MouseY;
  72.         GotoXY( x div 8, y div 8);        { Cursor setzen }
  73.         If RightButtonPressed Then Write('X')
  74.                               Else Write('O');
  75.         GotoXY (1, 1);
  76.       End
  77.     Else
  78.       Writeln('Zeichen #',ord(c));
  79.   Until WindowClosed Or (c=#13) Or ((PickedMenu=0) and (PickedItem=2))
  80. End.
  81.