1:
var
n,i:byte;
a,s:longint;
begin
readln(a,n);s:=0;
for i:=1 to n do begin
s:=s+a;
a:=a*10+a mod 10;
end;
writeln(s);
readln;
end.
2:
var
a,b,c:byte;
begin
for a:=1 to 9 do
for b:=0 to 9 do
for c:=0 to 9 do
if a*a*a+b*b*b+c*c*c=a*100+b*10+c then
writeln(a,b,c);
readln;
end.
3:
begin
write('Input the array:');
for i:=1 to 15 do read(a[i]);readln;
{paixu}
for i:=1 to 14 do for j:=i+1 to 15 do if a[i]>a[j] then begin
n:=a[i];a[i]:=a[j];a[j]:=n;
end;
{paixu}
write('Input the data:');
readln(n);
for i:=1 to 15 do if a[i]=n then break;
if a[i]=n then while a[i]=n do begin
write(i,' '); i:=i+1;
end else write('NO');
readln;
end.
4:
var
a:array [1..100,1..100] of integer;
i,j,k:byte;
x,y:byte;
f:boolean;
n:word;
begin
write('Input x, y:');
readln(x,y);
writeln('Input data:');
for j:=1 to y do for i:=1 to x do read(a[i,j]);readln;
n:=1;
for i:=1 to x do for j:=1 to y do begin
f:=true;
for k:=1 to x do if a[k,j]<a[i,j] then f:=false;
for k:=1 to y do if a[i,k]>a[i,j] then f:=false;
if f then begin writeln(n:3,' : ',i:3,', ',j:3); n:=n+1; end;
end;
if n=1 then writeln('Not found!');
readln;
end.
5:
var
a:longint;
i:byte;
function dc(n:longint):boolean;
var i:byte;
a:string;
begin
dc:=true;
str(n,a);
for i:=1 to length(a) do if a[i]<>a[length(a)+1-i] then dc:=false;
end;
begin
a:=95860;
while not dc(a) do inc(a);
write(a);
readln;
end.
6:
var
a:array [0..3000] of boolean;
i,j:word;
begin
fillchar(a,sizeof(a),true);
a[0]:=false; a[1]:=false;
for i:=2 to 3000 do if a[i] then
for j:=2 to 3000 div i do a[i*j]:=false;
for i:=11 to 3000 do if a[i] then
if not a[i mod round(exp(ln(10)*(trunc(ln(i)/ln(10)))))] then a[i]:=false;
for i:=1000 to 3000 do if a[i] then write(i:8);
readln;
end.
后面懒得写了，有空再说。
之前写过一个猜数字，放在这里了：
program gn;
type int_1_4=array [1..4] of integer;
st_5=string[5];
var i,j,k:integer;
numn,numg:int_1_4;
ga,gb:array [1..8] of integer;
nun:array [1..8,1..4] of integer;
flag:boolean;
ch:char;
procedure init;
var r_g:integer;
begin
randomize;
for i:=1 to 4 do begin
r_g:=random(10-i);
numn[i]:=r_g;
end;
for k:=1 to 4 do
for i:=1 to 4 do
for j:=1 to i-1 do
if numn[i]=numn[j] then begin
numn[i]:=succ(numn[i]);
numn[i]:=numn[i] mod 10
end;
flag:=false;
writeln;writeln;
end;
function readnum(var num:int_1_4):boolean;
var st5:st_5;
function realnum(numl:st_5):boolean;
var flagl:boolean;
begin
flagl:=true;
if length(numl)<>4 then flagl:=false;
realnum:=flagl;
if not flagl then writeln('ERROR:length');
if flagl then begin
for i:=1 to 4 do
if not (numl[i] in ['0'..'9']) then
flagl:=false;
if not flagl then begin
realnum:=false;
writeln('ERROR:char');
end;
if flagl then begin
for i:=1 to 4 do
for j:=1 to i-1 do
if numl[i]=numl[j] then flagl:=false;
if not flagl then begin
writeln('ERROR:same');
realnum:=false;
end;
end;
end;
if not flagl then write('')
end;
procedure lr(st:st_5);
begin
if k<>1 then writeln;
for i:=1 to k-1 do begin
for j:=1 to 4 do write(nun[i,j]);
writeln(' ',ga[i],'A',gb[i],'B');
end;
write('Guess number:');
readln(st5);
end;
begin
lr(st5);
while not realnum(st5) do lr(st5);
for i:=1 to 4 do num[i]:=ord(st5[i])-48;
end;
procedure ab(n,g:int_1_4);
var a,b:integer;
begin
a:=0;b:=0;
for i:=1 to 4 do
for j:=1 to 4 do
if n[i]=g[j] then b:=b+1;
for i:=1 to 4 do
if n[i]=g[i] then begin
a:=a+1;
b:=b-1;
end;
if a=4 then begin
writeln('You are right! Congratulations!');
k:=8;
flag:=true;
end;
if (a<>4) and (k<>8) then for i:=1 to k do write(' ');
ga[k]:=a;gb[k]:=b;
for i:=1 to 4 do nun[k,i]:=g[i];
end;
begin
init;
for k:=1 to 8 do begin
readnum(numg);
ab(numn,numg);
end;
writeln;
if not flag then begin
writeln('Wrong!');
write('right answer is:');
for i:=1 to 4 do write(numn[i]);
writeln;
end;
readln;
end.
还有高精度计算，不过没有除法：
简单加法：
program db1_1;
function jia(n1,n2:string):string;
var
n3:string;
i:byte;
begin
n3:='';
{-1-}if length(n1)<length(n2)
then for i:=1 to length(n2)-length(n1) do insert('0',n1,1)
else for i:=1 to length(n1)-length(n2) do insert('0',n2,1);
{-2-}for i:=length(n1) downto 1 do insert(chr(ord(n1[i])+ord(n2[i])-48),n3,1);
{-3-}for i:=length(n1) downto 1 do
if n3[i]>'9' then begin
if i=1 then insert('1',n3,1)
else n3[i-1]:=succ(n3[i-1])
end;
{-4-}for i:=1 to length(n3) do if n3[i]>'9' then n3[i]:=chr(ord(n3[i])-10);
{-5-}jia:=n3;
end;
var
a,b:string;
begin
readln(a);readln(b);writeln(jia(a,b));readln;
end.
其它：
unit HP;
interface
type
HPN=record
n:string;{数字主体}
s:boolean;{符号，值为true时是正数}
d:integer;{点的位置}
end;
Function StrToHPN(s:string;var a:HPN):boolean;
{将字符串转换为高精度类型}
Function StrInput(s:string):string;
{输入，格式为字符串类型}
Procedure HPNInput(s:string;var a:HPN);
{输入，格式为高精度类型}
Function HPNToStr(a:HPN):string;
{将高精度类型转换为字符串}
Function HPNComp (a,b:HPN):shortint;
{高精度类型比较大小，返回值1为">",0为"=",-1为"<"}
Function StrComp (a,b:string):shortint;
{字符串类型比较大小，返回值1为">",0为"=",-1为"<"}
Procedure HPNEvaluate(a:HPN;var b:HPN);
{赋值，a给b}
Procedure HPNSwap (var a,b:HPN);
{交换a,b}
Procedure HPNPlus (a,b:HPN;var c:HPN);
{高精度类型加法}
Function StrPlus (a,b:string):string;
{字符串类型加法}
Procedure HPNMinus(a,b:HPN;var c:HPN);
{高精度类型减法，a被减数，b为减数}
Function StrMinus(a,b:string):string;
{字符串类型减法，a被减数，b为减数}
Function StringOfChar(c:Char;l:byte):String;
{返回包含一个字符重复指定次数的字符串}
Procedure HPNMultiplication(a,b:HPN;var c:HPN);
{高精度类型乘法}
Function StrMultiplication(a,b:string):string;
{字符串类型乘法}
Procedure HPNdivison(a,b:HPN;var c:HPN;u:byte);
implementation
Function StringOfChar;
var
i:byte;t:String;
begin
t:='';for i:=1 to l do t:=t+c;
StringOfChar:=t;
end;
Function StrToHPN;
var
i:byte;
begin
a.s:=s[1]<>'-';if s[1] in ['+','-'] then delete(s,1,1);
a.d:=pos('.',s)-1;
if a.d=-1 then a.d:=length(s);
delete(s,a.d+1,1);
StrToHPN:=true;
if length(s)=0 then StrToHPN:=false;
while (s[1]='0') and (s<>'') do begin
delete(s,1,1);
a.d:=a.d-1;
end;
for i:=length(s) downto 1 do
if s[i]='0' then delete(s,i,1) else break;
a.n:=s;
for i:=1 to length(a.n) do
if not (a.n[i] in ['0'..'9'])
then StrToHPN:=false;
end;
Procedure HPNInput;
var
t:string;
f:boolean;
begin
f:=false;
repeat
if f then writeln('Input Error!');
write(s);
readln(t);
f:=true;
until StrToHPN(t,a);
end;
function StrInput;
var
a:HPN;
begin
HPNInput(s,a);
StrInput:=HPNToStr(a)
end;
function HPNToStr;
var
i:integer;
s:string;
begin
s:='';
if not a.s then s:=s+'-';
if a.d<=0 then begin
s:=s+'0';
if a.n<>'' then begin
s:=s+'.';
s:=s+StringOfChar('0',a.d+2);
s:=s+a.n;
end;
end else begin
if a.d<=length(a.n) then s:=s+(copy(a.n,1,a.d));
if a.d<length(a.n) then begin
s:=s+'.';
s:=s+(copy(a.n,a.d+1,length(a.n)-a.d))
end;
if a.d>length(a.n) then begin
s:=s+(a.n);
s:=s+StringOfChar('0',a.d-length(a.n));
end;
end;
HPNToStr:=s;
end;
function HPNComp;
var
i,l:byte;
begin
if (a.n=b.n) and (a.s=b.s) and (a.d=b.d) then HPNComp:=0 else begin
if a.s<>b.s then HPNComp:=2*Ord(a.s)-1 else
if a.d<>b.d then HPNComp:=2*Ord((a.d>b.d)=a.s)-1
else begin
for i:=1 to l do if a.n[i]<>b.n[i] then break;
HPNComp:=2*Ord((a.n[i]>b.n[i])=a.s)-1;
end;
end;
end;
function StrComp;
var
m,n:HPN;
begin
StrToHPN(a,m);StrToHPN(b,n);
StrComp:=HPNComp(m,n)
end;
Procedure HPNEvaluate;
begin
b.n:=a.n;b.s:=a.s;b.d:=a.d;
end;
Procedure HPNSwap;
var
c:HPN;
begin
HPNEvaluate(a,c);
HPNEvaluate(b,a);
HPNEvaluate(c,b);
end;
procedure HPNPlus;
var
i,k:integer;
f:boolean;
s:string;
begin
if a.d<b.d then begin
a.n:=StringOfChar('0',b.d-a.d)+a.n;a.d:=b.d;
end else if a.d>b.d then begin
b.n:=StringOfChar('0',a.d-b.d)+b.n;b.d:=a.d;
end;
c.d:=a.d;
if length(a.n)<length(b.n)
then a.n:=a.n+StringOfChar('0',length(b.n)-length(a.n))
else b.n:=b.n+StringOfChar('0',length(a.n)-length(b.n));
k:=0;c.n:='';
if a.s=b.s then begin
c.s:=a.s;
for i:=length(a.n) downto 1 do begin
k:=k+ord(a.n[i])+ord(b.n[i])-96;
c.n:=chr(k mod 10+48)+c.n;
k:=k div 10
end;
if k<>0 then begin
c.n:=chr(k+48)+c.n;
c.d:=c.d+1
end;
end else begin
f:=a.s;a.s:=true;b.s:=true;
if HPNComp(a,b)=-1 then begin
f:=not f;
HPNSwap(a,b)
end;
c.s:=f;
for i:=length(a.n) downto 1 do begin
k:=ord(a.n[i])-ord(b.n[i])+k;
c.n:=chr(48+(k+10) mod 10)+c.n;
if k<0 then k:=-1 else k:=0
end
end;
s:=HPNToStr(c);
if not StrToHPN(s,c) then write('')
end;
function StrPlus;
var
m,n,c:HPN;
begin
StrToHPN(a,m);StrToHPN(b,n);
HPNPlus(m,n,c);
StrPlus:=HPNToStr(c)
end;
procedure HPNMinus;
begin
b.s:=not b.s;
HPNPlus(a,b,c)
end;
function StrMinus;
begin
if b[1]='-' then b:=copy(b,2,length(b)-1) else b:='-'+b;
StrMinus:=StrPlus(a,b)
end;
Procedure HPNMultiplication;
var
i,j:byte;
d:HPN;
begin
with c do begin
n:='0';d:=0;s:=true
end;
for i:=1 to length(a.n) do begin
for j:=1 to ord(a.n[i])-48 do begin
d:=b;d.d:=d.d+a.d-i;
HPNPlus(c,d,c);
end;
end;
end;
function StrMultiplication;
var
m,n,c:HPN;
begin
StrToHPN(a,m);StrToHPN(b,n);
HPNMultiplication(m,n,c);
StrMultiplication:=HPNToStr(c)
end;
procedure HPNdivison;
begin
end;
end.
可以将它保存成hp.pas然后再
uses hp;
var
a,b:string;
begin
a:=StrInput('Input First HPN:');
b:=StrInput('Input Second HPN:');
write(StrPlus(a,b));
write(StrMinus(a,b));
write(StrMultip(a,b));
writeln;
end.
在同一个文件夹保存、运行。
第10题：
正方形=n*m+(n-1)*(m-1)+...直到有一个为零
长方形=(n*(n-1)/2)*(m*(m-1)/2)-正方形