贪吃蛇：
uses crt,dos,graph;
type
slist=^listnode;
listnode=record
x,y:integer; direction:1..4;
shape:pointer;
front,next:slist;
end;
cakere=record
x,y:integer;
end;
const cn=5;
var
snake,tail:slist;
hs,bs,ts:array[1..4]of pointer; cs:pointer;
size,height,width,s1,t1,s2,t2,t:integer;
cake:array[1..cn]of cakere;
win,stop,pause:boolean;
gd,gm:integer;
procedure rotate;
var i,j:integer; p:pointer;
begin
for i:=0 to 14 do
for j:=0 to 14 do
putpixel(100+j,114-i,getpixel(i,j));
getmem(p,size); getimage(100,100,114,114,p^);
putimage(0,0,p^,normalput);
end;
procedure drawheadshape;
var i:byte;
begin
setactivepage(1);
getmem(hs[1],size);
line(7,0,0,9); line(7,0,14,9); line(0,9,0,14); line(14,9,14,14); line(0,14,14,14);
setcolor(red); circle(4,9,1); circle(10,9,1);
getimage(0,0,14,14,hs[1]^);
for i:=2 to 4 do begin
getmem(hs[i],size); rotate; getimage(0,0,14,14,hs[i]^); end;
setactivepage(0);
end;
procedure drawbodyshape;
var i:byte;
begin
setactivepage(1);
getmem(bs[1],size); cleardevice; setcolor(white);
line(7,0,0,9); line(7,0,14,9); line(7,6,0,14); line(7,6,14,14);
getimage(0,0,14,14,bs[1]^);
for i:=2 to 4 do begin
getmem(bs[i],size); rotate; getimage(0,0,14,14,bs[i]^); end;
setactivepage(0);
end;
procedure drawtailshape;
var i:byte;
begin
setactivepage(1);
getmem(ts[1],size); cleardevice; setcolor(white);
line(0,0,14,0); line(0,0,7,14); line(14,0,7,14);
getimage(0,0,14,14,ts[1]^);
for i:=2 to 4 do begin
getmem(ts[i],size); rotate; getimage(0,0,14,14,ts[i]^); end;
setactivepage(0);
end;
procedure drawcakeshape;
begin
setactivepage(1); cleardevice;
getmem(cs,size); setcolor(yellow);
circle(7,7,6); setfillstyle(2,yellow);
floodfill(7,7,yellow);
getimage(0,0,14,14,cs^);
setactivepage(0);
end;
procedure drawbasicarea;
begin
s1:=(640-width*15) div 2; t1:=(480-height*15) div 2;
s2:=s1+width*15-1; t2:=t1+height*15-1;
setlinestyle(0,0,thickwidth); setcolor(green);
line(s1-5,t1-5,s2+5,t1-5); line(s2+5,t1-5,s2+5,t2+5);
line(s2+5,t2+5,s1-5,t2+5); line(s1-5,t2+5,s1-5,t1-5);
moveto(s1-5,t2+10);
setcolor(white); outtext('Enter'); setcolor(darkgray); outtext(' -start ');
setcolor(white); outtext('Q'); setcolor(darkgray); outtext(' -quit ');
setcolor(white); outtext('P'); setcolor(darkgray); outtext(' -pause ');
end;
procedure getready;
begin
size:=imagesize(0,0,14,14);
drawheadshape;
drawbodyshape;
drawtailshape;
drawcakeshape;
height:=20; width:=30;
drawbasicarea;
end;
procedure initsnake;
var temp:slist;
begin
new(temp);
with temp^ do begin shape:=hs[4]; x:=2; y:=1; direction:=4 end;
snake:=temp;
new(temp);
with temp^ do begin shape:=ts[4]; x:=1; y:=1;
next:=nil; front:=snake;
direction:=4 end;
tail:=temp; snake^.next:=tail; snake^.front:=nil
end;
procedure listappend;
var temp:slist;
begin
new(temp);
with temp^ do begin
direction:=tail^.direction; shape:=bs[direction];
front:=tail^.front; tail^.front^.next:=temp;
next:=tail;
x:=tail^.x; y:=tail^.y;
end;
case tail^.direction of
1: tail^.y:=tail^.y+1 ;
2: tail^.x:=tail^.x+1 ;
3: tail^.y:=tail^.y-1 ;
4: tail^.x:=tail^.x-1 ;
end;
tail^.front:=temp;
end;
procedure createcake(i:integer);
var k:integer; n:integer; b:boolean; temp:slist;
begin
repeat
b:=true;
n:=random(height*width)+1;
for k:=1 to cn do
if ((cake[k].y-1)*width+cake[k].x)=n then b:=false;
temp:=snake;
while temp<>nil do
begin if ((temp^.y-1)*width+temp^.x)=n then b:=false;
temp:=temp^.next;end;
until b;
if n mod width=0 then cake[i].x:=width
else cake[i].x:=n mod width;
cake[i].y:=n div width+1;
putimage((cake[i].x-1)*15+s1,(cake[i].y-1)*15+t1,cs^,normalput);
end;
procedure timer(flags,cs,ip,ax,bx,cx,dx,si,di,ds,es,bp:word);interrupt;
var s:string; key:char; tt1,tt2:integer;
begin
if keypressed then begin
key:=readkey;
case key of
#75 :if snake^.direction<>4 then begin snake^.direction:=2; snake^.shape:=hs[snake^.direction] end;
#77 :if snake^.direction<>2 then begin snake^.direction:=4; snake^.shape:=hs[snake^.direction] end;
#80 :if snake^.direction<>1 then begin snake^.direction:=3; snake^.shape:=hs[snake^.direction] end;
#72 :if snake^.direction<>3 then begin snake^.direction:=1; snake^.shape:=hs[snake^.direction] end;
'p','P':pause:=true;
'q','Q':stop:=true;
end end;
t:=t+1;
setviewport(s2-50,t1-20,s2-10,t1-10,clipon); clearviewport;
setviewport(0,0,639,479,clipon); moveto(s2-50,t1-20);
str(t div 1080,s);
if (t div 1080<10) then outtext('0');
outtext(s); outtext(':');
str((t mod 1080)div 18,s);
if ((t mod 1080)div 18<10) then outtext('0');
outtext(s);
end;
procedure play;
var key:char; i,j:integer; temp:slist;
cx,cy,dd:integer; oldvec,newvec:pointer;
begin
initsnake; randomize; win:=true; stop:=false; pause:=false;
for i:=1 to cn do createcake(i);
cx:=1; cy:=1; dd:=4; t:=0;
getintvec($1c,oldvec);
newvec:=@timer;
setintvec($1c,newvec);
repeat
if pause then begin setintvec($1c,oldvec); readln;
setintvec($1c,newvec); pause:=false;
end;
putimage((snake^.x-1)*15+s1,(snake^.y-1)*15+t1,snake^.shape^,normalput);
if (cx>=1)and(cx<=width)and(cy>=1)and(cy<=height) then
putimage((cx-1)*15+s1,(cy-1)*15+t1,ts[dd]^,xorput);
cx:=tail^.x; cy:=tail^.y; dd:=tail^.direction;
temp:=tail;
while temp^.front<>nil do
begin with temp^ do begin
if (x>=1)and(x<=width)and(y>=1)and(y<=height)
then putimage((x-1)*15+s1,(y-1)*15+t1,shape^,normalput);
x:=front^.x; y:=front^.y;
direction:=front^.direction;
shape:=bs[direction]; end;
temp:=temp^.front end;
tail^.shape:=ts[tail^.direction];
case snake^.direction of
1:snake^.y:=snake^.y-1;
2:snake^.x:=snake^.x-1;
3:snake^.y:=snake^.y+1;
4:snake^.x:=snake^.x+1;
end;
for i:=1 to cn do
if (snake^.x=cake[i].x)and(snake^.y=cake[i].y)
then begin listappend; createcake(i) end;
temp:=snake^.next;
while temp<>nil do
begin if (temp^.x=snake^.x)and(temp^.y=snake^.y) then
begin stop:=true; win:=false; exit end; temp:=temp^.next; end;
if (snake^.x<1)or(snake^.x>width)or(snake^.y<1)or(snake^.y>height)
then begin win:=false; exit; end;
delay(300);
until stop=true;
setintvec($1c,oldvec);
end;
begin
gd:=detect;
initgraph(gd,gm,'../bgi');
getready;
play;
closegraph;
end.
俄罗斯方块：
USES Crt;
CONST
Change:Array [0..6,0..3,0..7] Of Byte =(((0,1,1,1,2,1,3,1),(1,0,1,1,1,2,1,3),(0,1,1,1,2,1,3,1),(1,0,1,1,1,2,1,3)),
((1,0,0,1,1,1,2,1),(1,0,1,1,1,2,2,1),(0,1,1,1,2,1,1,2),(1,0,0,1,1,1,1,2)),
((1,0,2,0,1,1,2,1),(1,0,2,0,1,1,2,1),(1,0,2,0,1,1,2,1),(1,0,2,0,1,1,2,1)),
((1,0,2,0,0,1,1,1),(0,0,0,1,1,1,1,2),(1,0,2,0,0,1,1,1),(0,0,0,1,1,1,1,2)),
((0,0,1,0,1,1,2,1),(1,0,0,1,1,1,0,2),(0,0,1,0,1,1,2,1),(1,0,0,1,1,1,0,2)),
((1,0,2,0,1,1,1,2),(0,0,0,1,1,1,2,1),(1,0,0,2,1,1,1,2),(2,2,0,1,1,1,2,1)),
((0,0,1,0,1,1,1,2),(2,0,0,1,1,1,2,1),(2,2,1,0,1,1,1,2),(0,2,0,1,1,1,2,1)));
VAR
Board:Array [0..3,0..11,1..25] Of Byte;
Players,N,Nowx,Nowy,Kind,Trans,Speed:Byte;
Time,Score:Word;
Now:Array [0..7] Of Byte;
PROCEDURE Furbish;
VAR B,C:Byte;
Begin
For C:=24 Downto 2 Do Begin
Gotoxy(1,C);
For B:=1 To 10 Do
If Board[0,B,C]=0 Then Write(' ')
Else Write('圹');
End;
End;
PROCEDURE Clear;
Var A,B,C:Byte;D:Boolean;
Begin
For A:=24 Downto 1 Do
Begin
D:=True;
For B:=1 To 10 Do
If Board[0,B,A]=0 Then D:=False;
If D=True Then
Begin
Score:=Score+10;Gotoxy(1,1);Write(Score:5,'0');
For C:=A Downto 2 Do
For B:=1 To 10 Do
Board[0,B,C]:=Board[0,B,C-1];
A:=A+1;
End;
End;
Furbish;
End;
FUNCTION Canmove(X,Y:Byte):Boolean;
BEGIN
Canmove:=True;
If Board[0,X+Now[0],Y+Now[1]]>0 Then Canmove:=False;
If Board[0,X+Now[2],Y+Now[3]]>0 Then Canmove:=False;
If Board[0,X+Now[4],Y+Now[5]]>0 Then Canmove:=False;
If Board[0,X+Now[6],Y+Now[7]]>0 Then Canmove:=False;
End;
PROCEDURE Clean;
Begin
Gotoxy((Nowx+Now[0])*2-1,Nowy+Now[1]);Write(' ');
Gotoxy((Nowx+Now[2])*2-1,Nowy+Now[3]);Write(' ');
Gotoxy((Nowx+Now[4])*2-1,Nowy+Now[5]);Write(' ');
Gotoxy((Nowx+Now[6])*2-1,Nowy+Now[7]);Write(' ');
End;
PROCEDURE Show;
Begin
Gotoxy((Nowx+Now[0])*2-1,Nowy+Now[1]);Write('圹');
Gotoxy((Nowx+Now[2])*2-1,Nowy+Now[3]);Write('圹');
Gotoxy((Nowx+Now[4])*2-1,Nowy+Now[5]);Write('圹');
Gotoxy((Nowx+Now[6])*2-1,Nowy+Now[7]);Write('圹');
End;
BEGIN
Fillchar(Board,Sizeof(Board),0);
Randomize;Score:=0;
For N:=1 To 24 Do
Board[0,0,N]:=1;
For N:=1 To 24 Do
Board[0,11,N]:=1;
For N:=1 To 10 Do
Board[0,N,25]:=1;
Window(31,2,50,25);Textcolor(White);Textbackground(Blue);
Clrscr;Window(31,2,51,25);
Speed:=1;
Kind:=Random(7);Trans:=Random(4);Nowx:=4;Nowy:=1;
For N:=0 To 7 Do
Now[N]:=Change[Kind,Trans,N];
While Canmove(Nowx,Nowy) Do
Begin
Repeat
Clean;Nowy:=Nowy+1;Show;
Repeat
If Keypressed Then
Case Upcase(Readkey) Of
#0:Case Readkey Of
#75:If Canmove(Nowx-1,Nowy) Then Begin Clean;Nowx:=Nowx-1;Show;End;
#77:If Canmove(Nowx+1,Nowy) Then Begin Clean;Nowx:=Nowx+1;Show;End;
#80:Begin Clean;Repeat
If Canmove(Nowx,Nowy+1) Then Nowy:=Nowy+1;
Until Not(Canmove(Nowx,Nowy+1));Show;End;
#61:Begin Gotoxy(9,12);Write('Pause');Repeat Delay(1000);Until Keypressed;Furbish;End;
End;
#27:Exit;
' ',#13:Begin
Clean;Trans:=Trans+1;
If Trans=4 Then Trans:=0;
For N:=0 To 7 Do
Now[N]:=Change[Kind,Trans,N];
If Not(Canmove(Nowx,Nowy)) Then Begin Trans:=Trans-1;For N:=0 To 7 Do
Now[N]:=Change[Kind,Trans,N];Show;End
Else Show;
End;
End;
Until Not(Keypressed);
Delay((10-Speed)*50);
Until Not(Canmove(Nowx,Nowy+1));
Score:=Score+1;Gotoxy(1,1);Write(Score:5,'0');Speed:=(Score Div 300)+1;
Board[0,Nowx+Now[0],Nowy+Now[1]]:=1;
Board[0,Nowx+Now[2],Nowy+Now[3]]:=1;
Board[0,Nowx+Now[4],Nowy+Now[5]]:=1;
Board[0,Nowx+Now[6],Nowy+Now[7]]:=1;
Clear;
Kind:=Random(7);Trans:=Random(4);Nowx:=4;Nowy:=1;
For N:=0 To 7 Do
Now[N]:=Change[Kind,Trans,N];
End;
Gotoxy(7,12);Write('GAME OVER');Readln;
END.
猜数字：
program game;
uses crt;
var fl,flag,fst,fq:boolean;
a:string[10];
fa,fb,ga,k,ab,db,i,j,b:integer;
shu,shub:array[1..4]of integer;
his:array[1..8,1..3] of integer;
z:set of 1..9;
procedure list1;
begin
writeln ('It is a guess number game. Made by Pan xiao huai');
writeln ('----------------game menu------------');
writeln (' 1------start');
writeln (' 2------view help');
writeln (' 3------end');
write ('Please enter your choice(1-3):');
readln (ab);
if ab=3 then ab:=4;
end;
procedure list2;
begin
writeln ('----------------game menu------------');
writeln (' 1------start');
writeln (' 2------view help');
writeln (' 3------view the history');
writeln (' 4------end');
write ('Please enter you choice(1-4):');
readln (ab);
end;
procedure creat;
var
i,j:integer;
z:set of 1..9;
begin
randomize;
j:=1;
z:=[1..9];
ga:=0;
repeat
i:=round(random*10);
if i in z then begin
z:=z-[i];
shu[j]:=i;
ga:=ga*10+shu[j];
inc(j)
end;
until j=5;
end;
procedure inputdata;
begin
repeat
flag:=true;
writeln('please input the number you guess(the for number must be different 1-9):');
write ('the ',k,' time:');
readln (a);
b:=0;
z:=[1..9];
for i:=1 to 4 do
if a[i] in ['1'..'9'] then
begin
shub[i]:=ord(a[i])-ord('0');
b:=b*10+shub[i];
if not(shub[i] in z) then flag:=false
else z:=z-[shub[i]];
end
else flag:=false;
if (b<1000) or (b>9999) then flag:=false;
if length(a)<>4 then flag:=false;
if flag=false then writeln ('----------wrong input!----------');
until flag=true;
his[k,1]:=b;
end;
procedure comp;
begin
fl:=false;
fa:=0;
fb:=0;
for i:=1 to 4 do
for j:=1 to 4 do
if shub[i]=shu[j] then if i=j then begin inc(fa);inc(fb) end
else inc(fb);
writeln (fa,' ',fb);
his[k,2]:=fa;
his[k,3]:=fb;
if fa=4 then fl:=true;
end;
procedure helpd;
begin
clrscr;
writeln ('-----------------------------help file---------------------------');
writeln (' This is a guess number game.Though it is very simple ,it is');
writeln ('very intresting');
writeln (' ----------------how to play?------------------');
writeln (' When game start,the computer will creat four different number,t');
writeln ('you just guess the four number.when you guess the four numbers');
writeln ('for the first time ,the computer will tell you how many number');
writeln ('you guessed is right.the first rusult is the number of right ');
writeln ('ones and the right position.the second result is the total ');
writeln ('right number you guessed');
writeln (' -----------------------------------------------');
writeln ('remember you just have 10 times');
writeln (' the end, wish you have a good time!');
writeln (' -----made by Panxiaohuai');
end;
procedure history;
begin
clrscr;
writeln ('The meant number is: ',ga);
writeln ('The numbers you guessed is as follows:');
for i:=1 to k-1 do
writeln (' ',his[i,1],' ',his[i,2],' ',his[i,3]);
end;
procedure mainp;
begin
fst:=false;
creat;
db:=0;
k:=1;
writeln ('--------you just have 10 choices,now begin---------------');
writeln;
repeat
inputdata;
comp;
inc(db);
inc(k);
until (fl=true) or (db=10);
if fl=true then begin
writeln ('--------------Great!You win!---------');
end
else begin
writeln ('--------------ha,ha,you lost!!-------');
writeln ('------The meant number is:',ga);
end;
writeln ('press enter to continue...');
readln
end;
begin
clrscr;
list1;
fst:=true;
repeat
case ab of
1:mainp;
2:helpd;
3:history;
4:exit
end;
if fst=true then list1
else list2;
until ab=4;
end.
九宫格：
program jgg;
uses crt;
var a:array[1..9] of byte;
i,j,k,s:integer;
c:char;
f,m:boolean;
procedure randomnum;
var i,j,l,m:integer;
begin
for i:=1 to 9 do
a[i]:=i-1;
randomize;
for i:=1 to 500 do
begin
j:=random(8)+1;
m:=random(8)+1;
l:=a[j];
a[j]:=a[m];
a[m]:=l;
end;
end;
function seek0:integer;
begin
for i:=1 to 9 do
if a[i]=0
then begin
seek0:=i;
break;
end;
end;
procedure print;
var k:integer;
begin
clrscr;
writeln('It will be:');
writeln('1 2 3');
writeln('4 5 6');
writeln('7 8');
writeln;
for k:=1 to 9 do
begin
if a[k]=0
then write(' ')
else write(a[k]);
if k mod 3=0
then writeln
else write(' ');
end;
writeln('times:',s);
end;
begin
randomnum;
s:=10;
print;
f:=false;
repeat
c:=readkey;
case ord(c) of
72:begin{up}
j:=seek0;
if (j-1) div 3<>2
then begin
a[j]:=a[j+3];
a[j+3]:=0;
dec(s);
print;
end;
end;
75:begin{left}
j:=seek0;
if j mod 3<>0
then begin
a[j]:=a[j+1];
a[j+1]:=0;
dec(s);
print;
end;
end;
77:begin{right}
j:=seek0;
if j mod 3<>1
then begin
a[j]:=a[j-1];
a[j-1]:=0;
dec(s);
print;
end;
end;
80:begin{down}
j:=seek0;
if (j-1) div 3<>0
then begin
a[j]:=a[j-3];
a[j-3]:=0;
dec(s);
print;
end;
end;
end;
m:=false;
for i:=1 to 8 do
if a[i]<>i
then begin
m:=true;
break;
end;
if not m
then f:=true;
until (s=0) or f;
if f
then begin
clrscr;
writeln('You are win!!!');
delay(2000);
end
else begin
clrscr;
writeln('You are lost!!!');
delay(2000);
end
end.
三子棋：
uses crt;
var
p:array[-1..5,-1..5] of boolean;
q:array[-1..5,-1..5] of char;
i,j,x,r,m,l,o:integer;
a,b,c,d:array[1..24]of integer;
procedure print;
forward;
procedure du;
var
i,j,k,m:integer;
label 1,2;
begin
k:=0;
writeln(' What do you want ? (1,2,3,4,5,6,7,8,9) ');
1:k:=0;
read(m);
clrscr;
for i:=1 to 3 do
for j:=1 to 3 do
begin
k:=k+1;
if k=m then goto 2;
end;
2: if (m<1) or (m>9) or (p[i,j]=false) then begin writeln('Please input again');goto 1; end;
p[i,j]:=false;
q[i,j]:='o';
x:=1;
print;
end;
procedure computer;
var
y:boolean;
i,j,k,m,n:integer;
begin
o:=o+1;
writeln(' Computer is :');
k:=0;j:=0;i:=0;m:=0;n:=0;
for i:=1 to 3 do
for j:=1 to 3 do
begin
k:=0;
if p[i,j] then
for m:=1 to 12 do
begin
y:=true;
for n:=1 to 2 do
begin
k:=k+1;
if q[i+a[k],j+b[k]]<>'x' then y:=false;
end;
if y then begin p[i,j]:=false;q[i,j]:='x';x:=2;print;exit;end;
end;
end;
k:=0;i:=0;j:=0;m:=0;n:=0;
for i:=1 to 3 do
for j:=1 to 3 do
begin
k:=0;
if p[i,j] then
for m:=1 to 12 do
begin
y:= true;
for n:=1 to 2 do
begin
k:=k+1;
if q[i+a[k],j+b[k]]<>'o' then y:=false;
end;
if y then begin p[i,j]:=false;q[i,j]:='x';x:=2;print;exit; end;
end;
end;
if o=2 then begin
if (q[2,2]='x') and ((q[1,1]='o') and (q[3,3]='o')) or ((q[1,3]='o') and (q[3,1]='o'))
then begin p[1,2]:=false;q[1,2]:='x';x:=2;print;exit;end;
if (q[2,2]='o') and (q[3,3]='o') then begin p[1,3]:=false;q[1,3]:='x';x:=2;print;exit;end;
if (q[1,1]='o') and (q[3,2]='o') then begin p[3,1]:=false;q[3,1]:='x';x:=2;print;exit;end;
if (q[1,1]='o') and (q[2,3]='o') then begin p[1,3]:=false;q[1,3]:='x';x:=2;print;exit;end;
if (q[1,3]='o') and (q[2,1]='o') then begin p[1,1]:=false;q[1,1]:='x';x:=2;print;exit;end;
if (q[1,3]='o') and (q[3,2]='o') then begin p[3,3]:=false;q[3,3]:='x';x:=2;print;exit;end;
if (q[3,1]='o') and (q[1,2]='o') then begin p[1,1]:=false;q[1,1]:='x';x:=2;print;exit;end;
if (q[3,1]='o') and (q[2,3]='o') then begin p[3,3]:=false;q[3,3]:='x';x:=2;print;exit;end;
if (q[3,3]='o') and (q[2,1]='o') then begin p[3,1]:=false;q[3,1]:='x';x:=2;print;exit;end;
if (q[3,3]='o') and (q[1,2]='o') then begin p[1,3]:=false;q[1,3]:='x';x:=2;print;exit;end;
end;
if p[2,2] then begin p[2,2]:=false;q[2,2]:='x';x:=2;print;exit;end else
if p[1,1] then begin p[1,1]:=false;q[1,1]:='x';x:=2;print;exit;end;
if p[1,3] then begin p[1,3]:=false;q[1,3]:='x';x:=2;print;exit;end;
if p[3,1] then begin p[3,1]:=false;q[3,1]:='x';x:=2;print;exit;end;
if p[3,3] then begin p[3,3]:=false;q[3,3]:='x';x:=2;print;exit;end;
for i:=1 to 3 do
for j:=1 to 3 do
if p[i,j] then
for m:=1 to 8 do
if q[i+c[m],j+d[m]]='x' then begin p[i,j]:=false;q[i,j]:='x';x:=2;print;exit;end;
i:=0;j:=0;
for i:=1 to 3 do
for j:=1 to 3 do
if p[i,j] then begin p[i,j]:=false;q[i,j]:='x';x:=2;print;exit;end;
end;
procedure print;
var
g,h,d,f:boolean;
i,j,k,l,m:integer;
begin
clrscr;
r:=r+1;
for i:=1 to 3 do
begin
for j:=1 to 3 do
if p[i,j]=false then write(q[i,j]:2) else write('-':2);
writeln;
writeln;
end;
for l:=1 to 3 do
begin
g:=true;
d:=true;
h:=true;
f:=true;
for m:=1 to 3 do
begin
if q[l,m]<>'o' then g:=false;
if q[m,l]<>'o' then d:=false;
if q[l,m]<>'x' then h:=false;
if q[m,l]<>'x' then f:=false;
end;
if h then begin writeln('Computer is winer !');halt end;
if f then begin writeln('Computer is winer !');halt end;
if g then begin writeln('You are winer !');halt end;
if d then begin writeln('You are winer !');halt end;
end;
if (q[1,1]='x')and (q[2,2]='x') and (q[3,3]='x') then begin writeln ('Computer is winer !');halt end;
if (q[1,3]='x')and (q[2,2]='x') and (q[3,1]='x') then begin writeln ('Computer is winer !');halt end;
if (q[1,1]='o')and (q[2,2]='o') and (q[3,3]='o') then begin writeln ('You are winer !');halt end;
if (q[1,3]='o')and (q[2,2]='o') and (q[3,1]='o') then begin writeln ('You are winer !');halt end;
if r=9 then begin writeln('Nobody is winer');halt;end;
if x=1 then computer else du;
end;
begin
a[1]:=1;a[2]:=2;b[3]:=1;b[4]:=2;a[5]:=-1;a[6]:=-2;b[7]:=-1;b[8]:=-2;
a[9]:=1;b[9]:=1;a[10]:=2;b[10]:=2;a[11]:=1;b[11]:=-1;a[12]:=2;b[12]:=-2;
a[13]:=-1;b[13]:=1;a[14]:=-2;b[14]:=2;a[15]:=-1;b[15]:=-1;a[16]:=-2;b[16]:=-2;
a[17]:=-1;a[18]:=1;b[19]:=-1;b[20]:=1;a[21]:=-1;b[21]:=-1;a[22]:=1;b[22]:=1;
a[23]:=-1;b[23]:=1;a[24]:=1;b[24]:=-1;c[1]:=-1;c[2]:=1;d[3]:=-1;d[4]:=1;
c[5]:=-1;d[5]:=-1;c[6]:=-1;d[6]:=1;c[7]:=1;d[7]:=-1;c[8]:=1;d[8]:=1;
for m:=-1 to 5 do
for l:=-1 to 5 do
p[m,l]:=true;
du;
end.
彩票 ：
program caipiao;
uses crt;
var
num:array[1..36] of byte;
a:array[1..10,1..7] of byte;
money:longint;
n:byte;
procedure print(f:boolean);
begin
if f
then clrscr;
writeln('money:',money,' yuan');
end;
procedure init;
label 1;
var i,j:integer;
begin
1:
print(true);
writeln('Input num:(max:1,1 yuan one num)');
readln(n);
if money then begin
writeln('You have no money!!!');
delay(1000);
goto 1;
end;
clrscr;
writeln('Input numbers(from small to big[1--36],max:7):');
for i:=1 to n do
begin
write(i,':');
for j:=1 to 7 do
read(a[i,j]);
readln;
end;
money:=money-n;
print(false);
end;
procedure kaijiang;
var i,j,k,l:integer;
begin
for i:=1 to 36 do
num[i]:=i;
randomize;
writeln('randoming...');
delay(2000);
for i:=1 to 500 do
begin
j:=random(35)+1;
k:=random(35)+1;
l:=num[j];
num[j]:=num[k];
num[k]:=l;
end;
for i:=1 to 6 do
begin
k:=i;
for j:=i+1 to 7 do
if num[j] then k:=j;
if k<>i
then begin
l:=num[k];
num[k]:=num[i];
num[i]:=l;
end;
end;
write('The number is:');
for i:=1 to 7 do
write(num[i],' ');
writeln;
delay(2000);
end;
procedure duijiang;
var i,j,k:integer;
s:array[1..10] of byte;
begin
fillchar(s,sizeof(s),0);
for k:=1 to n do
begin
i:=1;
j:=1;
repeat
if a[k,i]=num[j]
then begin
inc(s[k]);
inc(i);
inc(j);
end
else if a[k,i]>num[j]
then inc(j)
else inc(i);
until (i>=8) or (j>=8);
end;
for i:=1 to n do
begin
case s[i] of
4:money:=money+200;
5:money:=money+2000;
6:money:=money+200000;
7:money:=money+5000000;
end;
end;
print(true);
end;
begin
money:=10;
print(true);
repeat
init;
kaijiang;
duijiang;
until (money<=0) or (money>=10000000);
if money<=0
then begin
clrscr;
writeln('You are lose!!!');
end
else begin
clrscr;
writeln('You are win!!!');
end;
end.
赌博 :
program dubo;
uses crt;
var a:array[1..3] of byte;
mon,j:integer;
procedure randomnum;
var i:byte;
begin
randomize;
for i:=1 to 3 do
a[i]:=random(6)+1;
end;
procedure caidan;
label 1,2;
var i,k:byte;
begin
1:
writeln('money:',mon);
writeln('How many money?');
read(j);
if j>mon
then begin
writeln('You have no money!!!');
goto 1;
end;
mon:=mon-j;
writeln('money:',mon);
delay(2000);
2:
clrscr;
writeln('What do you want?');
delay(2000);
writeln('1:three one');
writeln('2:three two');
writeln('3:three three');
writeln('4:three four');
writeln('5:three five');
writeln('6:three six');
writeln('7:small(3-10)');
writeln('8:big(11-18)');
writeln('9:three');
writeln('10:four');
writeln('11:five');
writeln('12:six');
writeln('13:seven');
writeln('14:eight');
writeln('15:nine');
writeln('16:ten');
writeln('17:eleven');
writeln('18:twelve');
writeln('19:thirteen');
writeln('20:fourteen');
writeln('21:fiveteen');
writeln('22:sixteen');
writeln('23:seventeen');
writeln('24:eighteen');
write('Please input a number:');
readln(i);
if (i>24) or (i<1)
then begin
writeln('date error!!!');
delay(2000);
goto 2;
end;
clrscr;
writeln('randoming...');
delay(2000);
randomnum;
for k:=1 to 3 do
write(a[k],' ');
writeln;
case i of
1,2,3,4,5,6:begin
if (a[1]=i) and (a[2]=i) and (a[3]=i)
then mon:=mon+j*10;
end;
7:begin
if a[1]+a[2]+a[3]<=11
then mon:=mon+j*2;
end;
8:begin
if a[1]+a[2]+a[3]>=12
then mon:=mon+j*2;
end;
9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24:begin
if a[1]+a[2]+a[3]=i-6
then mon:=mon+j*5;
end;
end;
writeln('money:',mon);
end;
begin
mon:=1000;
repeat
caidan;
until (mon>=50000) or (mon<=0);
if mon<=0
then writeln('You are lose!!!')
else writeln('You are win!!!');
end.
猜拳：
program caiquan;
label 1;
const ch:array[1..3] of char=('J','S','B');
var n,pc:char;
i,w,l,m,p,s,q:integer;
begin
w:=0;
l:=0;
s:=0;
for i:=1 to 9 do
begin
1:
writeln('times:',i);
writeln('win:',w,' lose:',l,' same:',s);
write('Input char:(J=jiandao,S=shitou,B=bu)');
readln(n);
m:=0;
case n of
'J':m:=1;
'S':m:=2;
'B':m:=3;
else writeln('error!');
end;
if m=0
then goto 1
else begin
randomize;
p:=random(3)+1;
writeln('PC:',ch[p]);
if p>m
then if p-m=2
then q:=1
else q:=0
else if p then if m-p=2
then q:=0
else q:=1
else q:=3;
if q=1
then begin
inc(w);
end
else if q=0
then begin
inc(l);
end
else inc(s);
end;
end;
writeln('times:',i);
writeln('win:',w,' lose:',l,' same:',s);
if w>l
then writeln('You are win')
else if w then writeln('You are lose')
else writeln('The same');
end.
![[大整数乘法] java代码实现](https://img1.php1.cn/3cd4a/24c6f/9f3/0133bb25da242824.jpeg)
京公网安备 11010802041100号 | 京ICP备19059560号-4 | PHP1.CN 第一PHP社区 版权所有