Here's my program:
program p1074;

{$APPTYPE CONSOLE}

uses
  SysUtils;
var Token, s: string;
    dlina_s, N, ukaz: integer;

procedure GetToken;
begin
 Inc(ukaz);
 if ukaz>dlina_s then Token:=''
  else Token:=s[ukaz];
end;

procedure SendBack;
begin
 Dec(ukaz);
 if ukaz=0 then Token:=''
  else Token:=s[ukaz];
end;

function UnsInt:boolean;
begin
 Result:=true;
 GetToken;
 if not (Token[1] in ['0'..'9']) then
 begin
  Result:=false;
  exit;
 end;
 while Token[1] in ['0'..'9'] do
 begin
  GetToken;
  if token='' then break;
 end;
 SendBack;
end;

function Znak:boolean;
begin
 GetToken;
 if (Token='+') or (Token='-') then Result:=true
  else Result:=false;
end;

function _Int:boolean;
begin
 if not Znak then SendBack;
 Result:=UnsInt;
end;

function Exponenta:boolean;
begin
 GetToken;
 if (Token<>'e') and (Token<>'E') then
 begin
  Result:=false;
  exit;
 end;
 Result:=_Int;
end;

function UnsReal:boolean;
begin
 GetToken;
 if Token='.' then // aa?eaio .x
 begin
  Result:=UnsInt;
  exit;
 end
 else Sendback;
 Result:=UnsInt;
 if not Result then exit; // aa?eaio x
 GetToken;
 if Token='.' then Result:=UnsInt // aa?eaio x.x
 else begin SendBack; exit end;
end;

function SimpleReal:boolean;
begin
 if not Znak then SendBack;
 Result:=UnsReal;
end;

function RealNum:boolean;
begin
 Result:=SimpleReal;
 if not Result then Exit;
 GetToken;
 if Token='' then exit
  else begin SendBack; Result:=Exponenta; end;
end;

function Analiz:boolean;
begin
 Result:=RealNum;
 ukaz:=0;
end;

// ------------------ Eiiao aiaeeca --------------------- //

procedure DelExp(col: integer);
var i, j, dot: integer;
    zeros: string;
begin
 zeros:='';
 i:=StrToInt(copy(s,col+1,dlina_s)); // noaiaiu e
 Delete(s,col,dlina_s);
 dot:=Pos('.',s);
 if dot=0 then
 begin
  for j:=1 to abs(i) do zeros:=zeros+'0';
  if i>=0 then s:=s+zeros
   else s:=zeros+'.'+s;
 end
 else
 begin
  if i=0 then exit;
  if i>0 then
  begin
   if i>=length(s)-dot then // noaiaiu e aieuoa aeeiu a?iaiie ?anoe, iiyoiio
   begin                    // aueeauaaai oi?eo e aiiieiyai ni?aaa ioeyie
    for j:=1 to i-length(s)+dot do
     zeros:=zeros+'0';
    s:=s+zeros;
    Delete(s,dot,1);
   end
   else  // noaiaiu e iaiuoa aeeiu a?iaiie ?anoe, ia?aaaeaaai oi?eo ia i ai?aai
   begin
    Insert('.',s,dot+i);
    Delete(s,dot,1);
   end
  end // if i>0
  else
  begin
   if abs(i)>=dot-1 then // noaiaiu e (ii iiaoe?) aieuoa aeeiu oaeie ?anoe ?enea
   begin           // ia?aaaeaaai oi?eo ia io?iia ianoi e aiiieiyai ioeyie neaaa
    Delete(s,dot,1);
    for j:=1 to abs(i)-dot+2 do
     if j=1 then zeros:='0.' else zeros:=zeros+'0';
    Insert(zeros,s,1+Ord(s[1]='-'));
   end
   else
   begin
    Delete(s,dot,1);
    Insert('.',s,dot+i);
   end;
  end;
 end;
end;


procedure Format;
var i, dot, count: integer;
begin
 if s[1]='+' then Delete(s,1,1); // oaaeyai ie?n
// oaaeyai aaaouea ioee
 count:=0;
 for i:=1 + Ord((s[1]='+') or (s[1]='-')) to length(s)-1 do
  if  s[i]='0' then
  begin
   if s[i+1]<>'.' then Inc(count)
  end
    else break;
  if count>0 then Delete(s,1+Ord((s[1]='+') or (s[1]='-')),count);
// oaaeeee ioee
 i:=Pos('e',s);
 if i<>0 then DelExp(i)
 else
 begin
  i:=Pos('E',s);
  if i<>0 then DelExp(i);
 end;
 // ieoai 0 a oaeie ?anoe
 if ((s[1]='-') and (s[2]='.')) or (s[1]='.') then Insert('0',s,1+Ord(s[1]='-'));
 dot:=Pos('.',s);
 if (N=0) and (dot<>0) then Delete(s,dot,length(s));
 if (N>0) and (dot<>0) then
  if N>length(s)-dot then
   for i:=1 to N-length(s)+dot do
    s:=s+'0'
  else
   Delete(s,dot+N+1,length(s));
 if (N>0) and (dot=0) then
 begin
  s:=s+'.';
  for i:=1 to N do
   s:=s+'0';
 end;
 if s='-0.0' then s:='0.0';
 writeln(s);
end;


begin
 ukaz:=0;
 {Assign(Input,'input.txt');
 Assign(Output,'output.txt');}
 repeat
  readln(s);
  if s='#' then break;
  readln(N);
  dlina_s:=length(s);
  if not Analiz then
  begin
   writeln('Not a floating point number');
   continue;
  end
  else Format;
 until false;
end.

that's a long program!

thanks! :(