unit1~5.~pa

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

                        end;
                    end;
                end;
            end;
        end;

    //drawing score
    scores:='0000';
    scores1:=inttostr(score);
    j:=1;
    for i:=5-length(scores1) to 4 do begin
        scores[i]:=scores1[j];
        j:=j+1;
    end;
    for i:=1 to 4 do begin
        scorex:=image1.Width-10-((5-i)*tlheight);
        image1.Canvas.Draw(scorex,10,scorepic[strtoint(scores[i])]);
    end;
    ////
    disptag:=0;
    if discht=2 then discht:=1;
end;
//end;

//putting new bals;

if newtag=1 then begin
    //checking if there is enough space to put three balls
    k:=0;
    for i:=1 to tilen*tilen do begin
        if ballshow[i] then k:=k+1;
    end;
    if tilen*tilen-k>=3 then k1:=3
    else k1:=tilen*tilen-k;
    newtag:=2;
end;
if newtag=2 then begin
    for i:=1 to k1 do begin
        k:=1;
        while k<=tilen*tilen do begin
            if not ballshow[k] then begin
                newbind[i]:=k;
                ballshow[k]:=true;
                k:=tilen*tilen;
            end;
            k:=k+1;
        end;
    end;

    for i:=1 to k1 do begin
        ballpl:=false;
        while not ballpl do begin
            ballpl:=true;
            ballx[newbind[i]]:=random(tilen)+1;
            bally[newbind[i]]:=random(tilen)+1;
            for k:=1 to tilen*tilen do begin
                if (ballshow[k]) and (newbind[i]<>k) then begin
                    if (ballx[newbind[i]]=ballx[k]) and (bally[newbind[i]]=bally[k]) then ballpl:=false;
                end;
            end;
        end;
        ballmx[ballx[newbind[i]],bally[newbind[i]]]:=newbind[i];
        balltype[newbind[i]]:=newbtype[i];

        ball1[newbind[i]]:=ballt[balltype[newbind[i]]];

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

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

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

        balltag[newbind[i]]:=0;

        //drawing new balls
        {if(ballx[newbind[i]]=1) or (bally[newbind[i]]=1) then image1.Canvas.Rectangle(x1[ballx[newbind[i]],bally[newbind[i]]]-16,y1[ballx[newbind[i]],bally[newbind[i]]]-16,x1[ballx[newbind[i]],bally[newbind[i]]]+16,y1[ballx[newbind[i]],bally[newbind[i]]]+16);

        for a:=bally[newbind[i]]-1 to bally[newbind[i]] do begin
            for b:=ballx[newbind[i]]-1 to ballx[newbind[i]] do begin
                if (b>0) and (b<=tilen) and (a>0) and (a<=tilen) then begin
                    image1.Canvas.Draw(x1[b,a]-round(tlwidth/2),y1[b,a],floor1);
                    if ballmx[b,a]>0 then begin
                        image1.Canvas.Draw(ballshrx[ballmx[b,a]],ballshry[ballmx[b,a]],ballsh[ballmx[b,a]]);
                    end;
                end;
            end;
        end;
        for a:=bally[newbind[i]]-1 to bally[newbind[i]]+1 do begin
            for b:=ballx[newbind[i]]-1 to ballx[newbind[i]]+1 do begin
                if (b>0) and (b<=tilen) and (a>0) and (a<=tilen) then begin
                    if ballmx[b,a]>0 then begin
                        image1.Canvas.Draw(ballrx[ballmx[b,a]],ballry[ballmx[b,a]],ball1[ballmx[b,a]]);
                    end;
                end;
            end;
        end;
        ///////////////}
    end;

    newbfc:=0;
    newnum:=k1;
    newtag:=3;

    {newtag:=0;
    k:=10;
    for i:=1 to 3 do begin
        newbtype[i]:=random(6)+1;
        image1.Canvas.Draw(k,10,ballt[newbtype[i]]);
        k:=k+ballt[newbtype[i]].width;
    end;}
end;
if newtag=3 then begin
    newbfc:=newbfc+1;
    for i:=1 to newnum do begin
        image1.Canvas.Draw(ballrx[newbind[i]],ballry[newbind[i]],dispic[newbfc]);
    end;
    if newbfc>=4 then begin
        newbfc:=0;
        newtag:=4;
    end;
end;
if newtag=4 then begin
    for i:=1 to newnum do begin
        if(ballx[newbind[i]]=1) or (bally[newbind[i]]=1) then image1.Canvas.Rectangle(x1[ballx[newbind[i]],bally[newbind[i]]]-16,y1[ballx[newbind[i]],bally[newbind[i]]]-16,x1[ballx[newbind[i]],bally[newbind[i]]]+16,y1[ballx[newbind[i]],bally[newbind[i]]]+16);
        for a:=bally[newbind[i]]-1 to bally[newbind[i]] do begin
            for b:=ballx[newbind[i]]-1 to ballx[newbind[i]] do begin
                if (b>0) and (b<=tilen) and (a>0) and (a<=tilen) then begin
                    image1.Canvas.Draw(x1[b,a]-round(tlwidth/2),y1[b,a],floor1);
                    if ballmx[b,a]>0 then begin
                        image1.Canvas.Draw(ballshrx[ballmx[b,a]],ballshry[ballmx[b,a]],ballsh[ballmx[b,a]]);
                    end;
                end;
            end;
        end;
        for a:=bally[newbind[i]]-1 to bally[newbind[i]]+1 do begin
            for b:=ballx[newbind[i]]-1 to ballx[newbind[i]]+1 do begin
                if (b>0) and (b<=tilen) and (a>0) and (a<=tilen) then begin
                    if ballmx[b,a]>0 then begin
                        image1.Canvas.Draw(ballrx[ballmx[b,a]],ballry[ballmx[b,a]],ball1[ballmx[b,a]]);
                    end;
                end;
            end;
        end;
    end;
    newtag:=0;
    k:=10;
    for i:=1 to 3 do begin
        newbtype[i]:=random(6)+1;
        image1.Canvas.Draw(k,10,ballt[newbtype[i]]);
        k:=k+ballt[newbtype[i]].width;
    end;

    if newnum>0 then begin
        discht:=1;
        disch:=0;
    end;
end;
////

//----------//
if (discht=1) and (disptag=0) then begin
    disch:=disch+1;
    if ballmx[ballx[newbind[disch]],bally[newbind[disch]]]>0 then begin
        ballch:=newbind[disch];
        balltag[ballch]:=6;
        discht:=2;
    end;
    if disch>newnum then begin
        disch:=0;
        discht:=0;
    end;
end;
//----------//

if ballch>0 then begin
    if(ballx[ballch]=1) or (bally[ballch]=1) then begin
        if balltag[ballch]>3 then image1.Canvas.ellipse(ballrx[ballch],ballry[ballch]-1,ballrx[ballch]+ball1[ballch].width,ballry[ballch]+ball1[ballch].height)
        else image1.Canvas.rectangle(ballrx[ballch],ballry[ballch]-1,ballrx[ballch]+ball1[ballch].width,ballry[ballch]+ball1[ballch].height)
    end;
    for i:=bally[ballch]-1-track2 to bally[ballch]+track1 do begin
        for j:=ballx[ballch]-1-track2 to ballx[ballch]+track1 do begin
            if (j>0) and (j<=tilen) and (i>0) and (i<=tilen) then begin
                image1.Canvas.Draw(x1[j,i]-round(tlwidth/2),y1[j,i],floor1);
                if ballmx[j,i]>0 then begin
                    image1.Canvas.Draw(ballshrx[ballmx[j,i]],ballshry[ballmx[j,i]],ballsh[ballmx[j,i]]);
                    //image1.Canvas.Draw(ballrx[ballmx[j,i]],ballry[ballmx[j,i]],ball1[ballmx[j,i]]);
                end;
                if pushtag>0 then begin
                    if (xind1=j) and (yind1=i) then begin
                        if ballmx[xind1,yind1]=0 then begin
                            image1.Canvas.Draw(x1[xind1,yind1]-round(tlwidth/2),y1[xind1,yind1],floorsh);
                        end;
                    end;
                end;
            end;
        end;
    end;
    for i:=bally[ballch]-1-track2 to bally[ballch]+1+track1 do begin
        for j:=ballx[ballch]-1-track2 to ballx[ballch]+1+track1 do begin
            if (j>0) and (j<=tilen) and (i>0) and (i<=tilen) then begin
                //image1.Canvas.Draw(x1[j,i]-round(tlwidth/2),y1[j,i],floor1);
                if ballmx[j,i]>0 then begin
                    //image1.Canvas.Draw(ballshrx[ballmx[j,i]],ballshry[ballmx[j,i]],ballsh[ballmx[j,i]]);
                    image1.Canvas.Draw(ballrx[ballmx[j,i]],ballry[ballmx[j,i]],ball1[ballmx[j,i]]);
                end;
            end;
        end;
    end;
    if ballmx[ballx[ballch]+2,bally[ballch]+1]>0 then image1.Canvas.Draw(ballrx[ballmx[ballx[ballch]+2,bally[ballch]+1]],ballry[ballmx[ballx[ballch]+2,bally[ballch]+1]],ball1[ballmx[ballx[ballch]+2,bally[ballch]+1]]);
    if ballmx[ballx[ballch]+1,bally[ballch]+2]>0 then image1.Canvas.Draw(ballrx[ballmx[ballx[ballch]+1,bally[ballch]+2]],ballry[ballmx[ballx[ballch]+1,bally[ballch]+2]],ball1[ballmx[ballx[ballch]+1,bally[ballch]+2]]);
end;
////
end;

procedure TForm1.New1Click(Sender: TObject);
var i,j,xcorn:integer;
begin
image1.Canvas.Rectangle(0,0,image1.width,image1.height);
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;

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;
/////
for i:=1 to tilen*tilen do begin
    ballshow[i]:=false;
end;

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
////////////
//clearing path matrix
for i:=1 to 20 do begin
    for j:=1 to 20 do begin
        pathmx[j,i]:=-1;
        dismx[j,i]:=0;
    end;
end;
//
xstep:=0;
ystep:=0;
zstep:=0;

track1:=0;
track2:=0;

disptag:=0;
dispfc:=0;

//new bals;
newtag:=0;
xcorn:=10;
newnum:=0;
for i:=1 to 3 do begin
    newbtype[i]:=random(6)+1;
    image1.Canvas.Draw(xcorn,10,ballt[newbtype[i]]);
    xcorn:=xcorn+ballt[newbtype[i]].width;
end;
////
disch:=0;
discht:=0;

//score
score:=0;
scores:='0000';
scores1:=inttostr(score);
j:=1;
for i:= 5-length(scores1) to 4 do begin
    scores[i]:=scores1[j];
    j:=j+1;
end;
for i:=1 to 4 do begin
    scorex:=image1.Width-10-((5-i)*tlheight);
    image1.Canvas.Draw(scorex,10,scorepic[strtoint(scores[i])]);
end;
////
end;

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

end.