home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 9 / FreshFishVol9-CD1.bin / useful / dev / obero / oberon-a / examples / libraries / workbench / appicon.mod next >
Encoding:
Text File  |  1995-01-25  |  3.8 KB  |  114 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: AppIcon.mod $
  4.   Description: A port of appicon.c from the RKM:Libraries
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 1.5 $
  8.       $Author: fjc $
  9.         $Date: 1995/01/25 23:56:20 $
  10.  
  11.   Copyright © 1994-1995, Frank Copeland.
  12.   This example program is part of Oberon-A.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14.  
  15. *************************************************************************)
  16.  
  17. <* STANDARD- *>
  18.  
  19. MODULE AppIcon;
  20.  
  21. IMPORT
  22.   SYS := SYSTEM,
  23.   e   := Exec,
  24.   u   := Utility,
  25.   i   := Icon,
  26.   wb  := Workbench,
  27.   Out;
  28.  
  29. CONST
  30.   VersionTag = "$VER: AppIcon 1.3 (25.1.95)\r\n";
  31.  
  32. VAR
  33.   dobj    : wb.DiskObjectPtr;
  34.   myport  : e.MsgPortPtr;
  35.   appicon : wb.AppIconPtr;
  36.   appmsg  : wb.AppMessagePtr;
  37.  
  38.   dropcount : LONGINT;
  39.   x         : LONGINT;
  40.   success   : BOOLEAN;
  41.  
  42.  
  43. BEGIN (* AppIcon *)
  44.   IF e.SysBase.libNode.version >= 37 THEN
  45.     dobj := NIL; myport := NIL; appicon := NIL; appmsg := NIL;
  46.     dropcount := 0; x := 0; success := FALSE;
  47.     IF (i.base # NIL) & (i.base.version >= 37) THEN
  48.       IF (wb.base # NIL) & (wb.base.version >= 37) THEN
  49.         (* This is the easy way to get some icon imagery *)
  50.         (* Real applications should use custom imagery   *)
  51.         dobj := i.GetDefDiskObject (wb.disk);
  52.         IF dobj # NIL THEN
  53.           (* The type must be set to 0 for an appIcon *)
  54.           dobj.type := 0;
  55.  
  56.           (* The CreateMsgPort() function is on Exec version 37+ *)
  57.           myport := e.CreateMsgPort();
  58.           IF myport # NIL THEN
  59.             (* Put the AppIcon up on the Workbench window *)
  60.             appicon := wb.AddAppIcon
  61.               ( 0, 0, "TestAppIcon", myport, NIL, dobj, u.end );
  62.             IF appicon # NIL THEN
  63.               (* For the sake of this example, we allow the AppIcon *)
  64.               (* to be activated only five times.                   *)
  65.               Out.String ("Drop files on the Workbench AppIcon\n");
  66.               Out.String ("Example exits after 5 drops\n");
  67.  
  68.               WHILE dropcount < 5 DO
  69.                 e.WaitPort (myport);
  70.  
  71.                 (* Might be more than one message at the port... *)
  72.                 LOOP
  73.                   appmsg := SYS.VAL (wb.AppMessagePtr, e.GetMsg (myport));
  74.                   IF appmsg = NIL THEN EXIT END;
  75.                   IF appmsg.numArgs = 0 THEN
  76.                     (* If numArgs is 0 the AppIcon was activated directly *)
  77.                     Out.String ("User activated the AppIcon.\n");
  78.                     Out.String
  79.                       ("A Help window for the user would be good here\n")
  80.                   ELSIF appmsg.numArgs > 0 THEN
  81.                     (* If numArgs is >0 the AppIcon was activated by *)
  82.                     (* having one or more Icons dropped on top of it *)
  83.                     Out.String ( "User dropped ");
  84.                     Out.Int (appmsg.numArgs, 0);
  85.                     Out.String (" icons on the AppIcon.\n");
  86.                     FOR x := 0 TO appmsg.numArgs - 1 DO
  87.                       Out.Char ("#"); Out.Int (x + 1, 0);
  88.                       Out.String (" name = '");
  89.                       Out.String (appmsg.argList[x].name^);
  90.                       Out.String ("'\n");
  91.                     END
  92.                   END;
  93.                   (* Let Workbench know we're done with the message *)
  94.                   e.ReplyMsg (appmsg)
  95.                 END;
  96.                 INC (dropcount)
  97.               END;
  98.               success := wb.RemoveAppIcon (appicon)
  99.             END;
  100.             (* Clear away any messages that arrived at the last moment *)
  101.             LOOP
  102.               appmsg := SYS.VAL (wb.AppMessagePtr, e.GetMsg (myport));
  103.               IF appmsg = NIL THEN EXIT END;
  104.               e.ReplyMsg (appmsg)
  105.             END;
  106.             e.DeleteMsgPort (myport)
  107.           END;
  108.           i.FreeDiskObject (dobj)
  109.         END
  110.       END
  111.     END
  112.   END
  113. END AppIcon.
  114.