var 
  a: array of char; 
const 
  p: integer = 0; 
 
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word; 
  Shift: TShiftState); 
var 
  lg: integer; 
  b: byte; 
  procedure doit(w: integer); 
  var x: integer; 
  begin 
    with TEdit(Sender) do begin 
      for x := selstart to lg - b do begin 
        setlength(a, p + 1); 
        a[p] := text[x + w]; 
        inc(p); 
      end; 
    end; 
  end; 
begin 
  with TEdit(Sender) do begin 
    b := ord(sellength > 0); 
    lg := selstart + sellength; 
    if (key = vk_back) and (lg > 0) then doit(b) else 
      if (key = vk_delete) and (lg - b < length(text)) then doit(1); 
  end; 
end; 
 
// bisherige Aufzeichnung anschauen 
 
procedure TForm1.Button1Click(Sender: TObject); 
var x: integer; 
begin 
  label1.caption := ''; 
  for x := 0 to length(a) - 1 do 
    label1.caption := label1.caption + a[x]; 
end; 
 
// bisherige Aufzeichnung löschen 
 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  a := nil; 
end;