Hướng dẫn mini game in pascal - trò chơi nhỏ trong pascal

uses crt,dos; {//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
xh2,yh2,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=y1]
      and [getmousey div 8x2 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 x1x2 then
 for c:= x2 to x1 do
 begin
 if y1y2 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 [[x1x2]or[y1y2]] 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[x1x2]and[y1y2];
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]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;

Bài Viết Liên Quan

Chủ Đề