为什么有两个点过不了!大神求教!
查看原帖
为什么有两个点过不了!大神求教!
10641
chuxiaoyang楼主2016/6/10 17:50
var
 s,opt:string;
 len,i:longint;
 pro:array[1..225]of char;
procedure transint(a:string;len:longint);forward;
procedure chack0(a:string;len:longint);
begin
 if (len=1)and(a[1]='0') then write('0')
end;
procedure prof(pos:integer);
var i,p:longint;
begin
 p:=pos;
 for i:=1 to p-1 do pro[i]:=s[i];
 transint(pro,p-1);
 chack0(pro,p-1);
 write('/');
 for i:=1 to len-p do pro[i]:=s[i+p];
 transint(pro,len-p);
 halt;
end;
procedure proh;
begin
 transint(s,len-1);
 chack0(s,len-1);
 write('%');
 halt;
end;
procedure prod(pos:integer);
var i:integer;
begin
 if pos=1 then write('0');
 for i:=1 to pos-1 do pro[i]:=s[i];
 transint(pro,pos-1);
 chack0(pro,pos-1);
 write('.');
 for i:=len downto pos+1 do begin;
  write(s[i]);
  if (s[i]='0')or(s[i-1]='0') then break;
 end;
 halt;
end;
procedure transint(a:string;len:longint);
var
 j,l:longint;
begin
 l:=len;
 while a[l]='0' do dec(l);
 for j:=l downto 1 do write(a[j]);
end;
begin
 readln(s);
 len:=length(s);
 for i:=len downto 1 do begin
  case s[i] of
   '/':prof(i);
   '%':proh;
   '.':prod(i);
   else continue;
  end;
 end;
  if (len=1)and(s[1]='0') then begin write('0');halt;end;
  transint(s,len);
end.
2016/6/10 17:50
加载中...