1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Buttons, Clipbrd;

const
  MaxUmlaute = 89;

  Entities   : array [0..MaxUmlaute] of string[10] =
   ('<','>','&','"',' ','&Ccdil;','&ccdil;','Ñ'
   ,
   'ñ','Þ','þ','Ý','ý','ÿ','ß'
   ,
   'Æ','Á','Â','À','Å','Ã','Ä'
   ,
   'æ','á','â','à','å','ã','ä'
   , 'Ð','É','Ê','È','Ë','ð','é',
   'ê','è','ë','Í','Î','Ì','Ï',
   'í','î','ì','ï','Ó','Ô',
   'Ò','Ø','Õ','Ö','ó','ô',
   'ò','ø','õ','ö','Ú','Û',
   'Ù','Ü','ú','û','ù','ü','®',
   '©','±','µ','¶','·','¢','£',
   '¥','¼','½','¾','¹','²','³',
   '¿','°','¦','§','«','»','„',
   '“');

  Umlaute    : array [0..MaxUmlaute] of char =
   ('<','>','&','"','=','Ç','ç','Ñ','ñ','Þ','þ','Ý','ý','ÿ','ß','Æ','Á',
    'Â','À','Å','Ã','Ä','æ','á','â','à','å','ã','ä','Ð','É','Ê','È','Ë',
    'ð','é','ê','è','ë','Í','Î','Ì','Ï','í','î','ì','ï','Ó','Ô','Ò','Ø',
    'Õ','Ö','ó','ô','ò','ø','õ','ö','Ú','Û','Ù','Ü','ú','û','ù','ü','®',
    '©','±','µ','¶','·','¢','£','¥','¼','½','¾','¹','²','³','¿','°','¦',
    '§','«','»','"','"');

type
  TForm1 = class(TForm)
    Label3: TLabel;
    Memo2: TMemo;
    Memo1: TMemo;
    Image1: TImage;
    procedure Image1Click(Sender: TObject);
  private
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  
implementation

{$R *.dfm}

function SonderzeichenErsetzen(Zeile:string):string;
var j   : integer;
    Ent : string;

  function Entity(Umlaut:string):string;
  var i : integer;
  begin
    i:=0;
    Result:=Umlaut;
    while (Result=Umlaut) and (i<MaxUmlaute) do begin
      if Umlaute[i]=Umlaut then
        Result:=Entities[i];
      inc(i);
    end;
  end; {Entity}

begin
  j:=1;
  while j<=length(Zeile) do begin
    if ord(Zeile[j])>127 then begin
      Ent:=Entity(Zeile[j]);
      delete(Zeile,j,1);
      insert(Ent,Zeile,j);
    end;
    inc(j);
  end;
  Result:=Zeile;
end;

procedure TForm1.Image1Click(Sender: TObject);
var
  I: Integer;
begin
  Memo1.Clear;
  Memo1.PasteFromClipboard;
  Memo2.Clear;
  for I:=0 to Memo1.Lines.Count-1 do begin
    Memo2.Lines.Add(SonderzeichenErsetzen(Memo1.Lines[I]));
  end;
  Memo2.CopyToClipboard;      
end;

end.