unit1~6.~pa

该程序用Delphi实现了一个不错的3D动画播放

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls,math, Menus;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Timer1: TTimer;
    MainMenu1: TMainMenu;
    Game1: TMenuItem;
    New1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    About1: TMenuItem;
    Game2: TMenuItem;
    Author1: TMenuItem;
    Records1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Timer1Timer(Sender: TObject);
    procedure New1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure Records1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const tlwidth = 64;
      tlheight = 32;

var
  Form1: TForm1;
  //isometric and tiles
  tilen:integer;
  x1,y1,x2,y2:array[1..30,1..30] of integer;
  xs,ys,xs1,ys1:integer;

  x3,y3:array[1..30,1..30] of integer;
  xcent,ycent,ppos:integer;
  angle1,rad1,cos1,angrad:real;

  xp1,yp1,xp2,yp2,xp3,yp3:integer;
  xind,yind,xind1,yind1:integer;

  floor1,floorsh:tbitmap;
  floorshb:pbytearray;

  pushtag:integer;
  //----------------------//

  //balls
  ballt:array[1..6] of tbitmap;

  ballpl:boolean;
  ball1:array[1..121] of tbitmap;
  balltype:array[1..121] of integer;
  ballshow:array[1..121] of boolean;
  ballnum: integer;
  ballx,bally,ballrx,ballry:array[1..121] of integer;
  by1:integer;
  balltag:array[1..121] of integer;

  ballmx:array[1..20,1..20] of byte;
  //balls shadows
  ballshm:tbitmap;
  ballsh:array[1..121] of tbitmap;
  ballshrx,ballshry:array[1..121] of integer;
  ballshb:pbytearray;
  //

  ballch,ballch1:integer;
  bfcount:integer;
  //path algorithm
  pathmx:array[1..20,1..20] of integer;
  xdest,ydest,reach1,dd,sstt,sstt1:integer;
  xrr,yrr,xxrr,yyrr:array[1..50] of integer;

  xsteps,ysteps:array[0..50] of integer;
  xstep,ystep,zstep,scount:integer;
  track1,track2:byte;
  //
  dismx:array[1..20,1..20] of integer;
  discount:array [1..4] of integer;
  disx,disy:array[1..20,1..4] of integer;

  disptag,dispfc:byte;
  dispic:array[1..4] of tbitmap;
  ////
  //adding new balls
  newtag:integer;
  newbtype,newbind:array[1..3] of integer;
  newbfc,newnum:integer;
  ////
  discht,disch:integer;

  //Score
  scorepic:array[0..9] of tbitmap;
  score,scorex:integer;
  scores,scores1:string;
  ////

implementation

uses Unit2;

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var i,j,xcorn:integer;
begin
randomize;
//////////////////////////////////////////////////////
//loading floor graphic
floor1:=tbitmap.Create;
floor1.HandleType:=bmddb;
floor1.PixelFormat:=pf24bit;
floor1.LoadFromFile('res\tiles\tile3.bmp');
//floor1.Transparent:=true;
//floor1.TransparentColor:=floor1.Canvas.Pixels[0,0];

floorsh:=tbitmap.Create;
floorsh.HandleType:=bmddb;
floorsh.PixelFormat:=pf24bit;
//floorsh.LoadFromFile('res\tiles\tile2.bmp');
floorsh.width:=floor1.width;
floorsh.height:=floor1.height;
floorsh.Canvas.Draw(0,0,floor1);
for i:=0 to floorsh.Height-1 do begin
    floorshb:=floorsh.ScanLine[i];
    for j:=0 to floorsh.Width-1 do begin
        if not ((floorshb[j*3]=getbvalue(floor1.Canvas.Pixels[0,0])) and (floorshb[j*3+1]=getgvalue(floor1.Canvas.Pixels[0,0])) and (floorshb[j*3+2]=getrvalue(floor1.Canvas.Pixels[0,0]))) then begin
            floorshb[j*3]:=round(floorshb[j*3]/2);
            floorshb[j*3+1]:=round(floorshb[j*3+1]/2);
            floorshb[j*3+2]:=round(floorshb[j*3+2]/2);
        end;
    end;
end;

//putting tile masks on flore tiles
floor1.Transparent:=true;
floor1.TransparentColor:=floor1.Canvas.Pixels[0,0];
floorsh.Transparent:=true;
floorsh.TransparentColor:=floorsh.Canvas.Pixels[0,0];
//
////

pushtag:=-1;
tilen:=9;

image1.Width:=tilen*tlwidth+1;
image1.height:=tilen*tlheight+35;
image1.Canvas.Brush.Color:=clblack;//$777777;
image1.Canvas.pen.Color:=image1.Canvas.Brush.Color;
image1.Canvas.FloodFill(0,0,clred,fsborder);
form1.ClientWidth:=image1.left+image1.Width;
form1.ClientHeight:=image1.top+image1.Height;
form1.Left:=(screen.width-form1.width) div 2;
form1.top:=(screen.height-form1.height) div 2;
//assigning isometric grid;
xs:=round(image1.width/2);
ys:=30;//round(tlheight/2);
for i:=1 to tilen+1 do begin
    xs1:=xs;
    ys1:=ys;
    for j:=1 to tilen+1 do begin
        x1[j,i]:=xs1;
        xs1:=xs1+round(tlwidth/2);
        y1[j,i]:=ys1;
        ys1:=ys1+round(tlheight/2);
    end;
    xs:=xs-round(tlwidth/2);
    ys:=ys+round(tlheight/2);
end;
////

//assigning streched isometric grid
//image2.Width:=tilen*tlwidth+1;
//image2.height:=tilen*2*tlheight+1;
xs:=round(image1.width/2);
ys:=0;
for i:=1 to tilen+1 do begin
    xs1:=xs;
    ys1:=ys;
    for j:=1 to tilen+1 do begin
        x2[j,i]:=xs1;
        xs1:=xs1+round(tlwidth/2);
        y2[j,i]:=ys1;
        ys1:=ys1+round(tlheight);
    end;
    xs:=xs-round(tlwidth/2);
    ys:=ys+round(tlheight);
end;
////

//turning streched isometric grid 45 degree ccw
xcent:=round(tilen*tlwidth/2);
ycent:=round(tilen*tlheight);
angle1:=pi/4;
for i:=1 to tilen+1 do begin
    for j:=1 to tilen+1 do begin
      if not ((x2[j,i]=xcent) and (y2[j,i]=ycent)) then begin
        if (x2[j,i]-xcent>0) and (y2[j,i]-ycent<=0) then ppos:=1
        else if (x2[j,i]-xcent<=0) and (y2[j,i]-ycent<0) then ppos:=2
        else if (x2[j,i]-xcent<0) and (y2[j,i]-ycent>=0) then ppos:=3
        else if (x2[j,i]-xcent>=0) and (y2[j,i]-ycent>0) then ppos:=4;

        rad1:=sqrt(sqr(x2[j,i]-xcent)+sqr(y2[j,i]-ycent));
        cos1:=abs((x2[j,i]-xcent)/rad1);

        if ppos=1 then angrad:=arccos(cos1)
        else if ppos=2 then angrad:=pi-arccos(cos1)
        else if ppos=3 then angrad:=pi+arccos(cos1)
        else if ppos=4 then angrad:=2*pi-arccos(cos1);

        x3[j,i]:=xcent+round(rad1*sin(angrad+angle1+pi/2));
        y3[j,i]:=ycent+round(rad1*cos(angrad+angle1+pi/2));
      end;
    end;
end;
////
for i:=1 to tilen do begin
    for j:=1 to tilen do begin
        image1.Canvas.Draw(x1[j,i]-round(tlwidth/2),y1[j,i],floor1);
    end;
end;
//drawing grid
{for i:=1 to tilen+1 do begin
    image1.Canvas.MoveTo(x1[i,1],y1[i,1]);
    image1.Canvas.LineTo(x1[i,tilen+1],y1[i,tilen+1]);

    image1.Canvas.MoveTo(x1[1,i],y1[1,i]);
    image1.Canvas.LineTo(x1[tilen+1,i],y1[tilen+1,i]);
end;
}
/////////////

//drawing streched and turned grid
{for i:=1 to tilen+1 do begin
    image2.Canvas.MoveTo(x2[i,1],y2[i,1]);
    image2.Canvas.LineTo(x2[i,tilen+1],y2[i,tilen+1]);

    image2.Canvas.MoveTo(x2[1,i],y2[1,i]);
    image2.Canvas.LineTo(x2[tilen+1,i],y2[tilen+1,i]);
end;
for i:=1 to tilen+1 do begin
    image2.Canvas.MoveTo(x3[i,1],y3[i,1]);
    image2.Canvas.LineTo(x3[i,tilen+1],y3[i,tilen+1]);

    image2.Canvas.MoveTo(x3[1,i],y3[1,i]);
    image2.Canvas.LineTo(x3[tilen+1,i],y3[tilen+1,i]);
end;}
////
xind:=0;
yind:=0;
xind1:=0;
yind1:=0;
////////////////////////////////////////////////
//clearing ball matrix
for i:=1 to 20 do begin
    for j:=1 to 20 do begin
        ballmx[j,i]:=0;
    end;
end;
/////
//loading balls
for i:=1 to 6 do begin
    ballt[i]:=tbitmap.Create;
    ballt[i].HandleType:=bmddb;
    ballt[i].PixelFormat:=pf24bit;
    ballt[i].LoadFromFile('res\balls\b'+inttostr(i)+'\b'+inttostr(i)+'.bmp');
    ballt[i].Transparent:=true;
    ballt[i].TransparentColor:=ballt[i].Canvas.Pixels[0,0];
end;
for i:=1 to tilen*tilen do begin
    ball1[i]:=tbitmap.create;
    //creating shadow
    ballsh[i]:=tbitmap.create;
    ballsh[i].HandleType:=bmddb;
    ballsh[i].PixelFormat:=pf24bit;
    ballsh[i].Width:=round(tlwidth/2);
    ballsh[i].Height:=round(tlheight/2);
    ////
    ballshow[i]:=false;
end;
ballshm:=tbitmap.create;
ballshm.HandleType:=bmddb;
ballshm.PixelFormat:=pf24bit;
ballshm.LoadFromFile('res\balls\ballsh.bmp');
ballshm.Transparent:=true;
ballshm.TransparentColor:=ballshm.Canvas.Pixels[16,8];
////
ballnum:=5;//number of balls
for i:=1 to 4 do discount[i]:=0;
for i:=1 to ballnum do begin
    balltype[i]:=random(6)+1;
    ballshow[i]:=true;
    //finding starting coordinates
    if i>1 then begin
        ballpl:=false;
        while not ballpl do begin
            ballpl:=true;
            ballx[i]:=random(tilen)+1;
            bally[i]:=random(tilen)+1;
            for j:=1 to i-1 do begin
                if (ballx[i]=ballx[j]) and (bally[i]=bally[j]) then ballpl:=false;
            end;
        end;
    end
    else begin
        ballx[i]:=random(tilen)+1;
        bally[i]:=random(tilen)+1;
    end;
    ballmx[ballx[i],bally[i]]:=i;
    ///

    ball1[i]:=ballt[balltype[i]];
    ballrx[i]:=x1[ballx[i],bally[i]]-((tlwidth-ball1[i].Width) div 2);
    ballry[i]:=y1[ballx[i],bally[i]]-(ball1[i].height-(tlheight div 2));

    ballshrx[i]:=x1[ballx[i],bally[i]]-16;
    ballshry[i]:=y1[ballx[i],bally[i]]+8;

    ballsh[i].Canvas.CopyRect(rect(0,0,ballsh[i].Width,ballsh[i].Height),floorsh.Canvas,rect((tlwidth-ballsh[i].width) div 2, (tlheight-ballsh[i].height) div 2, (tlwidth-ballsh[i].width) div 2 + ballsh[i].width, (tlheight-ballsh[i].height) div 2 + ballsh[i].height));
    ballsh[i].Canvas.draw(0,0,ballshm);
    ballsh[i].Transparent:=true;
    ballsh[i].TransparentColor:=ballsh[i].Canvas.Pixels[0,0];

    balltag[i]:=0;
end;
//drawing balls
for i:=1 to ballnum do begin
    image1.Canvas.Draw(ballshrx[i],ballshry[i],ballsh[i]);
end;
for i:=1 to ballnum do begin
    image1.Canvas.Draw(ballrx[i],ballry[i],ball1[i]);
end;
////
ballch:=0;//selected ball
ballch1:=0;

//clearing path matrix
for i:=1 to 20 do begin
    for j:=1 to 20 do begin
        pathmx[j,i]:=-1;