procedure TForm1.FormCreate(Sender: TObject); 
begin 
 Memo1.Font.name := 'Courier New'; 
 Memo1.Font.Size := 10; 
 Memo2.Font.name := 'Courier New'; 
 Memo2.Font.Size := 10; 
end; 
 
function morse(txt: string; b: boolean): string; 
var 
  ps, einf: string; 
  i: integer; 
begin 
  result := ''; 
  if txt = '' then exit; 
  if not b then einf := #32 else einf := #32#32; 
  charupperbuff(@txt[1], length(txt)); 
  for i := 1 to length(txt) do begin 
    if (copy(txt, i - 1, 1) = #10) 
      or (copy(txt, i - 1, 1) = #13) 
      or b and (copy(txt, i - 1, 1) = #32) 
      then ps := '' else ps := #32; 
    case txt[i] of 
      'A': result := result + ps + '·-'; 
      'Ä': result := result + ps + '·-·-'; 
      'B': result := result + ps + '-···'; 
      'C': result := result + ps + '-·-·'; 
      'D': result := result + ps + '-··'; 
      'E': result := result + ps + '·'; 
      'F': result := result + ps + '··-·'; 
      'G': result := result + ps + '--·'; 
      'H': result := result + ps + '····'; 
      'I': result := result + ps + '··'; 
      'J': result := result + ps + '·---'; 
      'K': result := result + ps + '-·-'; 
      'L': result := result + ps + '·-··'; 
      'M': result := result + ps + '--'; 
      'N': result := result + ps + '-·'; 
      'O': result := result + ps + '---'; 
      'Ö': result := result + ps + '---·'; 
      'P': result := result + ps + '·--·'; 
      'Q': result := result + ps + '--·-'; 
      'R': result := result + ps + '·-·'; 
      'S': result := result + ps + '···'; 
      'T': result := result + ps + '-'; 
      'U': result := result + ps + '··-'; 
      'Ü': result := result + ps + '··--'; 
      'V': result := result + ps + '···-'; 
      'W': result := result + ps + '·--'; 
      'X': result := result + ps + '-··-'; 
      'Y': result := result + ps + '-·--'; 
      'Z': result := result + ps + '--··'; 
      '0': result := result + ps + '-----'; 
      '1': result := result + ps + '·----'; 
      '2': result := result + ps + '··---'; 
      '3': result := result + ps + '···--'; 
      '4': result := result + ps + '····-'; 
      '5': result := result + ps + '·····'; 
      '6': result := result + ps + '----·'; 
      '7': result := result + ps + '---··'; 
      '8': result := result + ps + '--···'; 
      '9': result := result + ps + '-····'; 
      '?': result := result + ps + '··--··'; 
      '+': result := result + ps + '·-·-·'; 
      '=': result := result + ps + '-···-'; 
      ';': result := result + ps + '-·-·-·'; 
      '@': result := result + ps + '·--·-·'; 
      ',': result := result + ps + '--..--'; 
      'ß': result := result + ps + '···--··'; 
      'Ñ': result := result + ps + '--·--'; 
      ':': result := result + ps + '---···'; 
      '_': result := result + ps + '··--·-'; 
      'È': result := result + ps + '·-··-'; 
      'É': result := result + ps + '··-··'; 
      #39: result := result + ps + '·----·'; 
      '/','\': result := result + ps + '-··-·'; 
     'À','Å': result := result + ps + '·--·-'; 
      '.','·': result := result + ps + '·-·-·-'; 
      '"','«','»' : result := result + ps + '·-··-·'; 
      '(','{','[','<': result := result + ps + '-·--·'; 
      ')','}',']','>': result := result + ps + '-·--·-'; 
      '-',#150,#151,#173: result := result + ps + '-····-'; 
      #9: if not b then result := result + #9 else 
          if (copy(txt, i - 1, 1) <> #32) and (copy(txt, i - 1, 1) <> #13) 
            and (copy(txt, i - 1, 1) <> #10) 
            then 
            result := result + #32; 
      #13: if not b then result := result + #13#10 else 
         if (copy(txt, i - 1, 1) <> #32) and (copy(txt, i - 1, 1) <> #13) 
           and (copy(txt, i - 1, 1) <> #10) 
         then 
            result := result + einf; 
      #32: if not b and (copy(txt, i - 1, 1) <> #10) or 
        (copy(txt, i - 1, 2) <> #32#32) and (copy(txt, i - 1, 1) <> #13) 
          and (copy(txt, i - 1, 1) <> #10) 
          and (copy(txt, i - 1, 1) <> #9) 
          then 
          result := result + einf; 
          else if copy(txt, i, 1) > #32 then result := result + #32; 
    end; 
  end; 
  if copy(result,1,1) = #32 then 
  result := copy(result, 2, maxint); 
end; 
 
function morseback(const txt: string): string; 
var s: string; 
begin 
  s  :=  stringreplace(txt, '.', '·', [rfReplaceall]); 
  s  :=  stringreplace(s, #149, '·', [rfReplaceall]); 
  s  :=  stringreplace(s, #150, '-', [rfReplaceall]); 
  s  :=  stringreplace(s, #151, '-', [rfReplaceall]); 
  s  :=  stringreplace(s, #173, '-', [rfReplaceall]); 
  if s = '·-' then result := 'A'else 
  if s = '·-·-' then result := 'Ä'else 
  if s = '·--·-' then result := 'À'else 
  if s = '-···' then result := 'B'else 
  if s = '-·-·' then result := 'C'else 
  if s = '----' then result := 'CH'else 
  if s = '-··' then result := 'D'else 
  if s = '·' then result := 'E'else 
  if s = '·-··-' then result := 'È'else 
  if s = '··-··' then result := 'É'else 
  if s = '··-·' then result := 'F'else 
  if s = '--·' then result := 'G'else 
  if s = '····' then result := 'H'else 
  if s = '··' then result := 'I'else 
  if s = '·---' then result := 'J'else 
  if s = '-·-' then result := 'K'else 
  if s = '·-··' then result := 'L'else 
  if s = '--' then result := 'M'else 
  if s = '-·' then result := 'N'else 
  if s = '--·--' then result := 'Ñ'else 
  if s = '---' then result := 'O'else 
  if s = '---·' then result := 'Ö'else 
  if s = '·--·' then result := 'P'else 
  if s = '--·-' then result := 'Q'else 
  if s = '·-·' then result := 'R'else 
  if s = '···--··' then result := 'ß'else 
  if s = '···' then result := 'S'else 
  if s = '-' then result := 'T'else 
  if s = '··-' then result := 'U'else 
  if s = '··--' then result := 'Ü'else 
  if s = '···-' then result := 'V'else 
  if s = '·--' then result := 'W'else 
  if s = '-··-' then result := 'X'else 
  if s = '-·--' then result := 'Y'else 
  if s = '--··' then result := 'Z'else 
  if s = '-----' then result := '0'else 
  if s = '·----' then result := '1'else 
  if s = '··---' then result := '2'else 
  if s = '···--' then result := '3'else 
  if s = '····-' then result := '4'else 
  if s = '·····' then result := '5'else 
  if s = '----·' then result := '6'else 
  if s = '---··' then result := '7'else 
  if s = '--···' then result := '8'else 
  if s = '-····' then result := '9'else 
  if s = '·-·-·-' then result := '.'else 
  if s = '··--··' then result := '?'else 
  if s = '·-·-·' then result := '+'else 
  if s = '-····-' then result := '-'else 
  if s = '-···-' then result := '='else 
  if s = '-·-·-·' then result := ';'else 
  if s = '-··-·' then result := '/'else 
  if s = '-·--·' then result := '('else 
  if s = '-·--·-' then result := ')'else 
  if s = '·--·-·' then result := '@'else 
  if s = '·----·' then result := #39else 
  if s = '·-··-·' then result := '"'else 
  if s = '---···' then result := ':'else 
  if s = '--··--' then result := ','else 
  if s = '··--·-' then result := '_'else 
  result := s; 
end; 
 
procedure SplitMorse(const mz: string; Trenner: TSysCharSet; 
  LeerzeichenWeg: boolean; ms: TMemorystream); 
var 
  p, r, m: pchar; 
  s, txt: string; 
  lg: integer; 
begin 
  ms.size := 0; 
  if mz = '' then exit; 
  txt := ''; 
  if LeerzeichenWeg then begin 
    p := @mz[1]; 
    m := p; 
    inc(m); 
    while p^ <> #0 do begin 
     if (p^ <> #32) 
      or not (m^ in Trenner + [#45, #46, #149, #150, #151, #173, #183]) 
     then txt := txt + p^; 
     inc(p); 
     inc(m); 
    end; 
  end else txt := mz; 
  txt := trimright(txt);     
  if txt = '' then exit;  
  p := @txt[1]; 
  while p^ <> #0 do begin 
   if p^ in Trenner then p^ := #32; 
   inc(p); 
  end; 
  lg := length(txt); 
  p := @txt[1]; 
  m := p; 
  repeat 
    r := p; 
    while (p^ = '-') or (p^ = '·') or (p^ = '.') or (p^ = '·') 
      or (p^ = #150) or (p^ = #151) or (p^ = #173) 
      do inc(p); 
    SetString(s, r, p - r); 
    if s <> '' then begin 
      s := morseback(s); 
      ms.writebuffer(s[1], length(s)); 
      inc(p); 
    end; 
    r := p; 
    while (p^ <> '-') and (p^ <> '·') and (p^ <> '.') and (p^ <> '·') 
      and (p^ <> #150) and (p^ <> #151) and (p^ <> #173) 
      do begin 
      if (p^ = #0) or (p - m > lg) 
        then break; 
      inc(p); 
    end; 
    SetString(s, r, p - r); 
    if s <> '' then 
      ms.writebuffer(s[1], length(s)); 
  until (p^ = #0) or (p - m > lg); 
end; 
 
// Morsecode erzeugen ... 
 
procedure TForm1.Button1Click(Sender: TObject);         
var OhneFormatierung: boolean; 
begin 
  Memo1.Lines.loadfromfile('c:\test.txt'); 
  OhneFormatierung := false; 
  Memo2.text := morse(Memo1.text, OhneFormatierung); 
  Memo2.Lines.savetofile('C:\morse.txt'); 
end; 
 
// ... und zurückwandeln 
 
procedure TForm1.Button2Click(Sender: TObject); 
var ms:TMemoryStream; 
begin 
  ms:= TMemoryStream.create; 
  Memo1.Lines.loadfromfile('c:\morse.txt'); 
  splitmorse(Memo1.text, ['|', '\'], false, ms); 
  ms.position := 0; 
  Memo2.lines.loadfromstream(ms); 
  ms.free; 
end;