home *** CD-ROM | disk | FTP | other *** search
/ Vectronix 2 / VECTRONIX2.iso / FILES_01 / HSPASCAL.LZH / HSPASCAL / GEMDEMO / MENUS.PAS < prev    next >
Pascal/Delphi Source File  |  1992-05-01  |  5KB  |  111 lines
  1. {-------------------------------------------------------------------------
  2.                 HighSpeed Pascal GEM-interface demo program
  3.  
  4.                                 MENU DEMO
  5.  
  6.                       Copyright (c) 1990 by D-House I
  7.                             All rights reserved
  8.  
  9.                       Programmed by Martin Eskildsen
  10. -------------------------------------------------------------------------}
  11. {$R-,S-,D+}
  12. program Menu_Demo;
  13.  
  14. uses GemInterface, GemAES, GemVDI;
  15.  
  16. {$I MENUS.H}
  17.  
  18. var
  19.   RSC_name      : string;       { string containing RSC file's name     }
  20.   MenuTree      : Tree_Ptr;     { object tree containing menu           }
  21.   NewText       : string;       { string containing an item's new text  }
  22.  
  23. { Let the user move around with the mouse and select menu items }
  24. procedure MoveAround;
  25. const
  26.   Title         = 3;            { pipe index holding menu title no.     }
  27.   Item          = 4;            { pipe index holding menu item no.      }
  28. var
  29.   pipe          : array [ 0..15 ] of integer;   { message pipe          }
  30.   TitleStr      : string;       { text describing menu title selected   }
  31.   ItemStr       : string;       {                      item             }
  32.   done          : boolean;      { done = TRUE = completed moving        }
  33. begin
  34.   graf_mouse(M_ON, NIL);        { show the cursor (mouse)               }
  35.   done := FALSE;
  36.   repeat
  37.     evnt_mesag(pipe);                   { wait for an event             }
  38.     if pipe[0] = MN_SELECTED then begin { if it's a menu event :        }
  39.       case pipe[Title] of
  40.         DESK_T   : begin                { Desk title                    }
  41.                      TitleStr := 'Desk';
  42.                      case pipe[Item] of
  43.                        ABOUT_I : ItemStr := 'About'     { about item    }
  44.                      end
  45.                    end;
  46.         FILE_T   : begin                { File title                    }
  47.                      TitleStr := 'File';
  48.                      case pipe[Item] of
  49.                        QUIT : ItemStr := 'Quit'         { quit item     }
  50.                      end
  51.                    end;
  52.         EXAMPL_T : begin                { Examples title                }
  53.                      TitleStr := 'Examples';
  54.                      case pipe[Item] of
  55.                        ITEM1 : ItemStr := 'Item 1';     { item 1        }
  56.                        ITEM2 : ItemStr := 'Item 2';     { item 2        }
  57.                        ITEM3 : ItemStr := 'Item 3';     { item 3        }
  58.                        ITEM4 : ItemStr := 'Item 4'      { item 4        }
  59.                      end
  60.                    end;
  61.       end { case }
  62.     end;
  63.     done := (pipe[Title] = FILE_T) and (pipe[Item] = QUIT);
  64.     graf_mouse(M_OFF, NIL);                              { hide mouse    }
  65.     if not done then Inform('You selected ' + TitleStr + ', ' + ItemStr);
  66.     menu_tnormal(MenuTree, pipe[Title], 1);             { reset title   }
  67.     graf_mouse(M_ON, NIL)                               { show mouse    }
  68.   until done;
  69.   graf_mouse(M_OFF, NIL)                                { hide mouse    }
  70. end;
  71.  
  72. begin { main }
  73.   if Init_Gem then begin
  74.     Message('Welcome to the Menu library demonstration!');
  75.     Message('First, we''ll have to load the MENUS.RSC file');
  76.     RSC_name := 'MENUS.RSC'#00;                         { note the #00  }
  77.     rsrc_load(RSC_name[1]);                             { try to load   }
  78.     if GemError = 0 then 
  79.       begin
  80.         RSC_name := 'GEMDEMO\MENUS.RSC'#00;
  81.         rsrc_load(RSC_name[1]);
  82.         if GemError = 0 then
  83.           ErrorCloseDown('MENUS.RSC could not be found');
  84.       end;
  85.       
  86.     Message('Then determine the address of the menu tree');
  87.     rsrc_gaddr(R_TREE, MAINMENU, MenuTree);     { get addr of main menu }
  88.  
  89.     Message('So now we''re ready to draw the menu');
  90.     menu_bar(MenuTree, 1);                      { 1 = draw menu         }
  91.  
  92.     Inform ('Now you''re on your own! File item Quit completes');
  93.     MoveAround;
  94.  
  95.     Message('Hope you noticed the Examples menu layout?');
  96.     Inform ('We''ll modify it slightly now... Examine!');
  97.     menu_icheck(MenuTree, ITEM1, 0);            { clear                 }
  98.     menu_icheck(MenuTree, ITEM4, 1);            { set                   }
  99.     menu_ienable(MenuTree, ITEM2, 0);           { disable               }
  100.     menu_ienable(MenuTree, ITEM3, 1);           { enable                }
  101.     NewText := '  Great!'#0;                    { note #0               }
  102.     menu_text(MenuTree, ITEM1, NewText[1]);     { set new text          }
  103.     MoveAround;
  104.  
  105.     Message('That''s all folks!');
  106.     menu_bar(MenuTree, 0);                      { clear menu bar line   }
  107.     rsrc_free;                          { release resource file memory  }
  108.     Exit_Gem
  109.   end
  110. end.
  111.