home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / e / amigae30a_fr.lha / AmigaE30f / Sources / Reqs / GadToolsDemo.e < prev    next >
Encoding:
Text File  |  1994-11-27  |  3.1 KB  |  101 lines
  1. /*Démo de la gadtools */
  2.  
  3. ENUM NONE,ER_OPENLIB,ER_WB,ER_VISUAL,ER_CONTEXT,ER_GADGET,ER_WINDOW,ER_MENUS
  4.  
  5. MODULE 'intuition/intuition', 'gadtools', 'libraries/gadtools',
  6.        'intuition/gadgetclass', 'exec/nodes', 'intuition/screens'
  7.  
  8. DEF scr=NIL:PTR TO screen,
  9.     visual=NIL,
  10.     wnd=NIL:PTR TO window,
  11.     glist=NIL,offy,g,
  12.     type,infos,listv:PTR TO LONG,menu
  13.  
  14. PROC main() HANDLE
  15.   openinterface()
  16.   REPEAT
  17.     wait4message()
  18.     TextF(10,150+offy,'type: \d[3], info: \h[4]',type,infos)
  19.   UNTIL type=IDCMP_CLOSEWINDOW
  20.   Raise(NONE)
  21. EXCEPT
  22.   closeinterface()
  23.   IF exception>0 THEN WriteF('Nepeut pas \s !\n',
  24.     ListItem(['','ouvrir la "gadtools.library" v37','locker le workbench',
  25.               'prendre les "visual infos"','créé le "context"','créé les "gadgets"',
  26.               'ouvrir la fenêtre','allouer les menus'],exception))
  27. ENDPROC
  28.  
  29. PROC openinterface()
  30.   IF (gadtoolsbase:=OpenLibrary('gadtools.library',37))=NIL THEN
  31.     Raise(ER_OPENLIB)
  32.   IF (scr:=LockPubScreen('Workbench'))=NIL THEN Raise(ER_WB)
  33.   IF (visual:=GetVisualInfoA(scr,NIL))=NIL THEN Raise(ER_VISUAL)
  34.   offy:=scr.wbortop+Int(scr.rastport+58)+1
  35.   IF (g:=CreateContext({glist}))=NIL THEN Raise(ER_CONTEXT)
  36.   IF (menu:=CreateMenusA([1,0,'Project',0,0,0,0,
  37.     2,0,'Charger','l',0,0,0,
  38.     2,0,'Sauver','s',0,0,0,
  39.     2,0,'Bla ->',0,0,0,0,
  40.     3,0,'aaargh','a',0,0,0,
  41.     3,0,'hmmm','h',0,0,0,
  42.     2,0,'Quitter','q',0,0,0,
  43.     0,0,0,0,0,0,0]:newmenu,NIL))=NIL THEN Raise(ER_MENUS)
  44.   IF LayoutMenusA(menu,visual,NIL)=FALSE THEN Raise(ER_MENUS)
  45.   IF (g:=CreateGadgetA(SCROLLER_KIND,g,
  46.     [scr.wborleft+20,offy+9,155,22,NIL,NIL,1,0,visual,0]:newgadget,
  47.     [GTSC_TOP,2,
  48.      GTSC_VISIBLE,3,
  49.      GTSC_TOTAL,10,
  50.      GTSC_ARROWS,22,
  51.      PGA_FREEDOM,LORIENT_HORIZ,
  52.      GA_RELVERIFY,TRUE,
  53.      GA_IMMEDIATE,TRUE,0]))=NIL THEN Raise(ER_GADGET)
  54.   listv:=[0,0,0,0]; listv[0]:=listv+4; listv[2]:=listv
  55.   AddTail(listv,[0,0,0,0,'aaaargh']:ln)
  56.   AddTail(listv,[0,0,0,0,'hmmmm']:ln)
  57.   IF (g:=CreateGadgetA(LISTVIEW_KIND,g,
  58.     [scr.wborleft+20,offy+40,155,100,NIL,NIL,2,0,visual,0]:newgadget,
  59.     [GTLV_SCROLLWIDTH,20,
  60.      GTLV_LABELS,listv,0]))=NIL THEN Raise(ER_GADGET)
  61.   IF (wnd:=OpenW(10,15,200,offy+165,$304 OR SCROLLERIDCMP,$E,
  62.     'Démo gadtools en E',NIL,1,glist))=NIL THEN Raise(ER_WINDOW)
  63.   IF SetMenuStrip(wnd,menu)=FALSE THEN Raise(ER_MENUS)
  64.   Gt_RefreshWindow(wnd,NIL)
  65. ENDPROC
  66.  
  67. PROC closeinterface()
  68.   IF wnd THEN ClearMenuStrip(wnd)
  69.   IF menu THEN FreeMenus(menu)
  70.   IF visual THEN FreeVisualInfo(visual)
  71.   IF wnd THEN CloseWindow(wnd)
  72.   IF glist THEN FreeGadgets(glist)
  73.   IF scr THEN UnlockPubScreen(NIL,scr)
  74.   IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
  75. ENDPROC
  76.  
  77. PROC wait4message()
  78.   DEF mes:PTR TO intuimessage,g:PTR TO gadget
  79.   REPEAT
  80.     type:=0
  81.     IF mes:=Gt_GetIMsg(wnd.userport)
  82.       type:=mes.class
  83.       IF type=IDCMP_MENUPICK
  84.         infos:=mes.code
  85.       ELSEIF (type=IDCMP_GADGETDOWN) OR (type=IDCMP_GADGETUP)
  86.         g:=mes.iaddress
  87.         infos:=g.gadgetid
  88.       ELSEIF type=IDCMP_REFRESHWINDOW
  89.         Gt_BeginRefresh(wnd)
  90.         Gt_EndRefresh(wnd,TRUE)
  91.         type:=0
  92.       ELSEIF type<>IDCMP_CLOSEWINDOW
  93.         type:=0
  94.       ENDIF
  95.       Gt_ReplyIMsg(mes)
  96.     ELSE
  97.       Wait(-1)
  98.     ENDIF
  99.   UNTIL type
  100. ENDPROC
  101.