unitmain.pas

是和Delphi 编程精选集锦书本配套的源码

unit Unitmain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls,mmsystem;

type
  TForm1 = class(TForm)
    Timer1: TTimer;//爆炸定时器
    Image1: TImage;//储存爆炸的图片
    Image2: TImage;//储存飞行器的图片
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    DeskTopDC:HDC;//桌面窗口的图形设备描述表句柄
    stop:boolean;//控制循环的变量
    expnum:integer;//爆炸的当前次数
    procedure Explode(X:integer;Y:integer);//爆炸函数
    procedure shipmove(X:integer;Y:integer);//飞行器函数
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//保存桌面背景
procedure savebackground(BKCanvas :TCanvas;
                        sp_w:integer;
                        sp_h :integer ;
                        nx:integer;
                        ny:integer);
var sc:TCanvas;
begin
  sc:=TCanvas.Create;
  try
    sc.Handle:=GetDC(0);
    bkcanvas.CopyRect( rect(0,0,sp_w, sp_h), sc,rect(nx, ny, nx+sp_w, ny+sp_h));
    ReleaseDC(0, sc.handle);
  finally
    sc.free;
  end;
end;

//透明拷贝图像
procedure tranbit(hdcDest:HDC;
                    nXOriginDest:integer;
                    nYOriginDest:integer;
                    nWidthDest:integer;
                    hHeightDest:integer;
                    hdcSrc:HDC;
                    nXOriginSrc:integer;
                    nYOriginSrc:integer;
                    nWidthSrc:integer;
                    nHeightSrc:integer;
                    crTransparent:UINT) ;
Var
    LibHandle:HWND;
    DllName:Procedure(hdcDest:HDC;
                    nXOriginDest:integer;
                    nYOriginDest:integer;
                    nWidthDest:integer;
                    hHeightDest:integer;
                    hdcSrc:HDC;
                    nXOriginSrc:integer;
                    nYOriginSrc:integer;
                    nWidthSrc:integer;
                    nHeightSrc:integer;
                    crTransparent:UINT);Stdcall;
begin
    LibHandle:=LoadLibrary('msimg32.dll');
    if LibHandle<32 then
    begin
        MessageBox(Form1.Handle,'Not Found msimg32.dll','Error',0);
        Exit;
    end;
    @DllName:=GetProcAddress(LibHandle,'TransparentBlt');
    if @DllName=nil then
    begin
        MessageBox(Form1.Handle,'Not Found TransparentBlt in msimg32.dll','Error',0);
        FreeLibrary(LibHandle);
        Exit;
    end;
    try
        TransparentBlt(hdcDest,
                    nXOriginDest,
                    nYOriginDest,
                    nWidthDest,
                    hHeightDest,
                    hdcSrc,
                    nXOriginSrc,
                    nYOriginSrc,
                    nWidthSrc,
                    nHeightSrc,
                    crTransparent);
    finally
        FreeLibrary(LibHandle);
    end;
end;

//爆炸
procedure TForm1.Explode(X:integer;Y:integer);
var

    BitMapB : TBitMap;
    w:integer;
    h:integer;
    i:integer;
    j:integer;

begin

    BitMapB:=TBitMap.Create;
    try
        w:=Image1.Width div 4;
        h:=image1.Height div 5;

        BitMapB.Height :=h;
        BitMapB.Width :=w;

        savebackground(BitMapB.canvas,w,h,X,Y);

    for i:=0 to 4 do
    begin
        for j:=0 to 3 do
        begin
        tranbit(DeskTopDC ,x,y,w,h,image1.Canvas.Handle,j*w,i*h,w,h,RGB(208,2,178));
        Sleep(20);

        end ;

    end;
    bitblt(DeskTopDC,X,Y,w,h,BitMapB.Canvas.handle,0,0,srccopy);
    finally
        BitMapB.Free;
    end;
end;

procedure TForm1.shipmove(X:integer;Y:integer);
var
    w:integer;
    h:integer;
    i:integer;
    j:integer;
    k:integer;
    l:integer;

    BitMapB : TBitMap;
begin
    Randomize();

    BitMapB:=TBitMap.Create;
    try
        w:=Image2.Width div 4;
        h:=image2.Height div 16;

        BitMapB.Height :=h;
        BitMapB.Width :=w;
        k:=0;
        l:=0;
        while not stop do
            for i:=0 to 15 do
                for j:=0 to 3 do
                begin
                    if (i=15) and (i>0) then break;
                    savebackground(BitMapB.canvas,w,h,k,l);

                    tranbit(DeskTopDC ,k,l,w,h,image2.Canvas.Handle,j*w,i*h,w,h,RGB(208,2,178));

                    sleep(10);
                    bitblt(DeskTopDC,k,l,w,h,BitMapB.Canvas.handle,0,0,srccopy);
                    if(k<x)then k:=k+1;
                    if(l<y)then l:=l+1;
                    if timer1.Enabled =false then
                    if(k>x-10)then
                    begin
                        stop:=true;
                        timer1.Enabled :=true;
                    end;
            end;

    finally
        BitMapB.Free;
    end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
    x,y:integer;
begin
    
    if(expnum = 0) then
    begin
        Explode(screen.width div 2-20,screen.Height div 2-20);
        sndPlaySound('explosion.wav',SND_NOSTOP);
        expnum:=expnum+1;
    end
    else if expnum<10 then
    begin
        x:=Random(screen.Width-100);
        y:=Random(Screen.Height-100);

        Explode(x,y);
        sndPlaySound('explosion.wav',SND_NOSTOP);
        expnum:=expnum+1;
    end
    else
    begin
        stop:=true;
        timer1.Enabled :=false;
        close();
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
    DeskTopDC:=GetDC(0);
    chdir(ExtractFilePath(application.ExeName));
    stop:=false;
    expnum:=0;
    self.shipmove(screen.width div 2,screen.Height div 2);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    stop:=true;
    Timer1.Enabled :=false;
    ReleaseDC(0, DeskTopDC);
end;

end.