unit1~3.~pa

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

            for j:=xind-1 to xind+1 do begin
                if (j>0) and (j<=tilen) and (i>0) and (i<=tilen) then begin
                    if ballmx[j,i]>0 then image1.Canvas.Draw(ballrx[ballmx[j,i]],ballry[ballmx[j,i]],ball1[ballmx[j,i]]);
                end;
            end;
          end;
        end;
        if ballmx[xind1,yind1]=0 then begin
          for i:=yind1-1 to yind1+1 do begin
            for j:=xind1-1 to xind1+1 do begin
                if (j>0) and (j<=tilen) and (i>0) and (i<=tilen) then begin
                    if ballmx[j,i]>0 then image1.Canvas.Draw(ballrx[ballmx[j,i]],ballry[ballmx[j,i]],ball1[ballmx[j,i]]);
                end;
            end;
          end;
        end;

        {image1.Canvas.MoveTo(x1[xind1,yind1],y1[xind1,yind1];
        image1.Canvas.LineTo(x1[xind1+1,yind1],y1[xind1+1,yind1]);
        image1.Canvas.LineTo(x1[xind1+1,yind1+1],y1[xind1+1,yind1+1]);
        image1.Canvas.LineTo(x1[xind1,yind1+1],y1[xind1,yind1+1]);
        image1.Canvas.LineTo(x1[xind1,yind1],y1[xind1,yind1]);}
      end;
    end;
    ////////////////
end
else begin
    xind:=0;
    yind:=0;

    if pushtag>0 then begin
      if (xind1<>0) and (yind1<>0) then begin
        if ballmx[xind1,yind1]=0 then begin
          image1.Canvas.Draw(x1[xind1,yind1]-round(tlwidth/2),y1[xind1,yind1],floor1);
          for i:=yind1-1 to yind1+1 do begin
            for j:=xind1-1 to xind1+1 do begin
                if (j>0) and (j<=tilen) and (i>0) and (i<=tilen) then begin
                    if ballmx[j,i]>0 then image1.Canvas.Draw(ballrx[ballmx[j,i]],ballry[ballmx[j,i]],ball1[ballmx[j,i]]);
                end;
            end;
          end;
        end;
      end;
    end;
end;
xind1:=xind;
yind1:=yind;
form1.Caption:='X:'+inttostr(xind)+', Y:'+inttostr(yind);



end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var i,j:integer;
begin
//pushtag:=-1*pushtag;

if button=mbleft then begin
    if pushtag<0 then begin
        for i:=1 to ballnum do begin
            if (x>=ballrx[i]) and (x<=ballrx[i]+ball1[i].width) and (y>=ballry[i]) and (y<=ballry[i]+ball1[i].height) then begin
                ballch:=i;
                balltag[ballch]:=0;
                pushtag:=1;
            end;
        end;
    end
    else begin
        if (xind>0) and (yind>0) then begin
            if ballmx[xind,yind]=0 then begin
                balltag[ballch]:=3;
                pushtag:=-1;
            end;
        end;
    end;
end
else begin
    pushtag:=-1;
    if ballch>0 then balltag[ballch]:=0;
    ballch:=0;
end;

{if pushtag>0 then begin
   if (xind<>0) and (yind<>0) then begin
       image1.Canvas.Draw(x1[xind,yind]-round(tlwidth/2),y1[xind,yind],floorsh);
       for i:=1 to ballnum do begin
            image1.Canvas.Draw(ballrx[i],ballry[i],ball1[i]);
       end;
   end;
end;}
if pushtag<0 then begin
   if (xind<>0) and (yind<>0) then begin
       if ballmx[xind,yind]=0 then image1.Canvas.Draw(x1[xind,yind]-round(tlwidth/2),y1[xind,yind],floor1);
       for i:=yind-1 to yind+1 do begin
           for j:=xind-1 to xind+1 do begin
               if (j>0) and (j<=tilen) and (i>0) and (i<=tilen) then begin
                   if ballmx[j,i]>0 then image1.Canvas.Draw(ballrx[ballmx[j,i]],ballry[ballmx[j,i]],ball1[ballmx[j,i]]);
               end;
           end;
       end;
       {for i:=1 to ballnum do begin
            image1.Canvas.Draw(ballrx[i],ballry[i],ball1[i]);
       end;}
   end;
end;

end;

procedure TForm1.Timer1Timer(Sender: TObject);
var i,j,a,b,c,d:integer;
begin
//main sicle
if ballch>0 then begin
    if balltag[ballch]=0 then begin
        bfcount:=0;
        by1:=ballry[ballch];
        balltag[ballch]:=1;
        ballch1:=ballch;
    end;
    if balltag[ballch]=1 then begin
        bfcount:=bfcount-1;
        ballry[ballch]:=ballry[ballch]-1;
        if bfcount<-4 then balltag[ballch]:=2;
    end;
    if balltag[ballch]=2 then begin
        bfcount:=bfcount+1;
        ballry[ballch]:=ballry[ballch]+1;
        if bfcount>=0 then balltag[ballch]:=1;
    end;
    if balltag[ballch]=3 then begin
        ballry[ballch]:=by1;
        //path code
//        ballch:=0;

        sstt:=0;

        xrr[1]:=ballx[ballch];
        yrr[1]:=bally[ballch];

        pathmx[xrr[1],yrr[1]]:=sstt;

        xdest:=xind;
        ydest:=yind;


        reach1:=0; //eligibility of destination point flag
        dd:=1;

        while reach1=0 do begin
           sstt:=sstt+1;
           c:=0;
           for d:=1 to dd do begin
             for b:=xrr[d]-1 to xrr[d]+1 do begin
                 a:=yrr[d];
                 if (b>0) and (b<=tilen) and (a>0) and (a<=tilen) then begin
                     if (ballmx[b,a]=0) and (pathmx[b,a]=-1) then begin
                         pathmx[b,a]:=sstt;
                         c:=c+1;
                         xxrr[c]:=b;
                         yyrr[c]:=a;
                     end;
                     if (b=xdest) and (a=ydest) then reach1:=1;
                 end;
             end;
             for a:=yrr[d]-1 to yrr[d]+1 do begin
                 b:=xrr[d];
                 if (b>0) and (b<=tilen) and (a>0) and (a<=tilen) then begin
                     if (ballmx[b,a]=0) and (pathmx[b,a]=-1) then begin
                         pathmx[b,a]:=sstt;
                         c:=c+1;
                         xxrr[c]:=b;
                         yyrr[c]:=a;
                     end;
                     if (b=xdest) and (a=ydest) then reach1:=1;
                 end;
             end;
           end;
           if c>0 then begin
              for d:=1 to c do begin
                 xrr[d]:=xxrr[d];
                 yrr[d]:=yyrr[d];
              end;
           end
           else begin //the destinaton point is unavailable
               reach1:=2;
               balltag[ballch]:=0;
               ballch:=0;
           end;
           dd:=c;
        end;

        if reach1=1 then begin
            //ballch:=0;
            sstt1:=sstt;
            xsteps[sstt1]:=xdest;
            ysteps[sstt1]:=ydest;
            while sstt1>1 do begin
                sstt1:=sstt1-1;
                if pathmx[xsteps[sstt1+1]+1,ysteps[sstt1+1]]=sstt1 then begin
                    xsteps[sstt1]:=xsteps[sstt1+1]+1;
                    ysteps[sstt1]:=ysteps[sstt1+1];
                end
                else if pathmx[xsteps[sstt1+1]-1,ysteps[sstt1+1]]=sstt1 then begin
                    xsteps[sstt1]:=xsteps[sstt1+1]-1;
                    ysteps[sstt1]:=ysteps[sstt1+1];
                end
                else if pathmx[xsteps[sstt1+1],ysteps[sstt1+1]+1]=sstt1 then begin
                    xsteps[sstt1]:=xsteps[sstt1+1];
                    ysteps[sstt1]:=ysteps[sstt1+1]+1;
                end
                else if pathmx[xsteps[sstt1+1],ysteps[sstt1+1]-1]=sstt1 then begin
                    xsteps[sstt1]:=xsteps[sstt1+1];
                    ysteps[sstt1]:=ysteps[sstt1+1]-1;
                end;
            end;
            xsteps[0]:=ballx[ballch];
            ysteps[0]:=bally[ballch];
        end;

        if reach1=1 then begin
            //image1.Canvas.brush.Color:=clwhite;
            for i:=0 to sstt do begin
                //image1.Canvas.TextOut(x1[xsteps[i],ysteps[i]],y1[xsteps[i],ysteps[i]],inttostr(pathmx[xsteps[i],ysteps[i]]));
                sstt1:=1;
                balltag[ballch]:=4
            end;
        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
        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;

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;

end.