unit1.pas

一个桌面宠物的例子

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, OleCtrls, AgentObjects_TLB, Menus,
  CoolTrayIcon;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    MyAgent: TAgent;
    Timer2: TTimer;
    CoolTrayIcon1: TCoolTrayIcon;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    A1: TMenuItem;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure GetShell_TrayWnd_Rect;
    procedure flying(x:integer;y:integer;speed:integer);
    function ListAct(filename:string):integer;
    procedure Timer2Timer(Sender: TObject);
    procedure N1Click(Sender: TObject);
  private
    { Private declarations }
    Peedy: IAgentCtlCharacter;
    Request1,Request2: IagentCtlRequest;
  public
    { Public declarations }
    h_old:HWnd;
    WinRect_old:TRect;
    Shell_TrayWnd_Rect:TRect;
    PeedyWidth:integer;
    PeedyHeight:integer;
    flyingDown:integer;
    ArrAct:array [1..255] of String;
    acsnum:integer;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);
var
  h: HWnd;
  Text: array [0..255] of char;
  WinRect:TRect;
  i:integer;
begin
  h:=GetForegroundWindow;
  Windows.GetWindowRect(h,WinRect);

  if (WinRect.left<50) or (WinRect.top<50) or (WinRect.Left>screen.Width-50) or (WinRect.top>screen.Height) then begin
      if flyingDown=0 then begin
        flying(Random(Shell_TrayWnd_Rect.Right-Shell_TrayWnd_Rect.Left-PeedyWidth),Shell_TrayWnd_Rect.Top,10);
        flyingDown:=1;
      end
      else begin
        exit;
      end;
  end;


  Timer2.Enabled:=true;

  if h<>h_old then begin
    if flyingDown=0 then begin
      flying(Random(Shell_TrayWnd_Rect.Right-Shell_TrayWnd_Rect.Left-PeedyWidth),Shell_TrayWnd_Rect.Top,10);
      flyingDown:=1;
    end
    else
    begin
      WinRect_old:=WinRect;
      flying(WinRect.Left+Random(WinRect.Right-WinRect.Left-Peedy.Width),WinRect.top,2);
      flyingDown:=0;
      h_old:=h;
    end;
  end
  else begin
    if (WinRect_old.left<>WinRect.Left) or (WinRect_old.top<>WinRect.top) then begin
      flying(WinRect.Left+Random(WinRect.Right-WinRect.Left-Peedy.Width),WinRect.top,2);
      WinRect_old:=WinRect;
    end;
  end;




end;

procedure TForm1.FormCreate(Sender: TObject);
var
acsfile:string;
begin

application.ShowMainForm:=False;

acsfile:=extractfilepath(application.ExeName)+'\Peedy.dat';

GetShell_TrayWnd_Rect;

acsnum:=ListAct(acsfile);

Request1:=MyAgent.Characters.Load('Peedy',acsfile);
Peedy:=MyAgent.Characters.Character('Peedy');

PeedyWidth:=Peedy.Width;
PeedyHeight:=Peedy.Height;

flying(Random(Shell_TrayWnd_Rect.Right-Shell_TrayWnd_Rect.Left-PeedyWidth),Shell_TrayWnd_Rect.Top,10);
flyingDown:=1;

Peedy.Show(0);
end;



procedure TForm1.GetShell_TrayWnd_Rect;
var 
wndHandle: THandle; 
wndClass: array[0..50] of Char;  
begin 
strPCopy(@wndClass[0], 'Shell_TrayWnd'); //获取任务栏类名 
wndHandle := FindWindow(@wndClass[0],nil); //获取任务栏窗口的句柄 
//ShowWindow(wndHandle, SW_Hide); //隐藏Windows任务栏 
Windows.GetWindowRect(wndHandle,Shell_TrayWnd_Rect);
end;

procedure TForm1.flying(x:integer;y:integer;speed:integer);
begin

Timer2.Enabled:=false;

Timer1.Enabled:=false;

Peedy.MoveTo(x,y-PeedyHeight+10,speed);

Timer1.Enabled:=True;

end;


function TForm1.ListAct(filename:string):integer;
var
f,i,ii:Integer;
Adress,ActNum,CharNum:integer;
ch:char;
str:string;
begin
f:=FileOpen(FileName,fmOpenRead or fmShareDenyNone);

FileSeek(f,12,soFromBeginning);
Fileread(f,Adress,4);
FileSeek(f,Adress,soFromBeginning);
Fileread(f,ActNum,4);

//ListBox1.Clear;

for ii:=1 to ActNum do
begin

Fileread(f,CharNum,4);

str:='';

for i:=1 to CharNum do
begin
Fileread(f,ch,1);
FileSeek(f,1,soFromCurrent);
str:=str+ch;
end;


//ListBox1.Items.Add(str);

ArrAct[ii]:=str;

FileSeek(f,10,soFromCurrent);

end;

fileclose(f);

result:=ActNum;

end;

procedure TForm1.Timer2Timer(Sender: TObject);
var
Acsindex:integer;
begin
Timer2.Enabled:=false;
Timer2.Interval:=(Random(9)+1)*1000;
Acsindex:=Random(acsnum-1)+1;
Peedy.Stop(Request1);
try
Request1:=Peedy.Play(ArrAct[Acsindex]);
except

end;
Timer2.Enabled:=true;

end;

procedure TForm1.N1Click(Sender: TObject);
begin
self.Close;
end;

end.