PASCAL编程问题

pascal编程问题~

var
ch:char;//第一行输入的字符
r,x,y,z,a,b:longint;//r为半径,x,y,z为三角形边长,a,b为长宽
p:double;//p为海伦公式里的一个量
begin
readln(ch);
if ch='Y' then
begin
readln(r);
writeln(2*pi*r:0:2);
writeln(pi*sqr(r):0:2);
end
else if ch='S' then
begin
readln(x,y,z);
writeln(x+y+z);
p:=(x+y+z) shr 1;
writeln(sqrt(p*(p-x)*(p-y)*(p-z)):0:2);
end
else if ch='J' then
begin
readln(a,b);
writeln((a+b) shl 1);
writeln(a*b);
end;
end.

本人91年上大学,92年学的Pascal,毕业后已经从来不用了.早忘了Pascal的规范了.只记得Procedure和:=...把java版的算法给你,自己改吧.
import java.util.Scanner;
public class HalfCircle{
public static void main(String[] args){
Scanner sc=new(System.in);
int r=sc.nextInt();
r--;
for(int i=r;i>=-r;i--){
int count=(int)(Math.rount(Math.sqrt(r*r-i*r)));
System.out.print("*");
for(int j=0;j<count;j++){
System.out.print("*");
}
System.out.println();
}
}
}

因为机器上没有安装Pascal，所以用Delphi的控制台来实现。
Delphi的控制台程序，代码如下：

program Project3;
{$APPTYPE CONSOLE}
uses
SysUtils,
math;
var
s:String;//存储输入文本
sType:String;//存储加密类型
i: Integer;
//前后翻转
function FunctionA(AStr:String):String;
var
i: Integer;
begin
Result:='';
for I := Length(Astr) downto 1 do
begin
Result:=Result+AStr[i];
end;
end;
//向右移字符，最一个补到最前
function FunctionC(AStr:String):String;
begin
if Length(AStr)>1 then
begin
Result:=AStr[Length(Astr)];
Result:=Result+Copy(Astr,1,Length(Astr)-1);
end
else
Result:=Astr;
end;
{
function FunctionC(AStr:String):String;
var
i: Integer;
begin
Result:='';
if Length(AStr)>1 then
begin
Result:=AStr[Length(Astr)];
for I := 1 to Length(Astr)-1 do
begin
Result:=Result+AStr[i];
end;
end
else
Result:=Astr;
end;
}
//以中间为对称轴，左右集体交换
function FunctionE(AStr:String):String;
var
j,k,m: Integer;
n: Extended;
begin
if Length(Astr)<2 then//单个字符，不需要换
Result:=Astr
else
begin
n:=Length(Astr)/2;//取中点
j:=Ceil(n);//向上取整
Result:='';
k:=j+1; //后半部分字符的起点
if j>n then m:=j-1//前半部分字符的结束点
else m:=j;
Result:=Copy(Astr,k,m);//复制后半部分
if m<>j then//如果有正中间的字符，则复制
begin
Result:=Result+Astr[j];
end;
Result:=Result+Copy(Astr,1,m);
end;
end;
//向左移字符，第一个补到最末
function FunctionJ(AStr:String):String;
begin
if Length(AStr)>1 then
begin
Result:=Copy(Astr,2,Length(Astr)-1);
Result:=Result+AStr[1];
end
else
Result:=Astr;
end;
//把文本中的数字减1
function FunctionM(AStr:String):String;
var
i,j: Integer;
begin
Result:='';
for I := 1 to Length(Astr) do
begin
if (Astr[i]>='0') and (Astr[i]<='9') then
begin
j:=StrToInt(Astr[i]);
Dec(j);
if j<0 then j:=9;
Result:=Result+IntToStr(j);
end
else
Result:=Result+AStr[i];
end;
end;
//把文本中的数字加1
function FunctionP(AStr:String):String;
var
i,j: Integer;
begin
Result:='';
for I := 1 to Length(Astr) do
begin
if (Astr[i]>='0') and (Astr[i]<='9') then
begin
j:=StrToInt(Astr[i]);
Inc(j);
if j>9 then j:=0;
Result:=Result+IntToStr(j);
end
else
Result:=Result+AStr[i];
end;
end;
begin
try
{ TODO -oUser -cConsole Main : Insert code here }
Write('请输入原始文本: ');
Readln(s);
Write('请输入加密方式(ACEJMP): ');
Readln(sType);
for i := 1 to Length(sType) do
begin
if UpperCase(sType[i])='A' then
s:=FunctionA(s)
else if UpperCase(sType[i])='C' then
s:=FunctionC(s)
else if UpperCase(sType[i])='E' then
s:=FunctionE(s)
else if UpperCase(sType[i])='J' then
s:=FunctionJ(s)
else if UpperCase(sType[i])='M' then
s:=FunctionM(s)
else if UpperCase(sType[i])='P' then
s:=FunctionP(s)
else
Writeln('错误的加密方式',sType[i]);
end;
Writeln('加密后的文本是： ',s);
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.

如果Pascal中没有相应的类型与函数，比如：String，Copy，你就需要自定义成数组，以及自己写出相应的函数了。

var i, j : longint;
r, s, t : string;
temp : char;
begin
readln(r);
readln(s);
t := s;
for i := 1 to length(r) do
begin
if r[i] = 'A' then
begin
for j := 1 to length(s) div 2 do
begin
temp := s[j];
s[j] := s[length(s) - j + 1];
s[length(s) - j + 1] := temp;
end;
end;
if r[i] = 'C' then
begin
for j := length(s) downto 1 do
s[j+1] := s[j];
s[1] := t[length(t)];
end;
if r[i] = 'E' then
begin
for j := 1 to length(s) div 2 do
s[j] := t[j + (length(t) + 1) div 2];
for j := length(s) div 2 + 1 to length(s) do
s[j] := t[j - (length(t) + 1) div 2];
if length(s) mod 2 = 1 then
s[length(s) div 2 + 1] := t[length(t) div 2 + 1];
end;
if r[i] = 'J' then
begin
for j := 1 to length(s) do
s[j] := s[j+1];
s[length(s)] := t[1];
end;
if r[i] = 'M' then
begin
for j := 1 to length(s) do
if ord(s[j]) in [49..57] then
s[j] := chr(ord(s[j]) - 1)
else
if ord(s[j]) = 48 then
s[j] := chr(57);
end;
if r[i] = 'P' then
begin
for j := 1 to length(s) do
if ord(s[j]) in [48..56] then
s[j] := chr(ord(s[j]) + 1)
else
if ord(s[j]) = 57 then
s[j] := chr(48);
end;
end;
writeln(s);
end.

var
s,t,s1:string;
n,i,j,w,z,w1,z1,w2,z2:longint;
begin
readln(t);
readln(s);
n:=length(s);
for i:=length(t) downto 1 do
case t[i] of
'A':begin
for j:=1 to n do
s1:=s1+s[n-j+1];
s:=s1;
s1:='';
end;
'C':begin
for j:=2 to n do
s1:=s1+s[j];
s1:=s1+s[1];
s:=s1;
s1:='';
end;
'E':begin
w:=1;
z:=n div 2;
if n mod 2=0 then begin
w1:=z;
z1:=0;
end
else begin
w1:=z+1;
z1:=w1;
end;
w2:=w1+1;
z2:=n;
for j:=w2 to z2 do
s1:=s1+s[j];
for j:=w1 to z1 do
s1:=s1+s[j];
for j:=w to z do
s1:=s1+s[j];
s:=s1;
s1:='';
end;
'J':begin
s1:=s[n];
for j:=1 to n-1 do
s1:=s1+s[j];
s:=s1;
s1:='';
end;
'M':begin
for j:=1 to n do
if s[j] in ['0'..'9']then if s[j]<>'9' then s1:=s1+chr(ord(s[j])+1)
else s1:=s1+'0'
else s1:=s1+s[j];
s:=s1;
s1:='';
end;
'P':begin
for j:=1 to n do
if s[j] in ['0'..'9']then if s[j]<>'0' then s1:=s1+chr(ord(s[j])-1)
else s1:=s1+'9'
else s1:=s1+s[j];
s:=s1;
s1:='';
end;
end;
write(s);
end.

program Project3;
{$APPTYPE CONSOLE}
uses
SysUtils,
math;
var
s:String;//存储输入文本
sType:String;//存储加密类型
i: Integer;
//前后翻转
function FunctionA(AStr:String):String;
var
i: Integer;
begin
Result:='';
for I := Length(Astr) downto 1 do
begin
Result:=Result+AStr[i];
end;
end;
//向右移字符，最一个补到最前
function FunctionC(AStr:String):String;
begin
if Length(AStr)>1 then
begin
Result:=AStr[Length(Astr)];
Result:=Result+Copy(Astr,1,Length(Astr)-1);
end
else
Result:=Astr;
end;
{
function FunctionC(AStr:String):String;
var
i: Integer;
begin
Result:='';
if Length(AStr)>1 then
begin
Result:=AStr[Length(Astr)];
for I := 1 to Length(Astr)-1 do
begin
Result:=Result+AStr[i];
end;
end
else
Result:=Astr;
end;
}
//以中间为对称轴，左右集体交换
function FunctionE(AStr:String):String;
var
j,k,m: Integer;
n: Extended;
begin
if Length(Astr)<2 then//单个字符，不需要换
Result:=Astr
else
begin
n:=Length(Astr)/2;//取中点
j:=Ceil(n);//向上取整
Result:='';
k:=j+1; //后半部分字符的起点
if j>n then m:=j-1//前半部分字符的结束点
else m:=j;
Result:=Copy(Astr,k,m);//复制后半部分
if m<>j then//如果有正中间的字符，则复制
begin
Result:=Result+Astr[j];
end;
Result:=Result+Copy(Astr,1,m);
end;
end;
//向左移字符，第一个补到最末
function FunctionJ(AStr:String):String;
begin
if Length(AStr)>1 then
begin
Result:=Copy(Astr,2,Length(Astr)-1);
Result:=Result+AStr[1];
end
else
Result:=Astr;
end;
//把文本中的数字减1
function FunctionM(AStr:String):String;
var
i,j: Integer;
begin
Result:='';
for I := 1 to Length(Astr) do
begin
if (Astr[i]>='0') and (Astr[i]<='9') then
begin
j:=StrToInt(Astr[i]);
Dec(j);
if j<0 then j:=9;
Result:=Result+IntToStr(j);
end
else
Result:=Result+AStr[i];
end;
end;
//把文本中的数字加1
function FunctionP(AStr:String):String;
var
i,j: Integer;
begin
Result:='';
for I := 1 to Length(Astr) do
begin
if (Astr[i]>='0') and (Astr[i]<='9') then
begin
j:=StrToInt(Astr[i]);
Inc(j);
if j>9 then j:=0;
Result:=Result+IntToStr(j);
end
else
Result:=Result+AStr[i];
end;
end;
begin
try
{ TODO -oUser -cConsole Main : Insert code here }
Write('请输入原始文本: ');
Readln(s);
Write('请输入加密方式(ACEJMP): ');
Readln(sType);
for i := 1 to Length(sType) do
begin
if UpperCase(sType[i])='A' then
s:=FunctionA(s)
else if UpperCase(sType[i])='C' then
s:=FunctionC(s)
else if UpperCase(sType[i])='E' then
s:=FunctionE(s)
else if UpperCase(sType[i])='J' then
s:=FunctionJ(s)
else if UpperCase(sType[i])='M' then
s:=FunctionM(s)
else if UpperCase(sType[i])='P' then
s:=FunctionP(s)
else
Writeln('错误的加密方式',sType[i]);
end;
Writeln('加密后的文本是： ',s);
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.

---

泰兴市19443644797： pascal编程问题 - ？
睢杨中诺： var a,b,c,d:integer;begin read(a,b,c); if a < b then d:=b else d:=a; if c > d then d:=c; writeln(d);end.{题目是求三个数中的最大数吗?还是求n个数中的最大数?}

泰兴市19443644797： pascal语言编程题 - ？
睢杨中诺： VAR i,j,k:integer; BEGIN FOR i:=0 TO 33 DO FOR j:=0 TO 50 DO BEGIN k:=90-i-j; IF 15*i+10*j+5*k=500 THEN writeln(i:5,j:5,k:5) END END.

泰兴市19443644797： pascal编程问题？
睢杨中诺： 结果是156吧,我运行了. 因为A,B是REAL,所以在SQRT时会保留17位小数,而平方时的结果必须是整数,问题就在这里! 就拿X=2举例吧:X=2 A=10.099504938362077; 而A*A=101.99999999999999999; 不完全=102; 只有当SQRT(X+100)和A*A都为整数时才标准相等.

泰兴市19443644797： Pascal编程的一个问题？
睢杨中诺： var m,n,i,s:longint; begin m:=1;n:=1; write(m,' ',n,' '); s:=0; for i:=3 to 30 do begin if (i-1) mod 5=0 then writeln; s:=m+n; write(s,' '); m:=n; n:=s; end; end.

泰兴市19443644797： Pascal编程的问题,高手进!!! - ？
睢杨中诺： //确实很多问题 //楼上的1错了 eof是文件结束 eoln是文件里的一行结束 // while not eoln(input1) do // while not eof(input1) do //等于 while 一行没有结束 do // while 文件没有结束 do //一行没结束 文件怎么会结束? //------------------------分割线----------------...

泰兴市19443644797： 电脑编程问题...pascal...？
睢杨中诺： 你程序编好以后在最后加上Readln; 然后生成exe程序就不会一闪就关了 比如加法 var N1, N2: Integer; begin Readln(N1); Readln(N2); Writeln(N1 + N2); Readln; //这个就是防止一闪就关闭的 end.

泰兴市19443644797： 关于Pascal语言的编程问题 要求完整的 - ？
睢杨中诺： 1. program xx; varn:integer; function jc(i:integer):integer; beginjc:=1;for i:=2 to n dojc:=jc*i; end; beginread(n);writeln(jc(n)); end.2. program xx2; vari:integer; beginfor i:=101 to 199 doif (i mod 3=2) and (i mod 5=3) and (i mod 7=5) then beginwriteln(i);break;end; end.

泰兴市19443644797： 4个初级pascal的编程问题,急求？
睢杨中诺： 1、 Var a,b,c:integer; Begin a:=1; b:=12; c:=123; writeln(a); writeln(b); writeln(c); //这样就是左对齐. writeln(a:3); writeln(b:3); writeln(c:3); //这样就是右对齐. end. 2、 Var a,b,s,l:integer; Begin readln(a,b); s:=a*b; l:=(a+b)*2; writeln(s);//输出面...

泰兴市19443644797： PASCAL 编程问题..？
睢杨中诺： 应该是还没给 year 赋值吧,要不就是后面那句 应该是还没给 year 赋值吧,要不就是后面那个“WRITE”改成小写的(不记得关键字也否也分大小写了)

泰兴市19443644797： PASCAL出现问题？
睢杨中诺： 一般遇到这种问题重新启动FP就好了,编译器的问题,我常遇到,没很大影响,因为FP常常不稳定,所以内部出现错误后会崩溃,重启FP就好了. 调试一下,到哪部出错看一下,如果有过程函数的,直接按F8,出问题后,光标自动停在出错的那行. 在程序末尾设断点,出问题后,光标也会自动停在出错的那行.