uses crt,dos; {http://vn.myblog.yahoo.com/kien_coi_1997}
type
quan=(k,xeD,maD,tuongD,hauD,vuaD,totD,
xeT,maT,tuongT,hauT,vuaT,totT);
nguoi=(Trang,Den);
mType=array[1..8,1..8]of quan;
his=record
xh1,yh1,xh2,yh2:0..8;
Old:quan;dirh:0..3;
end;
const xStart=2; yStart=1; Player:nguoi=trang;
{den:darkgray;trang:white}
New:mType= ((xeT,MaT,TuongT,HauT,VuaT,TuongT,MaT,XeT)
,(totT,totT,totT,totT,totT,totT,totT,totT)
,(k,k,k,k,k,k,k,k),(k,k,k,k,k,k,k,k)
,(k,k,k,k,k,k,k,k),(k,k,k,k,k,k,k,k)
,(totD,totD,totD,totD,totD,totD,totD,totD)
,(xeD,MaD,TuongD,HauD,VuaD,TuongD,MaD,XeD));
function mouseinstalled:boolean; assembler; asm
xor ax,ax; int 33h; cmp ax,-1; je @skip; xor al,al; @skip: end;
function getmousex:word; assembler; asm
mov ax,3; int 33h; mov ax,cx end;
function getmousey:word; assembler; asm
mov ax,3; int 33h; mov ax,dx end;
function leftpressed:boolean; assembler; asm
mov ax,3; int 33h; and bx,1; mov ax,bx end;
function rightpressed:boolean; assembler; asm
mov ax,3; int 33h; and bx,2; mov ax,bx end;
procedure mousesensetivity(x,y:word); assembler; asm
mov ax,1ah; mov bx,x; mov cx,y; xor dx,dx; int 33h end;
function mouserange(x1,y1,x2,y2:word):boolean;
begin
if (getmousex div 8>=x1)
and (getmousex div 8<=x2)
and (getmousey div 8>=y1)
and (getmousey div 8<=y2)
then mouserange:=true
else mouserange:=false;
end;
function getmousexcrt:word;
begin
getmousexcrt:=trunc(getmousex/8+1);
end;
function getmouseycrt:word;
begin
getmouseycrt:=trunc(getmousey/8+1);
end;
procedure vekhung(x1,y1,x2,y2:word);
var z,a,b:word;
begin
if (x1<>x2) and (y1<>y2) then
begin
a:=wherex; b:=wherey;
if x1>x2 then
begin z:=x1; x1:=x2; x2:=z; end;
if y1>y2 then
begin z:=y1; y1:=y2; y2:=z; end;
gotoxy(x1,y1); write(#201);
if x2-x1>1 then for z:=1 to x2-x1-1 do write(#205);
gotoxy(x2,y1); write(#187);
gotoxy(x1,y2); write(#200);
if x2-x1>1 then for z:=1 to x2-x1-1 do write(#205);
gotoxy(x2,y2); write(#188);
if y2-y1>1 then for z:=1 to y2-y1-1 do begin
gotoxy(x1,z+y1); write(#186); end;
if y2-y1>1 then for z:=1 to y2-y1-1 do begin
gotoxy(x2,z+y1); write(#186); end;
end;
gotoxy(a,b);
end;
procedure RangeMouse(x1,y1,x2,y2:word);
var regs:registers;
begin
Regs.AX:=7; Regs.CX:=x1; Regs.DX:=x2;
Intr($33,Regs);
Regs.AX:=8; Regs.CX:=y1; Regs.DX:=y2;
Intr($33,Regs);
end;
var x1,y1,x2,y2:byte;
xMove1,yMove1,xMove2,yMove2:byte;
Moving:boolean;c:char;
History:array[1..4]of his;
dir:0..3;m:mtype;
function Lawful(x1,y1,x2,y2:byte):boolean;
var z:quan;
function NotBlock(x1,y1,x2,y2:byte):boolean;
var c,d:byte;
begin
NotBlock:=true;c:=0;d:=0;
if m[x2,y2]=k then
d:=1;
if (x1>x2)and(y1=y2) then
begin c:=x1; x1:=x2; x2:=c; end;
if (y1>y2)and(x1=x2) then
begin c:=y1; y1:=y2; y2:=c; end;
if x1=x2 then
begin
for c:= y1 to y2 do
if m[x1,c]<>k then
d:=d+1;
end;
if y1=y2 then
begin
for c:= x1 to x2 do
if m[c,y1]<>k then d:=d+1;
end;
if abs(x2-x1)=abs(y2-y1) then
begin
if x1<x2 then
for c:= x1 to x2 do
begin
if y1<y2 then
if m[c,c+y1-x1]<>k then
d:=d+1;
if y1>y2 then
if m[c,x2+y2-c]<>k then
d:=d+1;
end;
if x1>x2 then
for c:= x2 to x1 do
begin
if y1<y2
if m[c,x2+y2-c]<>k then
d:=d+1;
if y1>y2 then
if m[c,c+y2-x2]<>k then
d:=d+1;
end;
end;
if d>2then
notblock:=false;
end;
begin
z:=m[x1,y1]; textbackground(black);
gotoxy(68,7); write(' ');
gotoxy(75,5); write(' ');
if ((m[x1,y1]in[xeD..totD])and(m[x2,y2]in[xeT..totT])
or (m[x1,y1]in[xeT..totT])and(m[x2,y2]in[xeD..totD])
or (m[x2,y2]=k)) and ((x1<>x2)or(y1<>y2)) then
case z of
xeT,xeD: Lawful:=((x1=x2)xor(y1=y2))and NotBlock(x1,y1,x2,y2);
maT,maD: lawful:=(abs(x1-x2)+abs(y1-y2)=3)and(x1<>x2)and(y1<>y2);
tuongT,tuongD: Lawful:=(abs(x2-x1)=abs(y2-y1))and NotBlock(x1,y1,x2,y2);
hauT,hauD: Lawful:=(((x1=x2)or(y1=y2))or(abs(x2-x1)=abs(y2-y1)))
and NotBlock(x1,y1,x2,y2);
vuaT,vuaD: Lawful:=(abs(x2-x1)<2)and(abs(y2-y1)<2)
and((x1<>x2)or(y1<>y2));
totT: Lawful:=(((dir=0)and(x2-x1=1)and(y1=y2)
or (x2-x1=1)and(abs(y1-y2)=1)and(m[x2,y2]<>k)
or (x2-x1=2)and(x1=2)and(y1=y2))
or ((dir=1)and(y2-y1=1)and(x1=x2)
or (y2-y1=1)and(abs(x1-x2)=1)and(m[x2,y2]<>k)
or (y2-y1=2)and(y1=2)and(x1=x2))
or ((dir=2)and(x1-x2=1)and(y1=y2)
or (x1-x2=1)and(abs(x1-x2)=1)and(m[x2,y2]<>k)
or (x1-x2=2)and(x1=7)and( y1=y2))
or ((dir=3)and(y1-y2=1)and(x1=x2)
or (y1-y2=1)and(abs(x1-x2)=1)and(m[x2,y2]<>k)
or (y1-y2=2)and(y1=7)and(x1=x2)))
and notblock(x1,y1,x2,y2);
totD: Lawful:=(((dir=2)and(x2-x1=1)and(y1=y2)
or (x2-x1=1)and(abs(y1-y2)=1)and(m[x2,y2]<>k)
or (x2-x1=2)and(x1=2)and(y1=y2))
or ((dir=3)and(y2-y1=1)and(x1=x2)
or (y2-y1=1)and(abs(x1-x2)=1)and(m[x2,y2]<>k)
or (y2-y1=2)and(y1=2)and(x1=x2))
or ((dir=0)and(x1-x2=1)and(y1=y2)
or (x1-x2=1)and(abs(x1-x2)=1)and(m[x2,y2]<>k)
or (x1-x2=2)and(x1=7)and(y1=y2))
or ((dir=1)and(y1-y2=1)and(x1=x2)
or (y1-y2=1)and(abs(x1-x2)=1)and(m[x2,y2]<>k)
or (y1-y2=2)and(y1=7)and(x1=x2)))
and notblock(x1,y1,x2,y2);
end else begin Lawful:=false;
gotoxy(68,7);textcolor(lightred);textbackground(Red);
write('!QuanCungMau'); end;
if not notblock(x1,y1,x2,y2) then
begin gotoxy(75,5);textcolor(lightred);
textbackground(Red);write('! Can'); end;
end;
procedure clearCell(x,y,z:byte);
begin
if z =0 then
if odd(x+y) then textcolor(black)
else textcolor(lightgray)
else textcolor(z);
gotoxy(x*8-8+xStart,y*3-3+yStart);
write(#219,#219,#219,#219,#219,#219,#219,#219);
gotoxy(x*8-8+xStart,y*3-3+yStart+1);
write(#219,#219,#219,#219,#219,#219,#219,#219);
gotoxy(x*8-8+xStart,y*3-3+yStart+2);
write(#219,#219,#219,#219,#219,#219,#219,#219);
textcolor(white);
end;
procedure qXe(x,y,z,b:byte);
begin
textcolor(z);
if b>0 then textbackground(b)
else if odd(x+y+1) then textbackground(white)
else textbackground(black);
gotoxy(x*8-8+xStart,y*3-3+yStart);
write(#32,#219,#32,#219,#32,#219,#32,#32);
gotoxy(x*8-8+xStart,y*3-3+yStart+1);
write(#32,#32,#178,#178,#178,#32,#32,#32);
gotoxy(x*8-8+xStart,y*3-3+yStart+2);
write(#32,#219,#219,#219,#219,#219,#32,#32);
end;
procedure qMa(x,y,z,b:byte);
begin
textcolor(z);
if b>0 then textbackground(b)
else if odd(x+y+1) then textbackground(white)
else textbackground(black);
gotoxy(x*8-8+xStart,y*3-3+yStart);
write(#32,#222,#223,#219,#220,#32,#32,#32);
gotoxy(x*8-8+xStart,y*3-3+yStart+1);
write(#32,#32,#222,#219,#219,#221,#32,#32);
gotoxy(x*8-8+xStart,y*3-3+yStart+2);
write(#32,#32,#219,#219,#219,#219,#32,#32);
end;
procedure qTot(x,y,z,b:byte);
begin
textcolor(z);
if b>0 then textbackground(b)
else if odd(x+y+1) then textbackground(white)
else textbackground(black);
gotoxy(x*8-8+xStart,y*3-3+yStart);
write(#32,#32,#32,#32,#254,#32,#32,#32);
gotoxy(x*8-8+xStart,y*3-3+yStart+1);
write(#32,#32,#32,#40,#42,#41,#32,#32);
gotoxy(x*8-8+xStart,y*3-3+yStart+2);
write(#32,#32,#220,#219,#219,#219,#220,#32);
end;
procedure qTuong(x,y,z,b:byte);
begin
textcolor(z);
if b>0 then textbackground(b)
else if odd(x+y+1) then textbackground(white)
else textbackground(black);
gotoxy(x*8-8+xStart,y*3-3+yStart);
write(#32,#32,#32,#234,#32,#32,#32,#32);
gotoxy(x*8-8+xStart,y*3-3+yStart+1);
write(#32,#32,#222,#254,#221,#32,#32,#32);
gotoxy(x*8-8+xStart,y*3-3+yStart+2);
write(#32,#220,#219,#219,#219,#220,#32,#32);
end;
procedure qVua(x,y,z,b:byte);
begin
textcolor(z);
if b>0 then textbackground(b)
else if odd(x+y+1) then textbackground(white)
else textbackground(black);
gotoxy(x*8-8+xStart,y*3-3+yStart);
write(#32,#47,#92,#32,#42,#32,#47,#92);
gotoxy(x*8-8+xStart,y*3-3+yStart+1);
write(#32,#92,#32,#221,#254,#222,#32,#47);
gotoxy(x*8-8+xStart,y*3-3+yStart+2);
write(#32,#32,#219,#219,#42,#219,#219,#32);
end;
procedure qHau(x,y,z,b:byte);
begin
textcolor(z);
if b>0 then textbackground(b)
else if odd(x+y+1) then textbackground(white)
else textbackground(black);
gotoxy(x*8-8+xStart,y*3-3+yStart);
write(#95,#46,#61,#42,#42,#61,#46,#95);
gotoxy(x*8-8+xStart,y*3-3+yStart+1);
write(#92,#92,#30,#30,#30,#30,#47,#47);
gotoxy(x*8-8+xStart,y*3-3+yStart+2);
write(#32,#176,#177,#178,#178,#177,#176,#32);
end;
[TẶNG BẠN] TRỌN BỘ Bí kíp học tốt 08 môn
