mainwnd.pas

Argh! Where s my mouse? Ah look at the eyes .... there it is! )) Mouse Eyes is another mouse cursor

{
  MouseEyes application written by: Graeme R. Foot, 22 Jan 2008

  Features:
  - Form Transparency
  - StayOnTop Form
  - User painting to Form canvas
  - Smoothing painting via DoubleBuffered
  - Form movement via from click-n-drag on the eyes
  - Access to display info via Screen and Mouse objects
  - Creative use of MulDiv
}
unit MainWnd;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, IniFiles, Menus;

type
  TfrmMain = class(TForm)
    tmrEyes: TTimer;
    mnuPopup: TPopupMenu;
    mniClose: TMenuItem;
    procedure tmrEyesTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure mniCloseClick(Sender: TObject);

  private
    { allow window draging via the client area as well }
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;

  protected
    m_lastPos : TPoint;

    procedure drawPupil(const in_eyeRect: TRect);

  public
    
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}


const
  APP_DATA = 'AppData.ini';


procedure TfrmMain.WMNCHitTest(var Message: TWMNCHitTest);
begin
  inherited;

  // close application if Right mouse button is down
  if ((GetAsyncKeyState(VK_RBUTTON) and $F000) = 0) and
     (Message.Result = htClient) then
  begin
    // move window redirect
    Message.Result := htCaption;
  end;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  // smooth drawing
  DoubleBuffered := true;
end;

procedure TfrmMain.FormShow(Sender: TObject);
var
  iniFile : TIniFile;
begin
  // read last coordinates
  if FileExists(ExtractFilePath(Application.ExeName) + APP_DATA) then
  begin
    iniFile := TIniFile.Create(ExtractFilePath(Application.ExeName) + APP_DATA);
    try
      self.Left := iniFile.ReadInteger('Window', 'Left', self.Left);
      self.Top  := iniFile.ReadInteger('Window', 'Top', self.Top);

    finally
      iniFile.Free;
    end;
  end
  else
  begin
    // screen centre
    self.Left := (Screen.Width - self.Width) div 2;
    self.Top  := (Screen.Height - self.Height) div 2;
  end;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
var
  iniFile : TIniFile;
begin
  // remember last coordinates
  iniFile := TIniFile.Create(ExtractFilePath(Application.ExeName) + APP_DATA);
  try
    iniFile.WriteInteger('Window', 'Left', self.Left);
    iniFile.WriteInteger('Window', 'Top', self.Top);

  finally
    iniFile.Free;
  end;
end;

procedure TfrmMain.drawPupil(const in_eyeRect: TRect);
const
  PUPIL_WIDTH  = 10;
  PUPIL_HEIGHT = 14;
  MOVE_RADIUS  = 8;
  FULL_DIST    = 40;
var
  eyePos    : TPoint;
  eyeDist   : integer;
  dx, dy    : integer;
  pupilRect : TRect;
begin
  // draw a pupil
  eyePos    := Point((in_eyeRect.Left + in_eyeRect.Right) div 2, (in_eyeRect.Top + in_eyeRect.Bottom) div 2);
  pupilRect := Rect(eyePos.X - PUPIL_WIDTH div 2, eyePos.Y - PUPIL_HEIGHT div 2,
                    eyePos.X + PUPIL_WIDTH div 2 +1, eyePos.Y + PUPIL_HEIGHT div 2 + 1);

  eyePos  := ClientToScreen(eyePos);
  dx      := m_lastPos.X - eyePos.X;
  dy      := m_lastPos.Y - eyePos.Y;
  eyeDist := Round(Sqrt(Sqr(dx) + Sqr(dy)));

  if (eyeDist > FULL_DIST) then
  begin
    OffsetRect(pupilRect, MulDiv(dx, MOVE_RADIUS, eyeDist), MulDiv(dy, MOVE_RADIUS, eyeDist));
  end
  else if (eyeDist > 0) then
  begin
    OffsetRect(pupilRect, MulDiv(dx, MulDiv(MOVE_RADIUS, eyeDist, FULL_DIST), eyeDist),
                          MulDiv(dy, MulDiv(MOVE_RADIUS, eyeDist, FULL_DIST), eyeDist));
  end;

  Canvas.Ellipse(pupilRect);
end;

procedure TfrmMain.FormPaint(Sender: TObject);
const
  LEFT_EYE  : TRect = (Left:24; Top:8; Right:50; Bottom:38);
  RIGHT_EYE : TRect = (Left:52; Top:8; Right:78; Bottom:38);
begin
  // draw eyes
  Canvas.Brush.Color := clWhite;
  Canvas.Brush.Style := bsSolid;
  Canvas.Pen.Color   := clBlack;
  Canvas.Pen.Style   := psSolid;
  Canvas.Pen.Width   := 1;

  Canvas.Ellipse(LEFT_EYE);
  Canvas.Ellipse(RIGHT_EYE);


  // draw pupils
  Canvas.Brush.Color := clBlack;
  Canvas.Brush.Style := bsSolid;
  Canvas.Pen.Style   := psClear;

  // left Eye
  drawPupil(LEFT_EYE);

  // right Eye
  drawPupil(RIGHT_EYE);
end;

procedure TfrmMain.tmrEyesTimer(Sender: TObject);
var
  mousePos : TPoint;
begin
  mousePos := Mouse.CursorPos;

  // keep track of mouse - repaint the eyes if its moved
  if (mousePos.X <> m_lastPos.X) or (mousePos.Y <> m_lastPos.Y) then
  begin
    self.Invalidate;
    m_lastPos := mousePos;
  end;
end;

procedure TfrmMain.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  // display close popup menu
  if (Button = mbRight) then
  begin
    mnuPopup.Popup(m_lastPos.X, m_lastPos.Y);
  end;
end;

procedure TfrmMain.mniCloseClick(Sender: TObject);
begin
  // close app
  Close;
end;

end.