www.pudn.com > deskpetDIY.rar > main.pas

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.