home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 5 / amigaformatcd05.iso / mui / developer / oberon / examples / rbapplicationclass.mod < prev    next >
Text File  |  1996-08-13  |  1KB  |  57 lines
  1. MODULE RBApplicationClasss;
  2.  
  3. IMPORT
  4.   e := Exec,
  5.   I := Intuition,
  6.   rc := RootClass,
  7.   m := Mui,
  8.   ms := MuiSimple,
  9.   ma := MUIApplication
  10.   u := Utility,
  11.   y := SYSTEM;
  12.  
  13. TYPE
  14.   Class = UNTRACED POINTER TO ClassDesc;
  15.   ClassDesc = RECORD( mw.ClassDesc );
  16.           END;
  17.  
  18.   pGetLocaleString = STRUCT( msg : I.Msg );
  19.                string : LONGINT;
  20.              END;
  21.  
  22. CONST
  23.   tagBase = u.user + (64*65536);
  24.   mGetLocaleString = tagBase +1 ;
  25.  
  26. VAR
  27.   class -: I.IClassPtr;
  28.  
  29.  
  30.   PROCEDURE ( VAR c : ClassDesc ) GetLocaleString*( VAR msg : pGetLocaleStgring ): e.APTR;
  31.     VAR app : m.Object;
  32.     BEGIN
  33.       ms.Get( c.object, m.aWindowApplication, app );
  34.       m.DoMethod( app, m.mApplicationReturnID, m.vApplicationReturnIDQuit );
  35.       RETURN NIL;
  36.     END GetLocaleString;
  37.  
  38.   PROCEDURE Dispatch * ( cl : I.IClassPtr; obj : I.ObjectPtr; msg : I.MsgPtr ):e.APTR;
  39.     VAR c : Class;
  40.     BEGIN
  41.       IF msg.methodID # I.new THEN
  42.     c := rc.BoopsiToObj( cl, obj )(Class);
  43.       END;               
  44.       CASE msg.methodID OF
  45.     | mGetLocaleString : RETURN c.GetLocaleString( msg^(pLocaleString) );
  46.       ELSE
  47.     RETURN ma.Dispatch( cl, obj, msg );
  48.       END;         
  49.     END Dispatch;     
  50.  
  51. BEGIN
  52.   class := rc.InitPrivFromClass( ma.class, Dispatch, SIZE( ClassDesc ), y.TYPEDESC( ClassDesc ) );
  53.   IF class = NIL THEN HALT(205) END;
  54. CLOSE
  55.   IF class # NIL THEN IF I.FreeClass( class ) THEN END END;
  56. END RBApplicationClass.
  57.