home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Pascal / MAXONPASCAL3.DMS / in.adf / DEMOS-OS2.0 / Rastertest.p < prev    next >
Encoding:
Text File  |  1994-08-25  |  1.8 KB  |  65 lines
  1. { Programm:    Rastertest
  2.   ~~~~~~~~~
  3.   Sprache:     MaxonPASCAL3 (bzw. KickPascal2.12 & OS 2.0-Includes)
  4.   ~~~~~~~~
  5.   Sinn:        Darstellung eines Raster wie bei z.B. SystemReq.
  6.   ~~~~~
  7.   Autor:       PackMAN
  8.   ~~~~~~       c/o Falk Zühlsdorff
  9.                Lindenberg 66
  10.                D-98693 Ilmenau/Thüringen
  11.  
  12.   Copyright:   FREEWARE,  Nutzung nur in nichtkommerziellen Programmen
  13.   ~~~~~~~~~~              Autor wird in Programm (.dok / Infofenster)
  14.                           erwähnt.                                      
  15.  
  16.   Kommentar:   spezielle Version für MAXON
  17.   ~~~~~~~~~~                              
  18.                (nicht fontsensitiv)                                      }  
  19.  
  20. Program Rastertest;
  21. USES Intuition,Graphics;
  22.  
  23. VAR   Win     : ^Window;
  24.       Msg     : ^IntuiMessage;
  25.       e       : boolean;
  26.       RP      : p_RastPort;
  27.       pattern : array[0..1] of word;
  28.  
  29. PROCEDURE SetAfPt(w:p_RastPort;p:Ptr;n:Integer);
  30. BEGIN
  31.  w^.AreaPtrn:=p;
  32.  w^.AreaPtSz:=n;
  33. END;
  34.  
  35. BEGIN
  36.  Win:=Open_Window(200,0,300,100,$0203,_CLOSEWINDOW,  
  37.          ACTIVATE+WINDOWDRAG+WINDOWDEPTH+RMBTRAP+WINDOWCLOSE,
  38.          'Rastertest © by PackMAN in `94',Nil,0,0,0,0);
  39.                                    { einfaches OS 1.3-Window zum Test } 
  40.  IF Win=Nil THEN  exit;
  41.  e:=false;
  42.  RP:=Win^.RPort;
  43.  pattern[0]:=$AAAA;                { Pattern ausfüllen    }
  44.  pattern[1]:=$5555;
  45.  SetAfPt(RP,^pattern,1);           { Pattern setzen       }
  46.  SetAPen(RP,2);                    { Farben für Raster    } 
  47.  SetBPen(RP,0);
  48.  SetDrMd(RP,JAM2);                 { Schreibmodus setzen  }
  49.  RectFill(RP,3,11,294,97);
  50.  SetAfPt(RP,NIL,0);                { Pattern zurücksetzen }
  51.  REPEAT
  52.   Msg:=Wait_Port(Win^.UserPort);
  53.   Msg:=Get_Msg(Win^.UserPort);
  54.   Reply_Msg(Msg);
  55.   IF Msg^.Class=_CLOSEWINDOW THEN e:=true;
  56.  UNTIL e;
  57.  Close_Window(Win);
  58.  CloseLib(Intuitionbase);
  59.  Closelib(GfxBase);
  60. END.
  61.  
  62.  
  63.  
  64.  
  65.