main.pas

Delphi版的宠物。大家可以看看呀。很好呀。

unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Menus,ShellAPI, ExtCtrls,Math, Buttons;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Timer2: TTimer;
    DogImage: TImage;
    Image1: TImage;
    Image2: TImage;
    Image3: TImage;
    Image4: TImage;
    SpeedButton1: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure RefreshRect; //局部刷新
    private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Count: byte=0;
  x,y: integer;
  ScreenCanvas: TCanvas;
const //定义图像大小
  w=35;
  h=35;
implementation
{$R *.DFM}
{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  x:=Screen.Width div 2;
  y:=Screen.Height div 2;
  ScreenCanvas:=TCanvas.Create;
  //窗体仅为一个按钮，显示在屏幕右上角
  Form1.Width:=80;
  Form1.Height:=25;
  Form1.Top:=0;
  Form1.Left:=screen.Width-80;
  //不在任务栏上显示图标
  SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  RefreshRect;
  ScreenCanvas.Free;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  MaskMap,Copy_NOT_OR: TBitMap;
begin
  //定义动作图像
  Timer1.Interval:=400;
  case Count of
    0:DogImage.picture:=Image1.picture;
    1:DogImage.picture:=image2.picture;
    2:DogImage.picture:=Image3.picture;
    3:DogImage.picture:=Image4.picture;
  end;
  inc(Count);
  MaskMap:=TBitMap.Create;
  Copy_NOT_OR:=TBitMap.Create;
  MaskMap.Width:=w;
  MaskMap.Height:=h;
  Copy_NOT_OR.Width:=w;
  Copy_NOT_OR.Height:=h;
  BitBlt(MaskMap.Canvas.Handle,0,0,w,h,DogImage.Canvas.Handle,0,0,SrcCopy);
  //请注意:透明色一定要是白色。若为其它色就会出现问题
  //如果图像中有白色，请改为与白色相近的颜色,因为白色是透明色，不会显示，但相近的颜色会显示出来
  MaskMap.Mask($FFFFFF); //MaskMap:小狗轮廓外是白色，轮廓内全是黑色
  //先将小狗原始图像赋给Copy_NOT_OR
  BitBlt(Copy_NOT_OR.Canvas.Handle,0,0,w,h,DogImage.Canvas.Handle,0,0,SrcCopy);
  try
    if count>0 then RefreshRect;
    //屏幕图像句柄
    ScreenCanvas.Handle:=GetDc(0);
    {MaskMap与背景图像作And运算
    背景图像:小狗轮廓外是背景本身图像(透明!)，轮廓内全是黑色}
    BitBlt(ScreenCanvas.Handle,x,y,w,h,MaskMap.Canvas.Handle,0,0,SrcAnd);
    {MaskMap与Copy_NOT_OR作取反运算
    Copy_NOT_OR:小狗轮廓外是黑色的，轮廓内是小狗本来图像}
    BitBlt(Copy_NOT_OR.Canvas.Handle,0,0,w,h,MaskMap.Canvas.Handle,0,0,SrcInvert);
    {Copy_NOT_OR与背景图像作OR运算
    背景图像:小狗轮廓外是透明的，轮廓内是小狗本来图像}
    BitBlt(ScreenCanvas.Handle,x,y,w,h,Copy_NOT_OR.Canvas.Handle,0,0,SrcPaint);
    ReleaseDc(0,ScreenCanvas.Handle);
  finally
    MaskMap.Free;
    Copy_NOT_OR.Free;
  end;
  if count=4 then
  begin
    count:=0;
    Timer1.Enabled:=False;
    Timer1.Interval:=1;
    Sleep(400);
    Timer2.Enabled:=true;
  end;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
  RefreshRect;
  //定义当前位置(随便)
  Randomize;
  x:=x+50-random(100);
  y:=y+50-random(100);
  if (x>Screen.Width-40) or (x<=10) then
    x:=Screen.Width div 2;
  if (y>Screen.Height-40) or (y<=10) then
    y:=Screen.Height div 2;
  Timer2.Enabled:=False;
  Timer1.Enabled:=true;
end;

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

procedure TForm1.RefreshRect;
var
  Rect: TRect;
begin
  {
  刷新屏幕局部，清除切换窗口时留下的残影。
  如果窗口滚动较快，还是会在窗口上留下一个个小狗，因为刷新区大小仅为135*135。
  但刷新区太大，画面的闪烁感会比较明显。
  }
  Rect.Left:=x-50;
  Rect.Top:=y-50;
  Rect.Right:=x+85;
  Rect.Bottom:=y+85;
  RedrawWindow(0,@Rect,0,RDW_ERASE or RDW_INVALIDATE or RDW_INTERNALPAINT or RDW_ERASENOW or RDW_ALLCHILDREN);
  sleep(5); //若不延时,将不能刷新局部屏幕
end;

end.