?? mainwnd.pas
字號:
{
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.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -