Listboxeintrag mit Link selberzeichnen

[Keldorn]

hat mich jetzt doch mal interessiert, ich würde es so angehen, ähnlich, wie von jaenicke vorgeschlagen:

Delphi-Quellcode:

procedure TForm1.FormCreate(Sender: TObject);
Var i:integer;
begin
  ListBox_luckie.Style := lbOwnerDrawFixed;
  ListBox_luckie.ItemHeight := 3*ListBox_luckie.canvas.TextHeight('Wg')+4;

  //nur paar Testeinträge
  for i := 1 to 10 do
    ListBox_luckie.items.add('');
end;

procedure TForm1.ListBox_luckieDrawItem(Control: TWinControl; Index: Integer;
  ARect: TRect; State: TOwnerDrawState);
Var SName,STel,SMail:string;
    Textrect:Trect;
    Hoehe:integer;
    Maus:Tpoint;
begin
  SName:='Name'+inttostr(index);
  STel:='0351-123456789-'+inttostr(index);
  smail:='Email'+inttostr(index)+'@blub.de';

  with (Control as TListbox) do
  begin
    hoehe:= canvas.TextHeight('Wg');
    if odSelected in State then
      begin
        Canvas.Font.Color := clHighlightText;
        canvas.brush.color:= clHighlight;
      end
     else
      begin
        Canvas.Font.Color := clWindowText;
        //leichtes Zebramuster
        if odd(index) then
          canvas.brush.color:= clWindow
         else
          //uses graphutil
          canvas.brush.color:= ColorAdjustLuma(colortorgb(clwindow),-10,false);
      end;
    Canvas.FillRect(ARect);

    textrect:=rect(arect.left+2,
                   arect.top+1,
                   arect.Right,
                   arect.Bottom);
    //Name
    canvas.font.style := [fsbold];
    DrawText(Canvas.Handle, PChar(SName), length(sName), TextRect, DT_LEFT);

    //Tel
    offsetrect(Textrect,0,hoehe);
    canvas.font.style := [];
    DrawText(Canvas.Handle, PChar(Stel), length(sTel), TextRect, DT_LEFT);

    //mail
    offsetrect(Textrect,0,hoehe);
    Maus := ScreenToClient(Mouse.CursorPos);

    if PtInRect(textrect,Maus) then
      canvas.font.style := [fsUnderline]
     else
      canvas.font.style := [];
    //für selected noch ändern
    canvas.font.color := clblue;
    DrawText(Canvas.Handle, PChar(Smail), length(Smail), TextRect, DT_LEFT);
  end;

end;

procedure TForm1.ListBox_luckieMouseMove(Sender: TObject; Shift: TShiftState; X,  Y: Integer);
Var Mailrect:Trect;
    Index:integer;
    NeuerCursor:Tcursor;
begin
  with sender as TListBox do
    begin
      index:=ItemAtPos(point(x,y),true);
      if index<>-1 then
        begin
          //Rect des Eintrages holen
          mailrect:=ItemRect(index);
          mailrect.Top:=mailrect.top+1+2+2*canvas.TextHeight('Wg');
          //hab ich nicht :-)
          //mailrect.right:=mailrect.right+2+canvas.Textwidth(Mailstring);

          if PtInRect(mailrect,Point(x,y)) then
            NeuerCursor:=crHandPoint
           else
            NeuerCursor:=crDefault;

          if NeuerCursor<>Cursor then
            begin
              //funktioniert leider noch nicht 100%, aber ich wollte nicht immer die LB komplett neuzeichnen
              //manchmal bleibt das fsunderline bestehen, aber ich wollte auch ohne globaleren Veriablen auskommen
              InvalidateRect(handle,@mailrect,true);
              //invalidate;
              cursor:=NeuerCursor;
            end;
        end;
    end;

end;

in deinem ondrawtiem würde ich

Delphi-Quellcode:

Var Contract:Tcontract;
...
  contract:=TContact((AControl as TListbox).Items.Objects[AIndex]); 
  Nachname:=contract.name;

für übersichtlicher halten