unit1~5.~pa

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

        end;

        //clearing path matrix
        //image1.Canvas.brush.Color:=clwhite;
        for i:=1 to tilen+1 do begin
            for j:=1 to tilen+1 do begin
                //image1.Canvas.TextOut(x1[j,i],y1[j,i],inttostr(pathmx[j,i]));
                pathmx[j,i]:=-1;
            end;
        end;
        ////

    end;
    if balltag[ballch]=4 then begin
        //xstep:=0;
        //ystep:=0;
        //zstep:=0;
        if (ballx[ballch]=1) or (bally[ballch]=1) then image1.Canvas.Rectangle(ballrx[ballch],ballry[ballch]-5,ballrx[ballch]+ball1[ballch].width,ballry[ballch]+ball1[ballch].height);
        xstep:=round((x1[xsteps[sstt1],ysteps[sstt1]]-x1[xsteps[sstt1-1],ysteps[sstt1-1]])/4);
        ystep:=round((y1[xsteps[sstt1],ysteps[sstt1]]-y1[xsteps[sstt1-1],ysteps[sstt1-1]])/4);
        zstep:=4;
        scount:=0;
        track1:=0;
        balltag[ballch]:=5;
    end;
    if balltag[ballch]=5 then begin
        scount:=scount+1;
        if (ballx[ballch]=1) or (bally[ballch]=1) then image1.Canvas.Rectangle(ballrx[ballch],ballry[ballch]-1,ballrx[ballch]+ball1[ballch].width,ballry[ballch]+ball1[ballch].height);
        ballrx[ballch]:=ballrx[ballch]+xstep;
        ballry[ballch]:=ballry[ballch]+ystep;
        if scount<3 then ballry[ballch]:=ballry[ballch]-zstep
        else ballry[ballch]:=ballry[ballch]+zstep;

        track2:=0;
        if scount=3 then begin
            track2:=1;
        end;
        if (ballx[ballch]>1) and (xsteps[sstt1]=1) then begin
            if bally[ballch]>1 then begin
                image1.Canvas.ellipse(x1[xsteps[sstt1],ysteps[sstt1]-1],y1[xsteps[sstt1],ysteps[sstt1]-1],x1[xsteps[sstt1],ysteps[sstt1]-1]-32,y1[xsteps[sstt1],ysteps[sstt1]-1]+16);
            end;
        end;
        if (bally[ballch]>1) and (ysteps[sstt1]=1) then begin
            if ballx[ballch]>1 then begin
                image1.Canvas.ellipse(x1[xsteps[sstt1]-1,ysteps[sstt1]],y1[xsteps[sstt1]-1,ysteps[sstt1]],x1[xsteps[sstt1]-1,ysteps[sstt1]]+32,y1[xsteps[sstt1]-1,ysteps[sstt1]]+16);
            end;
        end;

//        if (ballx[ballch]=1) or (bally[ballch]=1) then track1:=1;

        ballshrx[ballch]:=ballshrx[ballch]+xstep;
        ballshry[ballch]:=ballshry[ballch]+ystep;
        if scount>=4 then begin
            ballmx[ballx[ballch],bally[ballch]]:=0;
            ballx[ballch]:=xsteps[sstt1];
            bally[ballch]:=ysteps[sstt1];
            ballmx[ballx[ballch],bally[ballch]]:=ballch;
            sstt1:=sstt1+1;
            xstep:=0;
            ystep:=0;
            zstep:=0;
            balltag[ballch]:=4;
            track1:=1;
            if sstt1>=sstt+1 then begin
                //ballrx[ballch]:=x1[ballx[xdest],bally[xdest]]-((tlwidth-ball1[ballch].Width) div 2);
                //ballry[ballch]:=y1[ballx[ydest],bally[ydest]]-(ball1[ballch].height-(tlheight div 2));
                by1:=ballry[ballch];
                balltag[ballch]:=6;
            end;
        end;
    end;
    if balltag[ballch]=6 then begin
        //image1.Cursor:=crArrow;

        for i:=1 to tilen do begin
            for j:=1 to 4 do begin
                disx[i,j]:=0;
                disy[i,j]:=0;
            end;
        end;
        //checking balls to eliminate by X axis
        discount[1]:=1;
        i:=1;
        while i <= tilen do begin
            if (ballmx[i,bally[ballch]]>0) and (balltype[ballmx[i,bally[ballch]]]=balltype[ballch]) then begin
                disx[discount[1],1]:=i;
                disy[discount[1],1]:=bally[ballch];
                discount[1]:=discount[1]+1;
            end
            else begin
                if discount[1]<6 then begin
                    for j:=1 to discount[1] do begin
                        disx[j,1]:=0;
                        disy[j,1]:=0;
                    end;
                    discount[1]:=1;
                end
                else i:=tilen;
            end;
            i:=i+1;
        end;
        discount[1]:=discount[1]-1;
        if discount[1]<5 then begin
            for i:=1 to 20 do begin
                disx[i,1]:=0;
                disy[i,1]:=0;
            end;
            //form1.Caption:='no X';
        end;
        //else balltag[ballch]:=7;
        /////
        //checking balls to eliminate by Y axis
        discount[2]:=1;
        i:=1;
        while i <= tilen do begin
            if (ballmx[ballx[ballch],i]>0) and (balltype[ballmx[ballx[ballch],i]]=balltype[ballch]) then begin
                disx[discount[2],2]:=ballx[ballch];
                disy[discount[2],2]:=i;
                discount[2]:=discount[2]+1;
            end
            else begin
                if discount[2]<6 then begin
                    for j:=1 to discount[2] do begin
                        disx[j,2]:=0;
                        disy[j,2]:=0;
                    end;
                    discount[2]:=1;
                end
                else i:=tilen;
            end;
            i:=i+1;
        end;
        discount[2]:=discount[2]-1;
        if discount[2]<5 then begin
            for i:=1 to 20 do begin
                disx[i,2]:=0;
                disy[i,2]:=0;
            end;
            //form1.Caption:='no';
        end;
        //else balltag[ballch]:=7;
        /////
        if ballx[ballch]<bally[ballch] then begin
            a:=1;
            b:=bally[ballch]-ballx[ballch]+1;
            c:=tilen-b+1;
        end
        else begin
            a:=ballx[ballch]-bally[ballch]+1;
            b:=1;
            c:=tilen-a+1;
        end;
        //form1.Caption:=inttostr(a)+', '+inttostr(b);
        discount[3]:=1;
        i:=1;
        while i <= c do begin
            if (ballmx[a,b]>0) and (balltype[ballmx[a,b]]=balltype[ballch]) then begin
                disx[discount[3],3]:=a;
                disy[discount[3],3]:=b;
                discount[3]:=discount[3]+1;
            end
            else begin
                if discount[3]<6 then begin
                    for j:=1 to discount[3] do begin
                        disx[j,3]:=0;
                        disy[j,3]:=0;
                    end;
                    discount[3]:=1;
                end
                else i:=c;
            end;
            a:=a+1;
            b:=b+1;
            i:=i+1;
        end;
        discount[3]:=discount[3]-1;
        if discount[3]<5 then begin
            for i:=1 to 20 do begin
                disx[i,3]:=0;
                disy[i,3]:=0;
            end;
            //form1.Caption:='no';
        end;
        ////
        if ballx[ballch]<tilen-bally[ballch]+1 then begin
            a:=1;
            b:=bally[ballch]+ballx[ballch]-1;
            c:=b;
        end
        else begin
            a:=ballx[ballch]-(tilen-bally[ballch]+1)+1;
            b:=tilen;
            c:=tilen-a+1;
        end;
        discount[4]:=1;
        i:=1;
        while i <= c do begin
            if (ballmx[a,b]>0) and (balltype[ballmx[a,b]]=balltype[ballch]) then begin
                disx[discount[4],4]:=a;
                disy[discount[4],4]:=b;
                discount[4]:=discount[4]+1;
            end
            else begin
                if discount[4]<6 then begin
                    for j:=1 to discount[4] do begin
                        disx[j,4]:=0;
                        disy[j,4]:=0;
                    end;
                    discount[4]:=1;
                end
                else i:=c;
            end;
            a:=a+1;
            b:=b-1;
            i:=i+1;
        end;
        discount[4]:=discount[4]-1;
        if discount[4]<5 then begin
            for i:=1 to 20 do begin
                disx[i,4]:=0;
                disy[i,4]:=0;
            end;
            //form1.Caption:='no';
        end;
        ////

        if discht=0 then begin
            newtag:=1;
        end
        else begin
            newtag:=0;
            discht:=1;
        end;
        //discht:=0;


        for i:=1 to 4 do begin
            if discount[i]>=5 then begin
                score:=score+discount[i];
                disptag:=1;
                newtag:=0;
            end;
        end;

        //making balls disappear
        {for i:=1 to 4 do begin
            if discount[i]>=5 then begin
                for j:=1 to discount[i] do begin
                    ballshow[ballmx[disx[j,i],disy[j,i]]]:=false;
                    ballmx[disx[j,i],disy[j,i]]:=0;
                    if(disx[j,i]=1) or (disy[j,i]=1) then image1.Canvas.Rectangle(x1[disx[j,i],disy[j,i]]-16,y1[disx[j,i],disy[j,i]]-16,x1[disx[j,i],disy[j,i]]+16,y1[disx[j,i],disy[j,i]]+16);
                    for a:=disy[j,i]-1 to disy[j,i] do begin
                        for b:=disx[j,i]-1 to disx[j,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:=disy[j,i]-1 to disy[j,i]+1 do begin
                        for b:=disx[j,i]-1 to disx[j,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;
            end;
        end;}

        balltag[ballch]:=0;
        ballch:=0;
    end;
end;

if ballch=0 then begin
    if ballch1>0 then begin
        if(ballx[ballch1]=1) or (bally[ballch1]=1) then image1.Canvas.Rectangle(ballrx[ballch1],ballry[ballch1]-5,ballrx[ballch1]+ball1[ballch1].width,ballry[ballch1]+ball1[ballch1].height);
        ballry[ballch1]:=by1;
        for i:=bally[ballch1]-1-track2 to bally[ballch1]+track1 do begin
          for j:=ballx[ballch1]-1-track2 to ballx[ballch1]+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]]);
                end;
            end;
          end;
        end;
        for i:=bally[ballch1]-1-track2 to bally[ballch1]+1+track1 do begin
          for j:=ballx[ballch1]-1-track2 to ballx[ballch1]+1+track1 do begin
            if (j>0) and (j<=tilen) and (i>0) and (i<=tilen) then begin
                if ballmx[j,i]>0 then begin
                    image1.Canvas.Draw(ballrx[ballmx[j,i]],ballry[ballmx[j,i]],ball1[ballmx[j,i]]);
                end;
            end;
          end;
        end;
        balltag[ballch]:=0;
        ballch1:=ballch;
    end;
end;

//Making balls disappear
if disptag=1 then begin
    dispfc:=dispfc+1;
    for i:=1 to 4 do begin
        if discount[i]>=5 then begin
            for j:=1 to discount[i] do begin
                image1.Canvas.Draw(ballrx[ballmx[disx[j,i],disy[j,i]]],ballry[ballmx[disx[j,i],disy[j,i]]],dispic[dispfc]);
            end;
        end;
    end;
    if dispfc>4 then begin
        dispfc:=0;
        disptag:=2;
    end;
end;
if disptag=2 then begin
        for i:=1 to 4 do begin
            if discount[i]>=5 then begin
                for j:=1 to discount[i] do begin
                    ballshow[ballmx[disx[j,i],disy[j,i]]]:=false;
                    ballx[ballmx[disx[j,i],disy[j,i]]]:=0;
                    bally[ballmx[disx[j,i],disy[j,i]]]:=0;
                    ballmx[disx[j,i],disy[j,i]]:=0;
                    if(disx[j,i]=1) or (disy[j,i]=1) then image1.Canvas.Rectangle(x1[disx[j,i],disy[j,i]]-16,y1[disx[j,i],disy[j,i]]-16,x1[disx[j,i],disy[j,i]]+16,y1[disx[j,i],disy[j,i]]+16);
                    for a:=disy[j,i]-1 to disy[j,i] do begin
                        for b:=disx[j,i]-1 to disx[j,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:=disy[j,i]-1 to disy[j,i]+1 do begin
                        for b:=disx[j,i]-1 to disx[j,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;