this slowpoke moves

Eyes follow Mouse

private
    { Private declarations }
    X, Y : Integer;
    procedure WMNCHitTest(var Msg:TMessage); message WM_NCHITTEST;
    procedure WMEraseBkgnd(var m: TWMEraseBkgnd); message WM_ERASEBKGND;
    
//

procedure TForm1.FormCreate(Sender: TObject);
var
  LeftRgn, RightRgn, NewRgn : HRGN;
begin
  LeftRgn :=CreateEllipticRgn(0,0,Width div 2,Height);
  RightRgn:=CreateEllipticRgn(Width div 2,0,Width,Height);
  NewRgn:=CreateRectRgn(0,0,0,0);
  CombineRgn(NewRgn,LeftRgn,RightRgn,RGN_OR);
  DeleteObject(LeftRgn);
  DeleteObject(RightRgn);
  SetWindowRgn(handle,NewRgn,False);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  Canvas.Brush.Color:=clWhite;
  Canvas.Pen.Color:=clBlack;
  Canvas.Pen.Width:=10;
  Canvas.Ellipse(0,0,Width div 2,Height);
  Canvas.Ellipse(Width div 2,0,Width,Height);
end;

procedure TForm1.WMEraseBkgnd(var m : TWMEraseBkgnd);
begin
  m.Result:=LRESULT(False);
end;

procedure TForm1.WMNCHitTest(var Msg:TMessage);
begin
  msg.result:=HTCAPTION;
end;{}

procedure TForm1.Timer1Timer(Sender: TObject);
var
  Point : TPoint;
  XC, YC, XF, YF, XPos, YPos : Integer;
  L : Double;
begin
  GetCursorPos(Point);
  Point.X:=Point.X-Left;
  Point.Y:=Point.Y-Top;

  if (Point.X<>X) or (Point.Y<>Y) then
  begin
    X:=Point.X;
    Y:=Point.Y;

    XC:=Width div 4; YC:=Height div 2;
    XF:=X-XC;
    YF:=Y-YC;
    L:=Sqrt(Sqr(XF)+Sqr(YF))/30; if L=0 then L:=1;
    XPos:=Round(XC+XF/L);
    YPos:=Round(YC+YF/L/1.5);

    FormPaint(Self);
    Canvas.Pen.Color:=clBlue;
    Canvas.Brush.Color:=clBlack;
    Canvas.Ellipse(XPos-15,YPos-15,XPos+15,YPos+15);

    XC:=Width*3 div 4; YC:=Height div 2;
    XF:=X-XC;
    YF:=Y-YC;
    L:=Sqrt(Sqr(XF)+Sqr(YF))/30; if L=0 then L:=1;
    XPos:=Round(XC+XF/L);
    YPos:=Round(YC+YF/L/1.5);

    Canvas.Ellipse(XPos-15,YPos-15,XPos+15,YPos+15);
  end;
end;

Keine Kommentare:

Kommentar veröffentlichen

Beliebte Posts

Translate