home *** CD-ROM | disk | FTP | other *** search
/ Computer Club Elmshorn Atari PD / CCE_PD.iso / pc / 0600 / CCE_0632.ZIP / CCE_0632 / GOBJ_111.ZIP / GOBJECTS.111 / SOURCE / EYES.PAS next >
Pascal/Delphi Source File  |  1994-03-03  |  5KB  |  239 lines

  1. program ObjectGEMEyes; {$X+} {$E .ACC }
  2.  
  3. uses
  4.  
  5.     Gem,OTypes,OWindows;
  6.  
  7. type
  8.  
  9.     TMyApplication = object(TApplication)
  10.         procedure InitInstance; virtual;
  11.         procedure InitMainWindow; virtual;
  12.         function GetMsTimer: longint; virtual;
  13.         procedure MUTimer(data: TEventData); virtual;
  14.         procedure ACOpen(mID: integer); virtual;
  15.         function ACClose(mID,Why: integer): integer; virtual;
  16.     end;
  17.  
  18.     PMyWindow = ^TMyWindow;
  19.     TMyWindow = object(TWindow)
  20.         oldx,
  21.         oldy,
  22.         pmx,
  23.         pmy     : integer;
  24.         paintall: boolean;
  25.         function GetStyle: integer; virtual;
  26.         procedure GetWindowClass(var AWndClass: TWndClass); virtual;
  27.         procedure SetupSize; virtual;
  28.         procedure SetupWindow; virtual;
  29.         procedure Paint(var PaintInfo: TPaintStruct); virtual;
  30.         { neue Routinen }
  31.         procedure TimerRedraw(x,y: integer); virtual;
  32.     end;
  33.  
  34.     PSpace = ^TSpace;
  35.     TSpace = object(TKey)
  36.         procedure Work; virtual;
  37.     end;
  38.  
  39.  
  40. var
  41.  
  42.     MyApplication: TMyApplication;
  43.  
  44.  
  45.  
  46. procedure TMyApplication.InitInstance;
  47.  
  48.     begin
  49.         Attr.EventMask:=MU_MESAG;
  50.         if AppFlag then Attr.EventMask:=Attr.EventMask or MU_TIMER or MU_KEYBD;
  51.         vsl_color(vdiHandle,LBlack);
  52.         vsf_perimeter(vdiHandle,PER_OFF);
  53.         vsf_interior(vdiHandle,FIS_SOLID);
  54.         vsf_color(vdiHandle,White);
  55.         inherited InitInstance
  56.     end;
  57.  
  58.  
  59. procedure TMyApplication.InitMainWindow;
  60.  
  61.     begin
  62.         new(PMyWindow,Init(nil,'Eyes'));
  63.         if (MainWindow=nil) then Status:=em_InvalidMainWindow
  64.     end;
  65.  
  66.  
  67. function TMyApplication.GetMsTimer: longint;
  68.  
  69.     begin
  70.         GetMsTimer:=100
  71.     end;
  72.  
  73.  
  74. procedure TMyApplication.MUTimer(data: TEventData);
  75.     var p: PMyWindow;
  76.  
  77.     begin
  78.         p:=PMyWindow(MainWindow);
  79.         if (data.mX<>p^.oldx) or (data.mY<>p^.oldy) then
  80.             begin
  81.                 wind_update(BEG_UPDATE);
  82.                 p^.TimerRedraw(data.mX,data.mY);
  83.                 wind_update(END_UPDATE)
  84.             end
  85.     end;
  86.  
  87.  
  88. procedure TMyApplication.ACOpen(mID: integer);
  89.  
  90.     begin
  91.         inherited ACOpen(mID);
  92.         if mID=menuID then
  93.             if ChkError>=em_OK then Attr.EventMask:=Attr.EventMask or MU_TIMER or MU_KEYBD
  94.     end;
  95.  
  96.  
  97. function TMyApplication.ACClose(mID,Why: integer): integer;
  98.  
  99.     begin
  100.         if mID=menuID then Attr.EventMask:=Attr.EventMask and (not(MU_TIMER or MU_KEYBD));
  101.         ACClose:=inherited ACClose(mID,Why)
  102.     end;
  103.  
  104.  
  105. function TMyWindow.GetStyle: integer;
  106.  
  107.     begin
  108.         GetStyle:=NAME or CLOSER or FULLER or MOVER or SIZER
  109.     end;
  110.  
  111.  
  112. procedure TMyWindow.GetWindowClass(var AWndClass: TWndClass);
  113.  
  114.     begin
  115.         inherited GetWindowClass(AWndClass);
  116.         with AWndClass do
  117.             begin
  118.                 Style:=Style or cs_FullRedraw or cs_WorkBackground;
  119.                 hbrBackground:=0
  120.             end
  121.     end;
  122.  
  123.  
  124. procedure TMyWindow.SetupSize;
  125.  
  126.     begin
  127.         inherited SetupSize;
  128.         with Work do
  129.             begin
  130.                 X:=100;
  131.                 Y:=100;
  132.                 W:=100;
  133.                 H:=80
  134.             end;
  135.         Calc(WC_BORDER,Work,Curr)
  136.     end;
  137.  
  138.  
  139. procedure TMyWindow.SetupWindow;
  140.  
  141.     begin
  142.         paintall:=true;
  143.         oldx:=-1;
  144.         oldy:=-1;
  145.         pmx:=0;
  146.         pmy:=0;
  147.         new(PSpace,Init(@self,0,14624,nil,false));
  148.         inherited SetupWindow
  149.     end;
  150.  
  151.  
  152. procedure TMyWindow.Paint(var PaintInfo: TPaintStruct);
  153.     var lr,ou,breite,hoehe: integer;
  154.  
  155.     procedure pupil(mx,my,x,y: integer);
  156.         var xx,yy,zz,f,ff: real;
  157.  
  158.         begin
  159.             xx:=mx-(Work.X+x);
  160.             yy:=my-(Work.Y+y);
  161.             zz:=sqrt(sqr(xx)+sqr(yy));
  162.             if zz<>0 then
  163.                 begin
  164.                     f:=(Work.W/11.12)*xx/zz;
  165.                     ff:=(Work.H/4.22)*yy/zz
  166.                 end
  167.             else
  168.                 begin
  169.                     f:=0;
  170.                     ff:=0
  171.                 end;
  172.             v_ellipse(vdiHandle,Work.X+x+trunc(f),Work.Y+y+trunc(ff),
  173.                                             Work.W div 10,Work.H div 8)
  174.         end;
  175.  
  176.     begin
  177.         lr:=Work.W shr 2;
  178.         ou:=Work.H shr 1;
  179.         breite:=Work.W div 5;
  180.         hoehe:=ou-(Work.H div 16);
  181.         if paintall then
  182.             begin
  183.                 vr_recfl(vdiHandle,PaintInfo.rcPaint.A2);
  184.                 vsf_color(vdiHandle,Black);
  185.                 vsf_perimeter(vdiHandle,PER_ON);
  186.                 vsf_interior(vdiHandle,FIS_HOLLOW);
  187.                 v_ellipse(vdiHandle,Work.X+lr,Work.Y+ou,breite,hoehe);
  188.                 v_ellipse(vdiHandle,Work.X+Work.W-lr,Work.Y+ou,breite,hoehe);
  189.                 vsf_interior(vdiHandle,FIS_SOLID);
  190.                 vsf_perimeter(vdiHandle,PER_OFF)
  191.             end
  192.         else
  193.             begin
  194.                 pupil(oldx,oldy,lr,ou);
  195.                 pupil(oldx,oldy,Work.W-lr,ou)
  196.             end;
  197.         vsf_color(vdiHandle,Blue);
  198.         pupil(pmx,pmy,lr,ou);
  199.         pupil(pmx,pmy,Work.W-lr,ou);
  200.         vsf_color(vdiHandle,White)
  201.     end;
  202.  
  203.  
  204. procedure TMyWindow.TimerRedraw(x,y: integer);
  205.  
  206.     begin
  207.         pmx:=x;
  208.         pmy:=y;
  209.         paintall:=false;
  210.         HideMouse;
  211.         WMRedraw(Work.X,Work.Y,Work.W,Work.H);
  212.         ShowMouse;
  213.         oldx:=pmx;
  214.         oldy:=pmy;
  215.         paintall:=true
  216.     end;
  217.  
  218.  
  219. procedure TSpace.Work;
  220.     var rect: GRECT;
  221.         p   : PWindow;
  222.  
  223.     begin
  224.         p:=PWindow(Parent);
  225.         with p^ do
  226.             begin
  227.                 Work.W:=100;
  228.                 Work.H:=80;
  229.                 Calc(WC_BORDER,Work,rect);
  230.                 WMSized(rect.X,rect.Y,rect.W,rect.H)
  231.             end
  232.     end;
  233.  
  234.  
  235. begin
  236.     MyApplication.Init('EYES','ObjectGEM Eyes');
  237.     MyApplication.Run;
  238.     MyApplication.Done
  239. end.