type 
  TForm1 = class(TForm) 
  ... 
  ... 
  ... 
  private 
    st: array of TStaticText; 
  public 
    function BuildLine(twc: TWinControl; x, y, lngth, wdth: integer; 
      horz: boolean; colr: TColor): integer; 
    procedure DeleteLine(i: integer); 
    procedure LineDblClick(Sender: TObject); 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.DFM} 
 
function TForm1.BuildLine(twc: TWinControl; x, y, lngth, wdth: integer; 
  horz: boolean; colr: TColor): integer; 
begin 
  if twc is TComponent then begin 
    Result := length(st); 
    setlength(st, succ(Result)); 
    st[Result] := TStaticText.create(twc.parent); 
    st[Result].autosize := false; 
    if horz then begin 
      st[Result].height := wdth; 
      st[Result].width := lngth; 
    end else begin 
      st[Result].height := lngth; 
      st[Result].width := wdth; 
    end; 
    st[Result].caption := ''; 
    st[Result].color := colr; 
    st[Result].left := x; 
    st[Result].top := y; 
    st[Result].cursor := crHandpoint; 
    st[Result].tag := Result; 
    st[Result].onDblClick := LineDblClick; 
    st[Result].parent := twc.parent; 
  end else Result := -1; 
end; 
 
procedure TForm1.DeleteLine(i: integer); 
begin 
  if length(st) > i then st[i].visible := false; 
end; 
 
procedure TForm1.LineDblClick(Sender: TObject); 
begin 
  DeleteLine(TStaticText(Sender).tag); 
end; 
 
// am Programmschluß alle Linien freigeben 
 
procedure TForm1.FormDestroy(Sender: TObject); 
var x: integer; 
begin 
  for x := 0 to high(st) do st[x].free; 
end; 
 
 
 
// --- Beispielaufrufe --- 
 
// waagerechte Linie auf ein TEdit setzen 
 
procedure TForm1.Button4Click(Sender: TObject); 
var a: integer; 
begin 
  a := ord(Edit1.borderstyle = bsSingle) * 2; 
  if BuildLine(Edit1, a + Edit1.left, Edit1.top + 10, 
    Edit1.clientwidth, 1, true, clGreen) < 0 
    then showmessage('Fehler'); 
end; 
 
// Columns einer Listbox mit blauen Linien kenntlich machen 
 
procedure TForm1.Button5Click(Sender: TObject); 
var w, a, x: integer; 
begin 
  a := ord(Listbox1.borderstyle = bsSingle) * 2; 
  w := Listbox1.clientwidth div Listbox1.columns; 
  for x := 1 to Listbox1.columns - 1 do 
    BuildLine(Listbox1, a + x * (w + 1 + a div 2) + Listbox1.left, 
      Listbox1.top + a, Listbox1.clientheight, 1, false, clBlue); 
end; 
 
// Ein Memo wird zeilenweise mit roten Linien versehen 
 
var 
  merk: array of integer; 
 
procedure TForm1.Button6Click(Sender: TObject); 
var h, a, y, m: integer; 
begin 
  a := ord(Memo1.borderstyle = bsSingle) * 2; 
  m := canvas.Textheight('Dummy'); 
  h := Memo1.clientheight div m; 
  setlength(merk, h); 
  for y := 1 to h do 
    merk[y - 1] := BuildLine(Memo1, a + Memo1.left, a + Memo1.top + y * m + 
      a div 2, Memo1.clientwidth, 1, true, clRed); 
end; 
 
// alle Linien des Memos löschen 
 
procedure TForm1.Button7Click(Sender: TObject); 
var x: integer; 
begin 
  for x := 0 to high(merk) do DeleteLine(merk[x]); 
end;