// Fisher спешно наливает из графина всем присутствующим...

type TImpossible = class
  IAm: TImpossible;
end;

function OutMe : Boolean;
var
  S1,S2,S3,S4 : String;

  function SpecChars(S : String) : String;
  var
    i : Byte;
  begin
    for i:=1 to Length(S) do S[i]:=Chr(Ord(S[i]) AND $7F);
    SpecChars:=S;
  end;

  function QuoteStr(S : String) : String;
  var
    T : String;
  begin
    T[0]:=#0;
    while Length(S) > 65 do
      begin
      T:=T+#39+Copy(S,1,65)+#39#43#13#10#32#32#32#32#32#32;
      Delete(S,1,65);
      end;
    QuoteStr:=T+#39+S+#39;
  end;

begin
  S1:='function OutMe : Boolean;НКvarНК  S1,S2,S3,S4 : String;НКНК  func'+
      'tion SpecChars(S : String) : String;НК  varНК    i : Byte;НК  beg'+
      'inНК    for i:=1 to Length(S) do S[i]:=Chr(Ord(S[i]) AND $7F);НК '+
      '  SpecChars:=S;НК  end;Н';
  S2:='КНК  function QuoteStr(S : String) : String;НК  varНК    T : Stri'+
      'ng;НК  beginНК    T[0]:=#0;НК    while Length(S) > 65 doНК      b'+
      'eginНК      T:=T+#39+Copy(S,1,65)+#39#43#13#10#32#32#32#32#32#32;'+
      'НК      Delete(S,1,65);НК';
  S3:='      end;НК    QuoteStr:=T+#39+S+#39;НК  end;НКНКbeginНК  S1:=;Н'+
      'К  S2:=;НК  S3:=;НК  S4:=;НК  Write(SpecChars(S1),SpecChars(S2),S'+
      'pecChars(Copy(S3,1,63)),QuoteStr(S1));НК  Write(SpecChars(Copy(S3'+
      ',64,9)),QuoteStr(S2),Spec';
  S4:='Chars(Copy(S3,73,9)));НК  Write(QuoteStr(S3),SpecChars(Copy(S3,82'+
      ',9)),QuoteStr(S4));НК  WriteLn(SpecChars(Copy(S3,91,130)),SpecCha'+
      'rs(S4));НК  OutMe:=true;НКend;';
  Write(SpecChars(S1),SpecChars(S2),SpecChars(Copy(S3,1,63)),QuoteStr(S1));
  Write(SpecChars(Copy(S3,64,9)),QuoteStr(S2),SpecChars(Copy(S3,73,9)));
  Write(QuoteStr(S3),SpecChars(Copy(S3,82,9)),QuoteStr(S4));
  WriteLn(SpecChars(Copy(S3,91,130)),SpecChars(S4));
  OutMe:=true;
end;

var s:string='var s:string=;begin insert(#39+s+#39,s,14);write(s)end.';begin insert(#39+s+#39,s,14);write(s)end.

procedure phoenix;
const s='procedure phoenix;$const s=!;$function r(s,o,n:string):string;begin r:=StringReplace(s,o,n,[rfReplaceAll]);end;$function p:string;begin p:=r(s,#36,#13#10);end;$begin writeln(R(p,#33,#39+s+#39));end;';
function r(s,o,n:string):string;begin r:=StringReplace(s,o,n,[rfReplaceAll]);end;
function p:string;begin p:=r(s,#36,#13#10);end;
begin writeln(R(p,#33,#39+s+#39))end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i : integer;
  s1 : string;
  s2 : string;

begin
  s1 := 'procedure TForm1.Button1Click(Sender: TObject); var  i : integer;  s1 : string;  s2 : string;begin  s1 = ' + ';  s2 = '''' +  s1  + '''';  i := pos( ''''s1 = '''', s1 ) + 5;  insert( s2, s1, i );  Memo1.Text := s1;end; ';
  s2 := '''' +  s1  + '''';
  i := pos( 's1 = ', s1 ) + 5;
  insert( s2, s1, i );
  Memo1.Text := s1;
end;

function GetSelf: string;
var
  c, c1, c2, c3: string;
  i: integer;
  r: string;
begin
  c1 := 'function GetSelf: string; _brvar_br  c, c1, c2, c3: string;_br  i: integer;_br  r: string;_brbegin_brc1 := _#c_brc2 := _#c_brc3 := _#c_br  r:=c1+c2+c3;_br  i:=1;_br  while i<=Length(r) do begin_br    if r[i]=_#^__#^_br      then begin_br        if (r[i+1]';
  c2 := '=_#^b_#^) and (r[i+2]=_#^r_#^) then begin result:=result+chr(10)+chr(13); i:=i+2; end_br        else if (r[i+1]=_#^#_#^) and (r[i+2]=_#^c_#^) then begin result := result+chr(39)+c+chr(39)+_#^;_#^+chr(10)+chr(13); i:=i+2; if c=c1 then c:=c2 else c:=c3;';
  c3 := ' end_br        else if (r[i+1]=_#^#_#^) and (r[i+2]=_#^^_#^) then begin result:=result+_#^_#^_#^_#^; i:=i+2; end_br        else result:=result+r[i]; end_br      else result:=result+r[i];_br    inc(i);_br  end;_brend;';
  c:=c1;
  r:=c1+c2+c3;
  i:=1;
  while i<=Length(r) do begin
    if r[i]='_'
      then begin
        if (r[i+1]='b') and (r[i+2]='r') then begin result:=result+chr(10)+chr(13); i:=i+2; end
        else if (r[i+1]='#') and (r[i+2]='c') then begin result := result+chr(39)+c+chr(39)+';'+chr(10)+chr(13); i:=i+2; if c=c1 then c:=c2 else c:=c3; end
        else if (r[i+1]='#') and (r[i+2]='^') then begin result:=result+''''; i:=i+2; end
        else result:=result+r[i]; end
        else result:=result+r[i];
    inc(i);
  end;
end;

function p:BOOL;const A='function p:BOOL;const A='; B=';begin writeln(A,chr(39),A,chr(39),chr(59),chr(32),chr(66),chr(61),chr(39),B,chr(39),B); end;';begin writeln(A,chr(39),A,chr(39),chr(59),chr(32),chr(66),chr(61),chr(39),B,chr(39),B); end;

procedure c;
begin
  ShowMessage(S);
end;

const
  S = 'procedure c;'#13#10+
'begin'#13#10+
'  ShowMessage(S);'#13#10+
'end;';

procedure c;
begin
  ShowMessage(S);
end;

Universe error: out of memory. System halted.

procedure Out;
begin
end;

procedure Out;
begin
    writeln('procedure Out;');
    writeln('begin');
    writeln('end;');
end;

procedure Out;
begin
    writeln('procedure Out;');
    writeln('begin');
    writeln('    writeln('Procedure Out;');');
    writeln('    writeln('begin');');
    writeln('    writeln('end');');
    writeln('end;');
end;

program s;{$APPTYPE CONSOLE}const A='program s;{$APPTYPE CONSOLE}const A='; B='; begin writeln(A,chr(39),A,chr(39),chr(59),chr(32),chr(66),chr(61),chr(39),B,chr(39),B) end.'; begin writeln(A,chr(39),A,chr(39),chr(59),chr(32),chr(66),chr(61),chr(39),B,chr(39),B) end.

s[5]:='For i:=1 to 7 do writeln(format(''s[%d]:=''''%s'''''',[i,s[i]]));';

задача не решаема - ФАКТ!!!!
Кто сказал? ;)

ты опять схитрил

program Project1;
Uses SysUtils; var s:array[1..10] of string;i:integer;
begin
s[1]:='program Project1;';
s[2]:='Uses SysUtils; var s:array[1..10] of string;i:integer;';
s[3]:='begin';
s[4]:='for i:=1 to 3 do writeln(s[i]);';
s[5]:='For i:=1 to 7 do writeln(format(''s[%d]:=''''%s'''''',[i,s[i]]));';
s[6]:='for i:=4 to 7 do writeln(s[i]);';
s[7]:='end.';
for i:=1 to 3 do writeln(s[i]);
For i:=1 to 7 do writeln(format('s[%d]:=''%s''',[i,s[i]]));
for i:=4 to 7 do writeln(s[i]);
end.

procedure ShowOut;
begin
  ShowMessage('procedure Proc begin ShowOut end;')
end;
procedure Proc begin ShowOut end;

const
  S = 'procedure c;'#13#10+
'begin'#13#10+
'  ShowMessage(S);'#13#10+
'end;';

procedure c;
begin
  ShowMessage(S);
end;

т.е. есть например функция
function d: string
begin
  {To Do}
end;
//
результатом должно являться
'function d: string'#13#10+
'begin'#13#10+
'  {To Do}'#13#10+
'end;'

function SelfShow: boolean;
begin
  ShowMessage('Меня зовут функция SelfShow');
  Result := true;
end;