DBR Delphi-Ecke

{
Egnlsiche Wsisneshcatfler hbaen fsetegsetllt, dsas man Txete acuh dnan ncoh lseen knan, wnen innehralb enies Wrotes die Bcuhtsaebn vretuashct snid. Bdeignung ist, dsas der esrte und der ltezte Bcuhtsabe des Wrotes bsetheen belibt. Mit dem flogneden Cdoe wreden sloche Txete aus nromlaen Txeten ezregut. Biem esrten Druclhauf wrid vresatucsht, biem zewietn weider rcihitg gsetlelt.
}

// Getestet mit D4 unter XP

function schuetteln(const wrt: string; lg: integer): string; 
var 
  i, z: integer; 
begin 
  result := wrt; 
  i := 2; 
  z := i + ord(lg > 5); 
  while i < lg do begin 
    result[i] := wrt[i + 1]; 
    result[i + 1] := wrt[i]; 
    inc(i, z); 
  end; 
end; 
 
function doit(const txt: string): string; 
const Delimiters = 
  [#1..#64, #91..#96, #123..#191, #215, #216, #247, #248]; 
  Delimiters_0 = [#0] + Delimiters; 
var 
  p, r: PChar; 
  wrt: string; 
  procedure zuweisen(b: boolean); 
  var 
    lg: integer; 
  begin 
    SetString(wrt, r, p - r); 
    lg := length(wrt); 
    if b and (lg > 3) then 
      wrt := schuetteln(wrt, pred(lg)); 
    result := result + wrt; 
    r := p; 
  end; 
  procedure keinBuchstabe; 
  begin 
    while p^ in Delimiters do inc(p); 
    zuweisen(false); 
  end; 
begin 
  result := ''; 
  p := @txt[1]; 
  r := p; 
  repeat 
    keinBuchstabe; 
    while not (p^ in Delimiters_0) do inc(p); 
    zuweisen(true); 
  until p^ = #0; 
end; 
 
// Beispielaufruf 
 
procedure TForm1.Button4Click(Sender: TObject); 
begin 
  Memo1.text := doit(Memo1.text); 
end;