home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 093.lha / Chaos / Sources / sherror.mod < prev   
Encoding:
Text File  |  1986-11-21  |  2.1 KB  |  76 lines
  1. (*
  2.     This module can be used to display an error on top
  3.     of a screen. All you have to do to use it is to
  4.     pass an error string and a Screen pointer.
  5.     
  6.     Created: 9/17/87 by Richie Bielak
  7.     
  8.     Modified:
  9.  
  10.     Copyright © 1987 by Richie Bielak
  11.  
  12.     This program maybe freely copied, but please leave my
  13.     name in. Thanks.....Richie
  14.     
  15.  
  16. *)
  17. IMPLEMENTATION  MODULE ShowError;
  18.  
  19. FROM SYSTEM        IMPORT ADR;
  20. FROM SimpleWindows IMPORT CreateWindow;
  21. FROM Intuition     IMPORT WindowPtr, GadgetPtr, CloseWindow, IDCMPFlagsSet,
  22.                           IDCMPFlags, WindowFlagsSet, WindowFlags,
  23.               IntuiMessagePtr, ScreenPtr;
  24. FROM SimpleGadgets IMPORT BeginGadgetList, EndGadgetList, FreeGadgetList,
  25.                           AddGadgetTextButton;
  26. FROM Ports         IMPORT WaitPort, ReplyMsg, GetMsg, MessagePtr;
  27. FROM Drawing   IMPORT SetAPen, Move;
  28. FROM Text      IMPORT Text;
  29.  
  30. CONST
  31.   MinWidth = 100;
  32.  
  33. (* ++++++++++++++++++++++++++++++ *)
  34. PROCEDURE SetUpGadget (w : CARDINAL) : GadgetPtr;
  35.   BEGIN
  36.     BeginGadgetList ();
  37.     AddGadgetTextButton ((w DIV 2) - 40, 25, ADR("Continue"));
  38.     RETURN EndGadgetList ()
  39.   END SetUpGadget;
  40.  
  41. (* $D- *)
  42. (* ++++++++++++++++++++++++++++++ *)
  43. PROCEDURE Error (sp : ScreenPtr; text : ARRAY OF CHAR);
  44.   VAR
  45.     wp : WindowPtr;
  46.     gp : GadgetPtr;
  47.     msgp : IntuiMessagePtr;
  48.     width : CARDINAL;
  49.   BEGIN
  50.     (* Figure out the width of the window based *)
  51.     (* on the length of text.                   *)
  52.     width := 20 + (HIGH(text)+1) * 9;
  53.     IF width < MinWidth THEN width := MinWidth; END;
  54.     (* Make one gadget *)
  55.     gp := SetUpGadget (width);
  56.     wp := CreateWindow (10, 20, width, 40,
  57.                         IDCMPFlagsSet {GadgetUp, GadgetDown},
  58.                         WindowFlagsSet {Activate, WindowDrag}, gp, sp,
  59.                     ADR ("Error..."));
  60.     SetAPen (wp^.RPort^, 1);
  61.     Move (wp^.RPort^, 20, 20);
  62.     Text (wp^.RPort^, ADR(text), HIGH(text));    
  63.     (* Wait for gadget messages *)
  64.     msgp := WaitPort (wp^.UserPort^);
  65.     LOOP
  66.       msgp := GetMsg (wp^.UserPort^);
  67.       IF msgp = NIL THEN EXIT END;
  68.       ReplyMsg (MessagePtr (msgp));
  69.     END;
  70.     CloseWindow (wp^);
  71.     FreeGadgetList (gp^);
  72.   END Error;
  73. (* $D+ *)
  74.  
  75. END ShowError.
  76.