⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.pas

📁 用于开发税务票据管理的软件
💻 PAS
📖 第 1 页 / 共 4 页
字号:
    dispic[i].LoadFromFile('res\balls\disb'+inttostr(i)+'.bmp');
    dispic[i].Transparent:=true;
    dispic[i].TransparentColor:=dispic[i].Canvas.Pixels[0,0];
end;

//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
for i:=0 to 9 do begin
    scorepic[i]:=tbitmap.Create;
    scorepic[i].HandleType:=bmddb;
    scorepic[i].PixelFormat:=pf24bit;
    scorepic[i].LoadFromFile('res\numbers\n'+inttostr(i)+'.bmp');
    scorepic[i].Transparent:=false;
end;

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;
recput:=false;
////
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var i,j:integer;
begin
xp1:=x;
yp1:=y;
xp2:=xp1;
yp2:=yp1*2-60;
////
xp3:=xp2;
yp3:=yp2;
if not ((xp3=xcent) and (yp3=ycent)) then begin
    if (xp3-xcent>0) and (yp3-ycent<=0) then ppos:=1
    else if (xp3-xcent<=0) and (yp3-ycent<0) then ppos:=2
    else if (xp3-xcent<0) and (yp3-ycent>=0) then ppos:=3
    else if (xp3-xcent>=0) and (yp3-ycent>0) then ppos:=4;

    rad1:=sqrt(sqr(xp3-xcent)+sqr(yp3-ycent));
    cos1:=abs((xp3-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);

    xp3:=xcent+round(rad1*sin(angrad+angle1+pi/2));
    yp3:=ycent+round(rad1*cos(angrad+angle1+pi/2));
end;
////
if (xp3>=x3[1,1]) and (xp3<x3[tilen+1,1]) and (yp3>=y3[1,1]) and (yp3<y3[1,tilen+1]) then begin
    for i:=1 to tilen do begin
        if (xp3>=x3[i,1]) and (xp3<x3[i+1,1]) then begin
            xind:=i;
        end;
    end;
    for i:=1 to tilen do begin
        if (yp3>=y3[1,i]) and (yp3<y3[1,i+1]) then begin
            yind:=i;
        end;
    end;
    ////////////////
    if pushtag>0 then begin
      if (xind1<>xind) or (yind1<>yind) then begin
        if (xind1<>0) and (yind1<>0) and (ballmx[xind1,yind1]=0) then image1.Canvas.Draw(x1[xind1,yind1]-round(tlwidth/2),y1[xind1,yind1],floor1);
        if ballmx[xind,yind]=0 then image1.Canvas.Draw(x1[xind,yind]-round(tlwidth/2),y1[xind,yind],floorsh);

        if ballmx[xind,yind]=0 then begin
          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;
        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;
    press1:boolean;
begin
//pushtag:=-1*pushtag;
press1:=false;
if ballch>0 then begin
    if balltag[ballch]>2 then press1:=true;
end;
if disptag>0 then press1:=true;

if not press1 then begin
  if button=mbleft then begin
    if pushtag<0 then begin
        for i:=1 to tilen*tilen do begin
            if ballshow[i] then 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;
    end
    else begin
        if (xind>0) and (yind>0) then begin
            if ballmx[xind,yind]=0 then begin
                balltag[ballch]:=3;
                xdest:=xind;
                ydest:=yind;
                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;

end;

procedure TForm1.Timer1Timer(Sender: TObject);
var i,j,k,k1,a,b,c,d:integer;
    f1:textfile;
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
        //image1.Cursor:=crHourGlass;

        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;
               //image1.Cursor:=crArrow;
           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;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -