这是一个猜数字游戏，首先，系统会随机产生一个四位数字，这四个数字各不
相同，且无‘0’。然后，由你来猜这个数字。你先猜出一个随意四位数，然后，
系统读入，并作出判断。会给出俩个数字，前面的一个是你猜中的数字正确，且
位置也正确的个数，后面一个是你猜中的数字总数，不论位置正确与否。
例如：假设系统给出的数字是1562
第一次，你猜的是5742
系统给出提示： 1 2
第二次，你猜的是1526
系统给出提示： 2 4
......
你根据如上信息，判断，计算，总结，直到猜中。
注意，你有十次机会。由变量db计数，当db=10 终止游戏。
程序的过程有：
p list1 第一次玩游戏时给出的总目录
p list2 玩过一次后的总目录，多出history一项，记录历史游戏。
p creat 系统随机给出一四位数
p inputdata 读入你猜的四位数，并判断输入格式的正确与否。
p comp 比较系统的数与你猜的数，并给出提示。
p helpd 帮助过程。
p history 记录历史游戏，即你每一步你猜的数字，以及电脑提示。
p mainp 主要的执行过程。
数组shu[] 保存系统的数字
数组shub[] 保存你猜的数字。
程序中有一些彩色字和闪耀效果，有的机器可能要出问题，可以把源程序中所有有textattr:=....这一行删掉。

源代码：
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
textattr:=red+(black shl 4)+blink;
writeln ('--------------Great!You win!---------');
textattr:=lightgray+(black shl 4)
end
else begin
textattr:=yellow+(black shl 4)+blink;
writeln ('--------------ha,ha,you lost!!-------');
textattr:=lightgray+(black shl 4);
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.