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