Question

pascal 游戏

用 PASCAL 编的游戏怎么带上图(画面)

Answer 1

uses graph,crt;
type Tqp=array[1..8,1..8]of integer;
Twjyw=array[1..6]of boolean;
const spx:array[1..9] of integer=(140,180,220,260,300,340,380,420,460);
spy:array[1..9] of integer=(80,120,160,200,240,280,320,360,400);
yqp:Tqp=
((11,10, 9, 8, 7, 9,10,11),
(12,12,12,12,12,12,12,12),
( 0, 0, 0, 0, 0, 0, 0, 0),
( 0, 0, 0, 0, 0, 0, 0, 0),
( 0, 0, 0, 0, 0, 0, 0, 0),
( 0, 0, 0, 0, 0, 0, 0, 0),
( 6, 6, 6, 6, 6, 6, 6, 6),
( 5, 4, 3, 2, 1, 3, 4, 5));
ck:string[5]='KPMH!';
fx:array[1..4,1..2]of shortint=((-1,0),(0,1),(1,0),(0,-1));
var image:array[0..26]of pointer;
cm:array[1..8,1..8]of boolean;
qp:Tqp;
kx,ky,k2x,k2y:integer;
k2f:boolean;
wjyw:Twjyw;
procedure initg;
var gd,gm:integer;
begin
gd:=detect;
initgraph(gd,gm,'bgi\');
end;
function inttostr(i:longint):string;
var st:string;
begin
str(i,st);
inttostr:=st;
end;
function min(a,b:longint):longint;
begin
if a<b then min:=a else min:=b;
end;
function max(a,b:longint):longint;
begin
if a>b then max:=a else max:=b;
end;
procedure loadimg(st:string;var img1:pointer);
var i,j:integer;
c:byte;
size:word;
f:file of byte;
begin
new(img1);
assign(f,'img\'+st);
reset(f);
for i:=1 to 40 do
for j:=1 to 40 do
begin
read(f,c);
putpixel(j,i,c);
end;
size:=ImageSize(1,1,40,40);
getMem(img1,Size);
getimage(1,1,40,40,img1^);
close(f);
cleardevice;
end;
procedure loadallimg;
var
i:integer;
begin
for i:=1 to 26 do
loadimg('img'+inttostr(i),image[i]);
end;
procedure init;
begin
kx:=1;ky:=1;
cleardevice;
loadallimg;
qp:=yqp;
fillchar(wjyw,sizeof(wjyw),0);
end;
procedure drawbar(x,y,c:integer);
begin
setcolor(c);
line(spx[x],spy[y],spx[x+1]-1,spy[y]);
line(spx[x],spy[y],spx[x],spy[y+1]-1);
line(spx[x+1]-1,spy[y],spx[x+1]-1,spy[y+1]-1);
line(spx[x],spy[y+1]-1,spx[x+1]-1,spy[y+1]-1);
end;
procedure print;
var i,j:integer;
begin
for i:=1 to 8 do
for j:=1 to 8 do
putimage(spx[j],spy[i],image[qp[i,j]*2+2-(i+j) mod 2]^,0);
{if k2f then
for i:=1 to 8 do
for j:=1 to 8 do
if cm[j,i] then
drawbar(i,j,blue); }
drawbar(kx,ky,4);
if k2f then
drawbar(k2x,k2y,green);
end;
function canmover(qp:Tqp;wjyw:Twjyw;x1,y1,x2,y2:integer):boolean;
var i,j,hx,hy,h2x,h2y:integer;
begin
canmover:=false;
if (x1=x2)and(y1=y2) then exit;
if not(qp[x1,y1] in [1..6]) then exit;
if qp[x2,y2] in [1..6] then exit;
case qp[x1,y1] of
1:
begin
if (y1=5)and(y2=3)and(x1=8)and(x2=8)and(not wjyw[1])and(not wjyw[3])
and(qp[8,2]=0)and(qp[8,3]=0)and(qp[8,4]=0)then
else if (y1=5)and(y2=7)and(x1=8)and(x2=8)and(not wjyw[2])and(not wjyw[3])
and(qp[8,5]=0)and(qp[8,6]=0)and(qp[8,7]=0)then
else if (abs(x2-x1)>1)or(abs(y2-y1)>1) then exit;
end;
2:
begin
if (abs(x2-x1)=abs(y2-y1))or(x2=x1)or(y2=y1) then else exit;
if x2>x1 then h2x:=1
else if x2<x1 then h2x:=-1
else h2x:=0;
if y2>y1 then h2y:=1
else if y2<y1 then h2y:=-1
else h2y:=0;
hx:=x1+h2x;
hy:=y1+h2y;
while not((hx=x2)and(hy=y2)) do
begin
if qp[hx,hy]<>0 then exit;
inc(hx,h2x);
inc(hy,h2y);
if (hx=x2)and(hy=y2) then break;
end;
end;
3:
begin
if (abs(x2-x1)=abs(y2-y1)) then else exit;
if x2>x1 then h2x:=1
else if x2<x1 then h2x:=-1
else h2x:=0;
if y2>y1 then h2y:=1
else if y2<y1 then h2y:=-1
else h2y:=0;
hx:=x1+h2x;
hy:=y1+h2y;
while not((hx=x2)and(hy=y2)) do
begin
if qp[hx,hy]<>0 then exit;
inc(hx,h2x);
inc(hy,h2y);
if (hx=x2)and(hy=y2) then break;
end;
end;
4:
begin
if ((abs(x1-x2)=2)and(abs(y1-y2)=1))or((abs(x1-x2)=1)and(abs(y1-y2)=2))
then else exit;
end;
5:
begin
if (x2=x1)or(y2=y1) then else exit;
if x2>x1 then h2x:=1
else if x2<x1 then h2x:=-1
else h2x:=0;
if y2>y1 then h2y:=1
else if y2<y1 then h2y:=-1
else h2y:=0;
hx:=x1+h2x;
hy:=y1+h2y;
while not((hx=x2)and(hy=y2)) do
begin
if qp[hx,hy]<>0 then exit;
inc(hx,h2x);
inc(hy,h2y);
if (hx=x2)and(hy=y2) then break;
end;
end;
6:
begin
if (x1-x2=1)or((x1=7)and(x2=5)and(qp[6,y2]=0)) then else exit;
if (x1-x2=2)and(y1<>y2) then exit;
if abs(y1-y2)>1 then exit;
if (y1=y2)and(qp[x2,y2]<>0) then exit;
if (abs(y1-y2)=1)and not (qp[x2,y2]in [7..12]) then exit;
end;
end;
canmover:=true;
end;
function canmoveb(qp:Tqp;wjyw:Twjyw;x1,y1,x2,y2:integer):boolean;
var i,j,hx,hy,h2x,h2y:integer;
begin
canmoveb:=false;
if (x1=x2)and(y1=y2) then exit;
if not(qp[x1,y1] in [7..12]) then exit;
if qp[x2,y2] in [7..12] then exit;
case qp[x1,y1] of
7:
begin
if (y1=5)and(y2=3)and(x1=1)and(x2=1)and(not wjyw[4])and(not wjyw[6])
and(qp[1,2]=0)and(qp[1,3]=0)and(qp[1,4]=0)then
else if (y1=5)and(y2=7)and(x1=1)and(x2=1)and(not wjyw[5])and(not wjyw[6])
and(qp[8,5]=0)and(qp[8,6]=0)and(qp[8,7]=0)then
else if (abs(x2-x1)>1)or(abs(y2-y1)>1) then exit;
end;
8:
begin
if (abs(x2-x1)=abs(y2-y1))or(x2=x1)or(y2=y1) then else exit;
if x2>x1 then h2x:=1
else if x2<x1 then h2x:=-1
else h2x:=0;
if y2>y1 then h2y:=1
else if y2<y1 then h2y:=-1
else h2y:=0;
hx:=x1+h2x;
hy:=y1+h2y;
while not((hx=x2)and(hy=y2)) do
begin
if qp[hx,hy]<>0 then exit;
inc(hx,h2x);
inc(hy,h2y);
if (hx=x2)and(hy=y2) then break;
end;
end;
9:
begin
if (abs(x2-x1)=abs(y2-y1)) then else exit;
if x2>x1 then h2x:=1
else if x2<x1 then h2x:=-1
else h2x:=0;
if y2>y1 then h2y:=1
else if y2<y1 then h2y:=-1
else h2y:=0;
hx:=x1+h2x;
hy:=y1+h2y;
while not((hx=x2)and(hy=y2)) do
begin
if qp[hx,hy]<>0 then exit;
inc(hx,h2x);
inc(hy,h2y);
if (hx=x2)and(hy=y2) then break;
end;
end;
10:
begin
if ((abs(x1-x2)=2)and(abs(y1-y2)=1))or((abs(x1-x2)=1)and(abs(y1-y2)=2))
then else exit;
end;
11:
begin
if (x2=x1)or(y2=y1) then else exit;
if x2>x1 then h2x:=1
else if x2<x1 then h2x:=-1
else h2x:=0;
if y2>y1 then h2y:=1
else if y2<y1 then h2y:=-1
else h2y:=0;
hx:=x1+h2x;
hy:=y1+h2y;
while not((hx=x2)and(hy=y2)) do
begin
if qp[hx,hy]<>0 then exit;
inc(hx,h2x);
inc(hy,h2y);
if (hx=x2)and(hy=y2) then break;
end;
end;
12:
begin
if (x1-x2=-1)or((x1=2)and(x2=4)and(qp[3,y2]=0)) then else exit;
if (x1-x2=-2)and(y1<>y2) then exit;
if abs(y1-y2)>1 then exit;
if (y1=y2)and(qp[x2,y2]<>0) then exit;
if (abs(y1-y2)=1)and not (qp[x2,y2]in [1..6]) then exit;
end;
end;
canmoveb:=true;
end;
function eatone(qp:Tqp;x,y,f:integer):boolean;
var i,j:integer;
begin
if f=1 then
begin
eatone:=false;
for i:=1 to 8 do
for j:=1 to 8 do
if canmover(qp,wjyw,i,j,x,y) then begin eatone:=true;exit;end;
end
else
begin
eatone:=false;
for i:=1 to 8 do
for j:=1 to 8 do
if canmoveb(qp,wjyw,i,j,x,y) then begin eatone:=true;exit;end;
end;
end;
function runqz(var qp:Tqp;var wjyw:Twjyw;k2x,k2y,kx,ky:integer):boolean;
var f:boolean;
begin
if not cm[ky,kx] then begin k2f:=false;runqz:=false;exit;end;
runqz:=true;
if qp[8,1]<>5 then wjyw[1]:=true;
if qp[8,8]<>5 then wjyw[2]:=true;
if qp[8,5]<>1 then wjyw[3]:=true;
if qp[1,1]<>11 then wjyw[4]:=true;
if qp[1,8]<>11 then wjyw[5]:=true;
if qp[1,5]<>7 then wjyw[6]:=true;
if qp[k2y,k2x]=1 then
begin
f:=true;
end;
if (k2x=5)and(kx=3)and(k2y=8)and(ky=8)and(qp[8,5]=1) then
begin
wjyw[1]:=true;
wjyw[2]:=true;
wjyw[3]:=true;
qp[8,4]:=5;
qp[8,1]:=0;
end;
if (k2x=5)and(kx=3)and(k2y=1)and(ky=1)and(qp[1,5]=7) then
begin
wjyw[4]:=true;
wjyw[5]:=true;
wjyw[6]:=true;
qp[1,4]:=11;
qp[1,1]:=0;
end;
if (k2x=5)and(kx=7)and(k2y=8)and(ky=8)and(qp[8,5]=1) then
begin
wjyw[1]:=true;
wjyw[2]:=true;
wjyw[3]:=true;
qp[8,6]:=5;
qp[8,8]:=0;
end;
if (k2x=5)and(kx=7)and(k2y=1)and(ky=1)and(qp[1,5]=7) then
begin
wjyw[4]:=true;
wjyw[5]:=true;
wjyw[6]:=true;
qp[1,6]:=11;
qp[1,8]:=0;
end;
qp[ky,kx]:=qp[k2y,k2x];
qp[k2y,k2x]:=0;
if (qp[ky,kx]=6)and(ky=1) then qp[ky,kx]:=2;
if (qp[ky,kx]=12)and(ky=8)then qp[ky,kx]:=8;
end;
const wzfz:array[7..12]of Tqp=
{king}
((( 16, 14, 12, 10, 10, 12, 14, 16),
( 16, 14, 12, 0, 0, 12, 14, 16),
( 16, 14, 0, 0, 0, 0, 14, 16),
( 16, 0, 0, 0, 0, 0, 0, 16),
( 0, 0, 0, 0, 0, 0, 0, 0),
( 0, 0, 0, 0, 0, 0, 0, 0),
( 0, 0, 0, 0, 0, 0, 0, 0),
( 0, 0, 0, 0, 0, 0, 0, 0)),
{quwwn}
(( 3, 5, 8, 8, 8, 8, 5, 3),
( 5, 6, 8, 8, 8, 8, 6, 5),
( 5, 6, 8, 8, 8, 8, 6, 5),
( 5, 6, 8, 8, 8, 8, 6, 5),
( 5, 6, 8, 8, 8, 8, 6, 5),
( 5, 6, 8, 8, 8, 8, 6, 5),
( 5, 6, 8, 6, 8, 8, 6, 5),
( 3, 5, 8, 5, 8, 8, 5, 3)),
{elephant}
(( 3, 5, 0, 5, 5, 0, 5, 3),
( 5, 8, 8, 8, 8, 8, 8, 5),
( 5, 8, 7, 7, 7, 7, 8, 5),
( 5, 8, 7, 6, 6, 7, 8, 5),
( 5, 8, 7, 6, 6, 7, 8, 5),
( 5, 8, 7, 7, 7, 7, 8, 5),
( 5, 8, 8, 8, 8, 8, 8, 5),
( 3, 5, 5, 5, 5, 5, 5, 3)),
{horse}
(( 2, 2, 4, 4, 4, 4, 2, 2),
( 3, 4, 6, 6, 6, 6, 4, 3),
( 3, 6, 8, 8, 8, 8, 6, 3),
( 3, 6, 8, 8, 8, 8, 6, 3),
( 3, 6, 8, 8, 8, 8, 6, 3),
( 3, 6, 8, 8, 8, 8, 6, 3),
( 3, 4, 6, 6, 6, 6, 4, 3),
( 2, 3, 3, 3, 3, 3, 3, 2)),
{car}
(( 0, 4, 4, 3, 3, 4, 4, 0),
( 2, 4, 4, 3, 3, 4, 4, 2),
( 0, 0, 0, 0, 0, 0, 0, 0),
( 0, 0, 0, 0, 0, 0, 0, 0),
( 0, 0, 0, 0, 0, 0, 0, 0),
( 0, 0, 0, 0, 0, 0, 0, 0),
( 2, 4, 4, 3, 3, 4, 4, 2),
( 0, 4, 4, 3, 3, 4, 4, 0)),
{pawn}
(( 0, 0, 0, 0, 0, 0, 0, 0),
( 0, 0, 0, 0, 0, 0, 0, 0),
( 1, 1, 1, 1, 1, 1, 1, 1),
( 3, 3, 3, 3, 3, 3, 3, 3),
( 5, 5, 5, 5, 5, 5, 5, 5),
( 7, 7, 7, 7, 7, 7, 7, 7),
( 10, 10, 10, 10, 10, 10, 10, 10),
( 15, 15, 15, 15, 15, 15, 15, 15)));

function qpcost(qp:Tqp):longint;
const fz:array[0..12]of longint=(0,10000,1800,600,600,1000,200,-10000,-1800,-600,-600,-1000,-200);
var t,i,j:longint;
begin
t:=0;
for i:=1 to 8 do
for j:=1 to 8 do
begin
inc(t,fz[qp[i,j]]);
if qp[i,j] in [7..12] then dec(t,wzfz[qp[i,j],i,j]);
end;
qpcost:=t;
end;
function search(qp:Tqp;wjyw:Twjyw;dep:integer;f:integer):longint;
const smax=9;
var ch:char;
temp:Tqp;
temp2:Twjyw;
i1,i2,i3,i4,j1,j2,j3,j4,i,t:longint;
x1l,x2l,y1l,y2l,fl:array[1..smax+1]of longint;
begin
if dep=0 then begin search:=qpcost(qp);exit;end;
if keypressed then
begin
ch:=readkey;
if ch=#27 then halt;
end;
fillchar(x1l,sizeof(x1l),0);
fillchar(x2l,sizeof(x2l),0);
fillchar(y1l,sizeof(y1l),0);
fillchar(y2l,sizeof(y2l),0);
if f=1 then
begin
for i:=1 to smax+1 do
fl[i]:=maxint;
for i1:=1 to 8 do
for j1:=1 to 8 do
for i2:=1 to 8 do
for j2:=1 to 8 do
if canmoveb(qp,wjyw,i1,j1,i2,j2) then
begin
i:=smax+1;
x1l[smax+1]:=i1;
x2l[smax+1]:=i2;
y1l[smax+1]:=j1;
y2l[smax+1]:=j2;
temp:=qp;
temp2:=wjyw;
fillchar(cm,sizeof(cm),1);
runqz(temp,temp2,i1,j1,i2,j2);
fl[smax+1]:=qpcost(temp);
while (fl[i]<fl[i-1])and(i>1) do
begin
t:=x1l[i];x1l[i]:=x1l[i-1];x1l[i-1]:=t;
t:=x2l[i];x2l[i]:=x2l[i-1];x2l[i-1]:=t;
t:=y1l[i];y1l[i]:=y1l[i-1];y1l[i-1]:=t;
t:=y2l[i];y2l[i]:=y2l[i-1];y2l[i-1]:=t;
t:=fl[i];fl[i]:=fl[i-1];fl[i-1]:=t;
dec(i);
end;
end;
t:=maxint;
for i:=1 to smax do
if fl[i]<>maxint then
begin
temp:=qp;
temp2:=wjyw;
fillchar(cm,sizeof(cm),1);
runqz(temp,temp2,x1l[i],y1l[i],x2l[i],y2l[i]);
t:=min(t,search(temp,temp2,dep-1,2));
end;
search:=t;
end
else
begin
for i:=1 to smax+1 do
fl[i]:=-maxint;
for i1:=1 to 8 do
for j1:=1 to 8 do
for i2:=1 to 8 do
for j2:=1 to 8 do
if canmover(qp,wjyw,i1,j1,i2,j2) then
begin
i:=smax+1;
x1l[smax+1]:=i1;
x2l[smax+1]:=i2;
y1l[smax+1]:=j1;
y2l[smax+1]:=j2;
temp:=qp;
temp2:=wjyw;
fillchar(cm,sizeof(cm),1);
runqz(temp,temp2,i1,j1,i2,j2);
fl[smax+1]:=qpcost(temp);
while (fl[i]>fl[i-1])and(i>1) do
begin
t:=x1l[i];x1l[i]:=x1l[i-1];x1l[i-1]:=t;
t:=x2l[i];x2l[i]:=x2l[i-1];x2l[i-1]:=t;
t:=y1l[i];y1l[i]:=y1l[i-1];y1l[i-1]:=t;
t:=y2l[i];y2l[i]:=y2l[i-1];y2l[i-1]:=t;
t:=fl[i];fl[i]:=fl[i-1];fl[i-1]:=t;
dec(i);
end;
end;
t:=-maxint;
for i:=1 to smax do
if fl[i]<>-maxint then
begin
temp:=qp;
temp2:=wjyw;
fillchar(cm,sizeof(cm),1);
runqz(temp,temp2,x1l[i],y1l[i],x2l[i],y2l[i]);
t:=max(t,search(temp,temp2,dep-1,0));
end;
search:=t;
end;
end;
function searchblack(qp:Tqp;wjyw:Twjyw;var x1,y1,x2,y2:integer):boolean;
var i1,i2,i3,i4,t,t2:longint;
temp:Tqp;
temp2:Twjyw;
begin
searchblack:=false;
t2:=maxint;
for i1:=1 to 8 do
for i2:=1 to 8 do
for i3:=1 to 8 do
for i4:=1 to 8 do
if canmoveb(qp,wjyw,i1,i2,i3,i4) then
begin
temp:=qp;
temp2:=wjyw;
fillchar(cm,sizeof(cm),1);
runqz(temp,temp2,i2,i1,i4,i3);
t:=search(temp,temp2,3,2);
if t>50000 then continue;
searchblack:=true;
if t<t2 then
begin
t2:=t;
x1:=i1;
y1:=i2;
x2:=i3;
y2:=i4;
end;
end;
end;
function choose:boolean;
var i,j:integer;
tf:boolean;
begin
if not(qp[ky,kx] in [1..6]) then begin choose:=false;exit;end;
fillchar(cm,sizeof(cm),0);
tf:=false;
for i:=1 to 8 do
for j:=1 to 8 do
if canmover(qp,wjyw,ky,kx,j,i)or canmoveb(qp,wjyw,ky,kx,j,i) then
begin cm[j,i]:=true;tf:=true;end;

end;
function lost(qp:Tqp):boolean;
var i,j:integer;
begin
lost:=true;
for i:=1 to 8 do
for j:=1 to 8 do
if qp[i,j]=7 then
begin
lost:=false;
exit;
end;
end;
procedure main;
var ch:char;
i,tx,ty,i1,i2,i3,i4:integer;
begin
while true do
begin
print;
repeat
ch:=readkey;
until ch<>#0;
if ch=#27 then halt;
if ch=#13 then
begin
if k2f then
begin
if runqz(qp,wjyw,k2x,k2y,kx,ky) then
begin
if lost(qp) then break;
fillchar(cm,sizeof(cm),1);
if not searchblack(qp,wjyw,i2,i1,i4,i3) then break;
runqz(qp,wjyw,i1,i2,i3,i4);
end;
k2f:=false;
end
else
if choose then
begin
k2x:=kx;
k2y:=ky;
k2f:=true;
end;
end;
for i:=1 to 5 do
if ch=ck[i] then break;
if i=5 then continue;
inc(kx,fx[i,1]);
inc(ky,fx[i,2]);
if kx<1 then kx:=8;
if kx>8 then kx:=1;
if ky<1 then ky:=8;
if ky>8 then ky:=1;

end;
clrscr;
outtextxy(100,100,'You win!');
repeat
ch:=readkey;
until ch=#13;
end;
procedure initchess;
var y:integer;
ch:char;
begin
settextstyle(7,horizdir,6);
setcolor(white);
outtextxy(10,10,'WY Chess');
settextstyle(1,horizdir,1);
y:=100;
outtextxy(50,y,'Made by WangYu');
outtextxy(50,300,'Pressed Enter to continue');
repeat ch:=readkey;until ch=#13;
end;
begin
initg;
initchess;
init;
main;
readkey;
end.
国际象棋

Answer 2

使用GRAPH3.GPU（系统库）
程序开头打上
use graph3;
就可以使用库中的函数和过程了。
建议看看PASCAL的基本教程。
里面有关于库的使用方法。

Answer 3

这是我用的两个库(DIY的),可以参考一下.
{bmp.pas}
unit bmp;
interface
uses graph;
const
maxx=19;maxy=9;
var
x,y:byte;
procedure BMP16(path:string;x,y:word;vscolor:byte);
procedure inigraph;
implementation
procedure inigraph;
var
grDriver: Integer;
grMode: Integer;
ErrCode: Integer;
begin
grDriver := Detect;
{$IFDEF Use8514} { check for Use8514 $DEFINE }
GrDriver := IBM8514;
GrMode := IBM8514Hi;
{$ELSE}
GrDriver := Detect; { use autodetection }
{$ENDIF}
InitGraph(GrDriver, GrMode, '');
ErrCode := GraphResult;
if ErrCode <> grOk then begin
Writeln('Graphics error:', GraphErrorMsg(ErrCode));
halt(1);
end;
end;
procedure BMP16(path:string;x,y:word;vscolor:byte);
const
color16:array [0..15] of byte
=(0,4,2,6,1,5,3,8,7,12,10,14,9,13,11,15);
var
fin:text;
width,height,f:word;
a:array [1..2] of byte;
n,k,r:byte;
i,j,l:longint;
c:char;
begin
assign(fin,path);
reset(fin);
for i:=1 to 10 do read(fin,c);
f:=0;
for j:=1 to 4 do begin
read(fin,c);f:=ord(c)*round(exp(ln(256)*(j-1)))+f;
end;
for i:=1 to 4 do read(fin,c);
width:=0;
for j:=1 to 4 do begin
read(fin,c);width:=ord(c)*round(exp(ln(256)*(j-1)))+width;
end;
height:=0;
for j:=1 to 4 do begin
read(fin,c);height:=ord(c)*round(exp(ln(256)*(j-1)))+height;
end;
reset(fin);r:=0;
for i:=1 to f do read(fin,c);
i:=1;j:=1;
while (i<=height) do begin
read(fin,c);r:=(r+1) mod 4;
n:=ord(c);
a[1]:=n div 16;
a[2]:=n mod 16;
for k:=1 to 2 do begin
if color16[a[k]]<>vscolor then putpixel(x+j-1,y+height-i,color16[a[k]]);
j:=j+1;if j>width then break;
end;
if j>width then begin
j:=1;
i:=i+1;
if r<>0 then for l:=3 downto r do read(fin,c);
r:=0;
end;
end;
close(fin);
end;
end.
----------------------------
{gramouse.pas}
unit gramouse;
interface
uses graph,drivers,crt,bmp;
procedure mouseshow(x,y:byte);
procedure mousedisshow;
procedure graphmouseinit;
procedure mouseinput(var event:tevent);
implementation
var
px,py:word;
p:pointer;
procedure graphmouseinit;
begin
getmem(p,imagesize(0,0,11,20));
end;
procedure mouseshow(x,y:byte);
begin
if x*8+11<getmaxx then px:=x*8 else px:=getmaxx-11;
if y*8+20<getmaxy then py:=y*8 else py:=getmaxy-20;
getimage(px,py,px+11,py+20,p^);
bmp16('mouse.bmp',x*8,y*8,13);
end;
procedure mousedisshow;
begin
putimage(px,py,p^,normalput);
dispose(p);
end;
procedure mouseinput(var event:tevent);
begin
mouseshow(mousewhere.x,mousewhere.y);
repeat
getmouseevent(event);
if event.what=4 then begin
mousedisshow;
mouseshow(mousewhere.x,mousewhere.y);
end;
until event.what=1;
mousedisshow;
end;
end.

Answer 4

猜数。
100以内，猜十次。会提示大了还是小了。
program
ex(input,output);
var
n,a,i:integer;
begin
randomize;
n:=random(100);
for
i:=1
to
10
do
begin
readln(a);
if
a=n
then
begin
writeln('You
win.');break;end;
if
a<n
then
writeln('small')
else
writeln('big');
if
i=10
then
writeln('You
fail.')
end;
readln;
end.
FreePascal、TurboPascal7通过。