网页资讯视频图片知道文库贴吧地图采购
进入贴吧全吧搜索
pascal吧 关注：14,951贴子：132,335

【Rijn】五子棋 FiveInARow 1.0.1905

优化了下。。从36kb缩减成32kb。。
上个版本竟然没人看。。。。。


{2}
procedure InitChess;
var
   grDriver: Integer;
   grMode: Integer;
   ErrCode: Integer;
   HalfX,HalfY,H:Word;
   ex,ey,i,j:Word;
   k:integer;
   strtemp:string;
begin
   DirectVideo:=False;
   Randomize;
   JustBegin:=True;
   V0.VN:=0;
   V0.V:=0;V0.D:=25;
   V0.LD:=5;V0.RD:=5;
   V0.LB:=False;
   V0.RB:=False;
   for i:=1 to ChessW do
     for j:=1 to ChessW do
     begin
       Order[i,j]:=0;
       Value[1,i,j,0]:=V0;
       Value[1,i,j,1]:=V0;
       Value[1,i,j,2]:=V0;
       Value[1,i,j,3]:=V0;
       Value[1,i,j,4]:=V0;
       Value[2,i,j,0]:=V0;
       Value[2,i,j,1]:=V0;
       Value[2,i,j,2]:=V0;
       Value[2,i,j,3]:=V0;
       Value[2,i,j,4]:=V0;
     end;
   for i:=0 to ChessW+1 do
   begin
     Order[i,0]:=$ff;
     Order[0,i]:=$ff;
     Order[i,ChessW+1]:=$ff;
     Order[ChessW+1,0]:=$ff;
   end;
   CurrentX:=ChessW div 2;CurrentY:=ChessW div 2;
   grDriver := Detect;
   InitGraph(grDriver, grMode,'C:\TP\BGI');           
   ErrCode := GraphResult;
   if ErrCode <> grOk then halt;
   SetFillStyle(1,White);
   FloodFill(1,1,White);
   IconWidth0:=IconWidth div 5;
   IconX:=(GetMaxX-IconWidth) div 2;
   IconY:=(GetMaxY-IconWidth) div 2;
   SetColor(LightGray);
   SetFillStyle(1,LightGray);
   Circle(IconX+IconWidth0*1+IconWidth0 div 2,IconY+IconWidth0*1+IconWidth0 div 2,IconWidth0*1+IconWidth0 div 2);
   FloodFill(IconX+IconWidth0*1+IconWidth0 div 2,IconY+IconWidth0*1+IconWidth0 div 2,LightGray);
   Circle(IconX+IconWidth-IconWidth0-IconWidth0 div 2,IconY+IconWidth-IconWidth0-IconWidth0 div 2,IconWidth0*1+IconWidth0 div 2);
   FloodFill(IconX+IconWidth-IconWidth0-IconWidth0 div 2,IconY+IconWidth-IconWidth0-IconWidth0 div 2,LightGray);
   SetColor(White);
   SetFillStyle(1,White);
   Circle(IconX+IconWidth-IconWidth0-IconWidth0 div 2,IconY+IconWidth-IconWidth0-IconWidth0 div 2,IconWidth0 div 2);
   FloodFill(IconX+IconWidth-IconWidth0-IconWidth0 div 2,IconY+IconWidth-IconWidth0-IconWidth0 div 2,White);
   Circle(IconX+IconWidth0*1+IconWidth0 div 2,IconY+IconWidth0*1+IconWidth0 div 2,IconWidth0 div 2);
   FloodFill(IconX+IconWidth0*1+IconWidth0 div 2,IconY+IconWidth0*1+IconWidth0 div 2,White);
   for i:=IconY to IconY+IconWidth0 do
     for j:=IconX+IconWidth0*1+IconWidth0 div 2 to IconX+IconWidth do
       PutPixel(j,i,LightGray);
   for i:=IconY+IconWidth0*2 to IconY+IconWidth0*3 do
     for j:=IconX+IconWidth0*1+IconWidth0 div 2 to IconX+IconWidth-(IconWidth0*1+IconWidth0 div 2) do
       PutPixel(j,i,LightGray);
   for i:=IconY+IconWidth0*4 to IconY+IconWidth0*5 do
     for j:=IconX to IconX+IconWidth-(IconWidth0*1+IconWidth0 div 2) do
       PutPixel(j,i,LightGray);
   for i:=IconY+IconWidth0 to IconY+IconWidth0*2 do
     for j:=IconX+IconWidth0*1+IconWidth0 div 2 to IconX+IconWidth-IconWidth0 do
       PutPixel(j,i,White);
   for i:=IconY+IconWidth0*3 to IconY+IconWidth0*4 do
     for j:=IconX+IconWidth0 to IconX+IconWidth-(IconWidth0*1+IconWidth0 div 2) do
       PutPixel(j,i,White);
   for i:=IconX+IconWidth0 to IconX+IconWidth0*2 do
     for j:=IconY+IconWidth0*1+IconWidth0 div 2 to IconY+IconWidth-IconWidth0 do
       if GetPixel(i,j)=LightGray then Point[i,j]:=1;
   for i:=IconX+IconWidth0*3 to IconX+IconWidth0*4 do
     for j:=IconY+IconWidth0 to IconY+IconWidth-(IconWidth0*1+IconWidth0 div 2) do
       if GetPixel(i,j)=LightGray then Point[i,j]:=1;


2025-07-06 03:11:40
广告
{3}
   SetColor(DarkGray);
   SetFillStyle(1,DarkGray);
   Circle(IconX+IconWidth0*1+IconWidth0 div 2,IconY+IconWidth0*1+IconWidth0 div 2,IconWidth0*1+IconWidth0 div 2);
   FloodFill(IconX+IconWidth0*1+IconWidth0 div 2,IconY+IconWidth0*1+IconWidth0 div 2,DarkGray);
   Circle(IconX+IconWidth-IconWidth0-IconWidth0 div 2,IconY+IconWidth-IconWidth0-IconWidth0 div 2,IconWidth0*1+IconWidth0 div 2);
   FloodFill(IconX+IconWidth-IconWidth0-IconWidth0 div 2,IconY+IconWidth-IconWidth0-IconWidth0 div 2,DarkGray);
   SetColor(White);
   SetFillStyle(1,White);
   Circle(IconX+IconWidth-IconWidth0-IconWidth0 div 2,IconY+IconWidth-IconWidth0-IconWidth0 div 2,IconWidth0 div 2);
   FloodFill(IconX+IconWidth-IconWidth0-IconWidth0 div 2,IconY+IconWidth-IconWidth0-IconWidth0 div 2,White);
   Circle(IconX+IconWidth0*1+IconWidth0 div 2,IconY+IconWidth0*1+IconWidth0 div 2,IconWidth0 div 2);
   FloodFill(IconX+IconWidth0*1+IconWidth0 div 2,IconY+IconWidth0*1+IconWidth0 div 2,White);
   for i:=IconX to IconX+IconWidth0 do
     for j:=IconY+IconWidth0*1+IconWidth0 div 2 to IconY+IconWidth do
       PutPixel(i,j,DarkGray);
   for i:=IconX+IconWidth0*2 to IconX+IconWidth0*3 do
     for j:=IconY+IconWidth0*1+IconWidth0 div 2 to IconY+IconWidth-(IconWidth0*1+IconWidth0 div 2) do
       PutPixel(i,j,DarkGray);
   for i:=IconX+IconWidth0*4 to IconX+IconWidth0*5 do
     for j:=IconY to IconY+IconWidth-(IconWidth0*1+IconWidth0 div 2) do
       PutPixel(i,j,DarkGray);
   for i:=IconX+IconWidth0 to IconX+IconWidth0*2 do
     for j:=IconY+IconWidth0*1+IconWidth0 div 2 to IconY+IconWidth-IconWidth0 do
       if Point[i,j]=1 then PutPixel(i,j,LightGray) else PutPixel(i,j,White);
   for i:=IconX+IconWidth0*3 to IconX+IconWidth0*4 do
     for j:=IconY+IconWidth0 to IconY+IconWidth-(IconWidth0*1+IconWidth0 div 2) do
       if Point[i,j]=1 then PutPixel(i,j,LightGray) else PutPixel(i,j,White);
   for i:=IconX-IconWidth0+IconWidth to IconX+IconWidth do
     for j:=IconY to IconY+IconWidth0 do
       PutPixel(i,j,Yellow);
   for i:=IconX to IconX+IconWidth do
     for j:=IconY to IconY+IconWidth do
       if GetPixel(i,j)<>White then Point[i,j]:=GetPixel(i,j) else Point[i,j]:=0;
   for i:=IconX to IconX+IconWidth do
     for j:=IconY to IconY+IconWidth do
       if Point[i,j]<>0 then PutPixel(i+5,j+5,Black);
   for i:=IconX to IconX+IconWidth do



     for j:=IconY to IconY+IconWidth do
       if Point[i,j]<>0 then PutPixel(i,j,Point[i,j]);
   SetTextStyle(DefaultFont,HorizDir,2);
   for i:=1 to length(pri) do
   begin
     Delay(70);
     SetColor(LightGray);
     OutTextXY((GetMaxX-TextWidth(pri)) div 2+2,IconY+IconWidth+20+2,Copy(pri,1,i));
     SetColor(DarkGray);
     OutTextXY((GetMaxX-TextWidth(pri)) div 2+1,IconY+IconWidth+20+1,Copy(pri,1,i));
     SetColor(Black);
     OutTextXY((GetMaxX-TextWidth(pri)) div 2,IconY+IconWidth+20,Copy(pri,1,i));
   end;
   x0:=IconY+IconWidth+25+TextHeight(pri);
   SetTextStyle(DefaultFont,HorizDir,1);
   for i:=1 to length(website) do
   begin
     Delay(50);
     SetColor(LightGray);
     OutTextXY((GetMaxX-TextWidth(website)) div 2+2,x0,Copy(website,1,i));
     SetColor(DarkGray);
     OutTextXY((GetMaxX-TextWidth(website)) div 2+1,x0,Copy(website,1,i));
     SetColor(Black);
     OutTextXY((GetMaxX-TextWidth(website)) div 2,x0,Copy(website,1,i));
   end;
   Delay(1000);
   CloseGraph;
   InitGraph(grDriver, grMode,'C:\TP\BGI');     
   BeginX:=GetMaxX div 2-(ChessW*BlankW div 2);
   BeginY:=GetMaxY div 2-(ChessW*BlankW div 2);
   ex:=GetMaxX div 2+(ChessW*BlankW div 2);
   ey:=GetMaxY div 2+(ChessW*BlankW div 2);
   Bar(BeginX,BeginY,ex,ey);
   SetColor(White);
   for i:=1 to ChessW+1 do
   begin
     Line(BeginX+(i-1)*BlankW,BeginY,BeginX+(i-1)*BlankW,ey);
     Line(BeginX,BeginY+(i-1)*BlankW,ex,BeginY+(i-1)*BlankW);
   end;
   for i:=1 to ChessW do
   begin
     str(i,strtemp);
     if i<10 then strtemp:='0'+strtemp;
     outtextxy(BeginX+(i-1)*BlankW+5,beginY-15,strtemp);
   end;
   for k:=1 to ChessW do
     outtextxy(BeginX-15,BeginY+(k-1)*BlankW+5,chr(k+96));
   SetTextStyle(DefaultFont,HorizDir,3);
   OutTextXY(10,10,'Five In A Row');
   k:=TextHeight('Five In A Row');
   SetTextStyle(DefaultFont,HorizDir,1);
   OutTextXY(GetMaxX-TextWidth(version)-10,k+10-TextHeight(version),version);
   OutTextXY(75,GetMaxY-23,'Steps');
   SetTextStyle(DefaultFont,HorizDir,2);
   OutTextXY(20,GetMaxY-30,'0');
   Line(0,k+20,GetMaxX,k+20);
   SetTextStyle(DefaultFont,HorizDir,1);
   OutTextXY(10,k+30,'Please use the main window to control.');
   case chose of
   1:begin
       SetTextStyle(DefaultFont,HorizDir,2);
       OutTextXY(BeginX-330+32,BeginY,'PC   ');
       OutTextXY(BeginX-200,BeginY,'Player');
     end;
   2:begin
       SetTextStyle(DefaultFont,HorizDir,2);
       OutTextXY(BeginX-330,BeginY,'Player');
       OutTextXY(BeginX-200+32,BeginY,'PC   ');
     end;
   3:begin
       SetTextStyle(DefaultFont,HorizDir,2);
       OutTextXY(BeginX-330,BeginY,'Player');
       OutTextXY(BeginX-200,BeginY,'Player');
     end;
   4:begin
       SetTextStyle(DefaultFont,HorizDir,2);
       OutTextXY(BeginX-330+32,BeginY,'PC');
       OutTextXY(BeginX-200+32,BeginY,'PC');
     end;
   end;
end;


{4}
procedure ViewState0(state0:integer);
var
   r:word;
begin
   r:=(BlankW div 2);
   SetColor(black);
   Circle(BeginX-330+48,BeginY+50,r-3);
   SetFillStyle(1,black);
   FloodFill(BeginX-330+48,BeginY+50,black);
   Circle(BeginX-200+48,BeginY+50,r-3);
   SetFillStyle(1,black);
   FloodFill(BeginX-200+48,BeginY+50,black);
   if state0=1 then
   begin
     SetColor(_Color1);
     Circle(BeginX-330+48,BeginY+50,r-3);
     SetFillStyle(1,_Color1);
     FloodFill(BeginX-330+48,BeginY+50,_Color1);
   end
   else
   begin
     SetColor(_Color2);
     Circle(BeginX-200+48,BeginY+50,r-3);
     SetFillStyle(1,_Color2);
     FloodFill(BeginX-200+48,BeginY+50,_Color2);
   end;
end;


{5}
procedure ViewResult(state0:integer);
var
   r:word;
begin
   r:=(BlankW div 2);
   SetColor(black);
   Circle(BeginX-330+50,BeginY+50,r-3);
   SetFillStyle(1,black);
   FloodFill(BeginX-330+50,BeginY+50,black);
   Circle(BeginX-200+50,BeginY+50,r-3);
   SetFillStyle(1,black);
   FloodFill(BeginX-200+50,BeginY+50,black);
   SetColor(white);
   if state0=1 then
   begin
     SetTextStyle(DefaultFont,HorizDir,2);
     OutTextXY(BeginX-330+24,BeginY+50,'Win');
   end
   else
   begin
     SetTextStyle(DefaultFont,HorizDir,2);
     OutTextXY(BeginX-200+24,BeginY+50,'Win');
   end;
end;
procedure RecordChess(_x,_y,player:Word);
var
   strtemp:string;
begin
   SetColor(black);
   SetTextStyle(DefaultFont,HorizDir,1);
   for i:=GetMaxY-40 to GetMaxY do
     Line(10,i,74,i);
   Step:=Step+1;
   SetColor(white);
   str(Step,strTemp);
   //strTemp:=strTemp+' Steps';
   SetTextStyle(DefaultFont,HorizDir,2);
   OutTextXY(20,GetMaxY-30,strtemp);
   ChessRecord[Step,0]:=player;
   ChessRecord[Step,1]:=_x;
   ChessRecord[Step,2]:=_y;
   str(_x,strtemp);
   if _x<10 then strtemp:='0'+strtemp;
   strtemp:=chr(_y+96)+' '+strtemp;
   SetTextStyle(DefaultFont,HorizDir,1);
   if player=1 then
     OutTextXY(BeginX-325+(step div 76)*50,BeginY+80+10*((Step mod 76 -1) div 2),strtemp)
   else
     OutTextXY(BeginX-195+(step div 76)*50,BeginY+80+10*((Step mod 76 -1) div 2),strtemp);
end;


{6}
procedure PutRect(_x,_y:Word;Erase:Boolean);
var
   r:Word;
begin
   r:=BlankW -2;
   if Erase then SetColor(Black) else SetColor(White);
   Rectangle(BeginX+_x*BlankW-r,BeginY+_y*BlankW-r,BeginX+_x*BlankW-1,BeginY+_y*BlankW-1);
   Rectangle(BeginX+_x*BlankW-r-1,BeginY+_y*BlankW-r-1,BeginX+_x*BlankW-2,BeginY+_y*BlankW-2);
end;
procedure TPut(x,y,p:Byte);forward;
procedure PutChess(_x,_y:Word;player:Byte);
var
   r:Word;
   color:Byte;
begin
   recordchess(_x,_y,player);
   r:=(BlankW div 2);
   if (_x>ChessW)or(_y>ChessW)or(Order[_x,_y]<>0) then exit;
   if player=1 then color:=_Color1 else
   if player=2 then color:=_Color2 else exit;
   SetColor(color);
   Circle(BeginX+_x*BlankW-r,BeginY+_y*BlankW-r,r-3);
   SetFillStyle(1,color);
   FloodFill(BeginX+_x*BlankW-r,BeginY+_y*BlankW-r,color);
   PutRect(CurrentX,CurrentY,True);
   Order[_x,_y]:=player;
   CurrentX:=_x;CurrentY:=_y;   
   Value[1,_x,_y,0]:=V0;
   Value[2,_x,_y,0]:=V0;
   Value[1,_x,_y,1]:=V0;
   Value[2,_x,_y,1]:=V0;
   Value[1,_x,_y,2]:=V0;
   Value[2,_x,_y,2]:=V0;
   Value[1,_x,_y,3]:=V0;
   Value[2,_x,_y,3]:=V0;
   Value[1,_x,_y,4]:=V0;
   Value[2,_x,_y,4]:=V0;
   PutRect(CurrentX,CurrentY,False);
end;


{7}
procedure ManTake(player:Byte);
var
   ch:Char;
   Take:Boolean;
begin
   Take:=False;
   repeat
     ch:=#0;
     if KeyPressed then
     begin
       ch:=ReadKey;
       GotoXY(12,25);
       write('         ');
       GotoXY(12,25);
       write('#',ord(ch));
     end;
     case ch of
       #71:{UpLeft}
           begin
             PutRect(CurrentX,CurrentY,True);
             if CurrentX>1 then CurrentX:=CurrentX-1;
             if CurrentY>1 then CurrentY:=CurrentY-1;
             PutRect(CurrentX,CurrentY,False);
           end;
       #72:{Up}
           begin
             PutRect(CurrentX,CurrentY,True);
             if CurrentY>1 then CurrentY:=CurrentY-1;
             PutRect(CurrentX,CurrentY,False);
           end;
       #73:{UpRight}
           begin
             PutRect(CurrentX,CurrentY,True);
             if CurrentX<ChessW then CurrentX:=CurrentX+1;
             if CurrentY>1 then CurrentY:=CurrentY-1;
             PutRect(CurrentX,CurrentY,False);
           end;
       #75:{Left}
           begin
             PutRect(CurrentX,CurrentY,True);
             if CurrentX>1 then CurrentX:=CurrentX-1;
             PutRect(CurrentX,CurrentY,False);
           end;
       #77:{Right}



2025-07-06 03:05:40
广告
           begin
             PutRect(CurrentX,CurrentY,True);
             if CurrentX<ChessW then CurrentX:=CurrentX+1;
             PutRect(CurrentX,CurrentY,False);
             end;
       #79:{DownLeft}
           begin
             PutRect(CurrentX,CurrentY,True);
             if CurrentX>1 then CurrentX:=CurrentX-1;
             if CurrentY<ChessW then CurrentY:=CurrentY+1;
             PutRect(CurrentX,CurrentY,False);
           end;
       #80:{Down}
           begin
             PutRect(CurrentX,CurrentY,True);
             if CurrentY<ChessW then CurrentY:=CurrentY+1;
             PutRect(CurrentX,CurrentY,False);
           end;
       #81:{DownRight}
           begin
             PutRect(CurrentX,CurrentY,True);
             if CurrentX<ChessW then CurrentX:=CurrentX+1;
             if CurrentY<ChessW then CurrentY:=CurrentY+1;
             PutRect(CurrentX,CurrentY,False);
           end;
       #13:{For sure}
           begin
             if Order[CurrentX,CurrentY]=0 then
             begin
               TPut(CurrentX,CurrentY,player);
               PutRect(CurrentX,CurrentY,False);
               Take:=True;
             end;
           end;
       else;
       end;
   until Take;
end;


{8}
function CheckWin(player:Byte):Boolean;
   function CheckLine(bx,by:Word;dx,dy:Integer):Byte;
     var
       sum,maxsum:Byte;
     begin
       maxsum:=0;sum:=0;
       repeat
       if Order[bx,by]=player then
       begin
         sum:=sum+1;
         if sum>maxsum then maxsum:=sum;
       end
       else
         sum:=0;
       bx:=bx+dx;by:=by+dy;
       until (bx<1)or(bx>ChessW)or(by<1)or(by>ChessW);
       CheckLine:=maxsum;
     end;
var
   i:Byte;
begin
   CheckWin:=False;
   for i:=1 to ChessW do
     if CheckLine(1,i,1,0)>4 then
     begin                      
       CheckWin:=True;Exit;
     end;
   for i:=1 to ChessW do
     if CheckLine(i,1,0,1)>4 then
   begin                    
     CheckWin:=True;Exit;
   end;
   for i:=1 to ChessW-4 do
     if CheckLine(1,i,1,1)>4 then
     begin                     
       CheckWin:=True;Exit;
     end;
   for i:=1 to ChessW-4 do
     if CheckLine(i,1,1,1)>4 then
     begin                    
       CheckWin:=True;Exit;
     end;
   for i:=5 to ChessW do
     if CheckLine(i,1,-1,1)>4 then
     begin                      
       CheckWin:=True;Exit;
     end;
   for i:=1 to ChessW-4 do
     if CheckLine(ChessW,i,-1,1)>4 then
     begin                           
       CheckWin:=True;Exit;
     end;
end;


{9}
procedure VD(x0,y0,d,p:Byte);
var
   dx,dy:Integer;
   x,y,x1,y1,x2,y2,i,j,s0,s1,s2,ls,rs,s,_p,r0,l0,rd,ld,d0:Byte;
   lb,rb,rb0,lb0:Boolean;ll,rr:Byte;
   t,t0:Word;
   out,bb:Boolean;
   d1,d2:ValueDot;
begin
   if Order[x0,y0]<>0 then Exit;
   dx:=Delta[d,0];dy:=Delta[d,1];
   if p=1 then _p:=2 else _p:=1;
   t0:=0;s0:=0;
   x:=x0;y:=y0;s1:=0;out:=false;
   repeat
     x:=x+dx;y:=y+dy;
     Inc(s1);                    
     if (s1>4)or(Order[x,y]=$ff)or(Order[x,y]=_p) then out:=True;
   until out;
   if (Order[x,y]=$ff)or(Order[x,y]=_p) then Dec(s1);
   x:=x0;y:=y0;s2:=0;out:=false;
   repeat
     x:=x-dx;y:=y-dy;
     Inc(s2);                        
     if (s2>4)or(Order[x,y]=$ff)or(Order[x,y]=_p) then out:=True;
   until out;
   if (Order[x,y]=$ff)or(Order[x,y]=_p) then Dec(s2);
   if s1+s2<4 then
     Value[p,x0,y0,d]:=V0
   else
   begin
     for i:=0 to s1 do
       if (4-i>=0)and(4-i<=s2) then
       begin
         ld:=1;rd:=1;rs:=0;ls:=0;
         x:=x0;y:=y0;ll:=0;bb:=True;lb:=False;
         for j:=1 to i do
         begin
           x:=x+dx;y:=y+dy;     
           if Order[x,y]=p then Inc(ls);
           if (ls=0)and(Order[x,y]=0) then Inc(ld);
           if (bb)and(ls>0)and(Order[x,y]=0) then begin lb:=True;ll:=ls;bb:=False;end;
         end;
         if ls=ll then lb:=False;
         if ls=0 then ld:=5;
         x1:=x+dx;y1:=y+dy;
         x:=x0;y:=y0;rr:=0;bb:=True;rb:=False;
         for j:=1 to 4-i do
           begin
             x:=x-dx;y:=y-dy;
             if Order[x,y]=p then Inc(rs);



             if (rs=0)and(Order[x,y]=0) then Inc(rd);
             if (bb)and(rs>0)and(Order[x,y]=0) then begin rb:=True;rr:=rs;bb:=False;end;
           end;
         if rs=0 then rd:=5;
         if rs=rr then rb:=False;
         x2:=x-dx;y2:=y-dy;
         s:=ls+rs;
         t:=VV[s];
         if (Order[x1,y1]=$ff)or(Order[x1,y1]=_p) then t:=t div 2;
         if (Order[x2,y2]=$ff)or(Order[x2,y2]=_p) then t:=t div 2;
         if t0<t then
         begin
           t0:=t;s0:=s;r0:=rd;l0:=ld;rb0:=rb;lb0:=lb;
         end;
       end;
       Value[p,x0,y0,d].V:=t0;
       Value[p,x0,y0,d].VN:=s0;
       Value[p,x0,y0,d].LD:=l0;
       Value[p,x0,y0,d].RD:=r0;
       Value[p,x0,y0,d].LB:=lb0;
       Value[p,x0,y0,d].RB:=rb0;
       Value[p,x0,y0,d].D:=l0*r0;
   end;
   Value[p,x0,y0,0].V:=Value[p,x0,y0,1].V+Value[p,x0,y0,2].V+Value[p,x0,y0,3].V+Value[p,x0,y0,4].V;
   if Value[p,x0,y0,1].V>Value[p,x0,y0,2].V then d1:=Value[p,x0,y0,1] else d1:=Value[p,x0,y0,2];
   if Value[p,x0,y0,3].V>Value[p,x0,y0,4].V then d2:=Value[p,x0,y0,3] else d2:=Value[p,x0,y0,4];
   if d1.V>d2.V then d2:=d1;
   Value[p,x0,y0,0].VN:=d2.VN;
   Value[p,x0,y0,0].D:=d2.D;
   Value[p,x0,y0,0].RD:=d2.RD;
   Value[p,x0,y0,0].LD:=d2.LD;
   Value[p,x0,y0,0].RB:=d2.RB;
   Value[p,x0,y0,0].LB:=d2.LB;
end;


{10}
procedure VAdd(x0,y0,dir,p:Byte);
var
   dx,dy:Integer;
   x,y,i,_p:Byte;
   out:Boolean;
begin
   dx:=Delta[dir,0];dy:=Delta[dir,1];
   if p=1 then _p:=2 else _p:=1;
   x:=x0;y:=y0;i:=0;out:=false;
   repeat
     x:=x+dx;y:=y+dy;
     Inc(i);
     if (i>4)or(Order[x,y]=$ff)or(Order[x,y]=_p) then out:=True;
     if Order[x,y]=0 then VD(x,y,dir,p);
   until out;
   x:=x0;y:=y0;i:=0;out:=false;
   repeat
     x:=x-dx;y:=y-dy;
     Inc(i);
     if (i>4)or(Order[x,y]=$ff)or(Order[x,y]=_p) then out:=True;
     if Order[x,y]=0 then VD(x,y,dir,p);
   until out;
end;


{11}
procedure TPut(x,y,p:Byte);
var
   x0,y0:Byte;
   d1,d2:ValueDot;
begin
   if Order[x,y]=0 then
   begin
     PutChess(x,y,p);
     VAdd(x,y,1,2);
     VAdd(x,y,2,2);
     VAdd(x,y,3,2);
     VAdd(x,y,4,2);
     VAdd(x,y,1,1);
     VAdd(x,y,2,1);
     VAdd(x,y,3,1);
     VAdd(x,y,4,1);
   end;
end;
procedure Ps(x,y:Byte;s:string);{调试}
var
   i:Byte;
begin
   for i:=2 to Length(s) do
     case s[1] of
     '-':begin
           x:=x+1;TPut(x,y,Ord(s[i])-48);
         end;
     '|':begin
           y:=y+1;TPut(x,y,Ord(s[i])-48);
         end;
     '\':begin
           x:=x+1;y:=y+1;TPut(x,y,Ord(s[i])-48);
         end;
     '/':begin
           x:=x-1;y:=y+1;TPut(x,y,Ord(s[i])-48);
         end;
     end;
end;


2025-07-06 02:59:40
广告
{12}
function CheckC(p,n:Byte):Word;
var
   i,j:Byte;
   t:Word;
begin
   t:=0;
   for i:=1 to ChessW do
     for j:=1 to ChessW do
       if Value[p,i,j,0].V>=VV[n] then
       begin
         Inc(t);
         ValueC[p,t,n].X:=i;
         ValueC[p,t,n].Y:=j;
         ValueC[p,t,n].V:=Value[p,i,j,0].V;
         ValueC[p,t,n].VN:=Value[p,i,j,0].VN;
         ValueC[p,t,n].D:=Value[p,i,j,0].D;
         ValueC[p,t,n].RD:=Value[p,i,j,0].RD;
         ValueC[p,t,n].LD:=Value[p,i,j,0].LD;
         ValueC[p,t,n].RB:=Value[p,i,j,0].RB;
         ValueC[p,t,n].LB:=Value[p,i,j,0].LB;
       end;
   ValueC[p,0,n].V:=t;CheckC:=t;
end;


扫二维码下载贴吧客户端

下载贴吧APP
看高清直播、视频！
分享到: