⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mousego.pas

📁 一个小玩具
💻 PAS
字号:
unit mousego;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls,shellapi, Buttons, Menus,urlmon;

const IDI_TRAYICON=WM_USER+10;
      TRAY_CALLBACK=WM_USER+40;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    label1: TPanel;
    label2: TPanel;
    SpeedButton1: TSpeedButton;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    A1: TMenuItem;
    N2: TMenuItem;
    X1: TMenuItem;
    H1: TMenuItem;
    procedure Timer1Timer(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure traycallback(var message:tmessage);message TRAY_CALLBACK;
    procedure FormResize(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure SpeedButton1Click(Sender: TObject);
    procedure A1Click(Sender: TObject);
    procedure X1Click(Sender: TObject);
    procedure H1Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;


var
  Form1: TForm1;
  km:real;
  lastx,lasty:integer;
  aa:TNotifyIcondata;
implementation

{$R *.DFM}

procedure TForm1.Timer1Timer(Sender: TObject);
var point:TPoint;
begin
   windows.GetCursorPos(point);
   km:=km+(25.4*(sqrt((lastx-point.x)*(lastx-point.x)+(lasty-point.y)*(lasty-point.y))/screen.PixelsPerInch))/1000000;
   lastx:=point.x;
   lasty:=point.y;
   label1.caption:='Mouse Position:'+inttostr(lastx)+' '+inttostr(lasty);
   label2.caption:='Total Distance:'+format('%8.6f',[km])+' Km';
   strcopy(aa.sztip,pchar(label2.caption));
  shell_notifyicon(nim_modify,@aa);

end;

procedure TForm1.FormShow(Sender: TObject);
var baa:TPoint;
begin
  getcursorpos(baa);
  lastx:=baa.x;
  lasty:=baa.y;
  application.OnMinimize:=formresize;
//  aa.szTip:=
end;

procedure TForm1.FormCreate(Sender: TObject);
var tubiao:THandle;
begin
  tubiao:=application.Icon.handle;
  aa.uFlags:=NIF_MESSAGE or NIF_ICON or NIF_TIP;
  aa.uID:=uint(IDI_TRAYICON);
  aa.cbSize:=sizeof(tnotifyicondata);
  aa.uCallbackMessage:=tray_callback;
  aa.Wnd:=self.handle;
  aa.hIcon:=tubiao;
  aa.sztip:='Mouse Distance';
  shell_notifyicon(nim_add,@aa);
  showwindow(application.handle,sw_hide);
  form1.caption:='Mouse Distance[BeginTime'+timetostr(now)+']';
end;

procedure TForm1.traycallback(var message: tmessage);
var pp:tpoint;
begin
  if (message.LParam=WM_LBUTTONDOWN) then begin
     if (message.WParam=IDI_TRAYICON) then begin
        form1.show;
        application.Restore;
        showwindow(form1.handle,SW_RESTORE);
        windows.SetForegroundWindow(form1.handle);
        windows.SetActiveWindow(form1.handle);
     end;
  end;
  //左键
  if (message.LParam=WM_RBUTTONDOWN) then begin
     if (message.WParam=IDI_TRAYICON) then begin
         windows.GetCursorpos(pp);
         popupmenu1.popup(pp.x,pp.y);
     end;
  end;
  //右键
  inherited;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  speedbutton1.Left:=form1.Width-speedbutton1.width-20;
  speedbutton1.top:=4;
  if form1.WindowState=wsminimized then begin
    form1.hide;
  end;
  showwindow(application.handle,sw_hide);
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var tubiao:THandle;
begin
  tubiao:=application.Icon.handle;
  aa.uFlags:=NIF_MESSAGE or NIF_ICON or NIF_TIP;
  aa.uID:=uint(IDI_TRAYICON);
  aa.cbSize:=sizeof(tnotifyicondata);
  aa.uCallbackMessage:=tray_callback;
  aa.Wnd:=self.handle;
  aa.hIcon:=tubiao;
  aa.sztip:='鼠标跟踪';
  shell_notifyicon(nim_delete,@aa);
  showwindow(application.handle,sw_hide);

end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
 if application.MessageBox('确认重新开始计算吗?','提示',mb_okcancel+mb_iconquestion)<>idok then exit;
  km:=0;
  formshow(nil);
  form1.caption:='鼠标距离[开始时间'+timetostr(now)+']';
end;

procedure TForm1.A1Click(Sender: TObject);
var msg:string;
begin
  msg:='这个小玩意是不知不觉中想出来的一个小东东,利用中午休息的时间做的'#13#10;
  msg:=msg+'希望大家能够喜欢.这个小软件可以计算出你的鼠标移动的距离,一公里为'#13#10;
  msg:=msg+'单位,统计一下你的鼠标一天移动的距离,看一下是不是很吃惊??我一天的'#13#10;
  msg:=msg+'距离最高达2Km,可怕吧!?大家有兴趣的话也来试试。'#13#10;
  msg:=msg+#13#10'谢谢您的使用!';
  application.MessageBox(pchar(msg),'关于',mb_ok+mb_iconinformation);
end;

procedure TForm1.X1Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.H1Click(Sender: TObject);
var Buffer: array[0..127] of WideChar;
begin
  StringToWideChar('http://www.wapsec.com.cn/delphi/', Buffer, SizeOf(Buffer) div 2);
  if IsValidURL(nil, Buffer, 0) = 0 then HLinkNavigateString(nil, Buffer);
end;

procedure TForm1.N1Click(Sender: TObject);
begin
   form1.show;
   application.Restore;
   showwindow(form1.handle,SW_RESTORE);
   windows.SetForegroundWindow(form1.handle);
   windows.SetActiveWindow(form1.handle);
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -