Kiedyś coś takiego pisałem z nudy. Do rysowania listy używałem ListBoxa a dane kontaktów (numer, nazwa, opis itp) trzymałem w ListView. Masz tu kod może ci się przyda:
procedure TForm1.LUserDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
Var
Ico: TIcon;
X,H: Integer;
S,T: String;
I : Integer;
R : TRect;
Row: Integer;
Z : Integer;
begin
Ico := TIcon.Create;
if odSelected in State then begin
R.Left := Rect.Left+2;
R.Right := Rect.Right-2;
R.Top := Rect.Top +2;
R.Bottom := Rect.Bottom-2;
LUser.Canvas.Brush.Color := $009DDEB7;
LUser.Canvas.FillRect(R);
LUser.Canvas.Brush.Color := $00266042;
LUser.Canvas.FrameRect(R);
LUser.Canvas.Brush.Style := bsClear;
Img2.GetIcon(0, Ico);
LUser.Canvas.Draw(Rect.Right-30, Rect.Top + 4, Ico);
Img3.GetIcon(0, Ico);
LUser.Canvas.Draw(Rect.Left+4, Rect.Top + 4, Ico);
LUser.Canvas.Font.Color := clBlack;
LUser.Canvas.Font.Style := [fsBold];
LUser.Canvas.TextOut(Rect.Left + 25, Rect.Top+6, L1.Items[Index].SubItems[0]);
end else begin
LUser.Canvas.Brush.Color := $00F2FEEC;
LUser.Canvas.FillRect(Rect);
Img2.GetIcon(0, Ico);
LUser.Canvas.Draw(Rect.Right-30, Rect.Top + 4, Ico);
Img3.GetIcon(0, Ico);
LUser.Canvas.Draw(Rect.Left+4, Rect.Top + 4, Ico);
LUser.Canvas.Font.Color := clBlack;
LUser.Canvas.Font.Style := [fsBold];
LUser.Canvas.TextOut(Rect.Left + 25, Rect.Top+6, L1.Items[Index].SubItems[0]);
end;
Ico.Free;
LUser.Canvas.Font.Name := 'Tahoma';
LUser.Canvas.Font.Height := -10;
LUser.Canvas.Font.Style := [];
//------------------------------------------------------------------------------
H := Canvas.TextHeight(LUser.Items[Index]);
S := L1.Items[Index].SubItems[2];
Row:= (Canvas.TextWidth(S)) div (LUser.Width-20);
if (Row*(LUser.Width-20)) <> Canvas.TextWidth(S) then
Row := Row +1;
for I := 1 to Row do begin
for X := 1 to Length(S) do begin
if X = Length(S) then begin
LUser.Canvas.TextOut(Rect.Left + 10, (Rect.Top + H) + (10*i), Copy(S, 1, X));
Break;
end;
if S[x] = ' ' then begin
T := Copy(S, 1, X);
if Canvas.TextWidth(T) < LUser.Width-20 then
Z := X
else
break;
end;
end;
LUser.Canvas.TextOut(Rect.Left + 10, (Rect.Top + H) + (10*i), Copy(S, 1, Z));
Delete(S, 1, Z);
end;
end;
Luser - komponent ListBox
Img2, Img3 - komponent TImageList
procedure TForm1.LUserMeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
Var
S : String;
Row: Integer;
I,H: Integer;
begin
S := L1.Items[Index].SubItems[2];
Row:= (Canvas.TextWidth(S)) div (LUser.Width-20);
if (Row*(LUser.Width-20)) <> Canvas.TextWidth(S) then
Row := Row +1;
if Row > 0 then
Height := (28 + 6) + (10*Row)
else
Height := 28;
end;
Krótkie objaśnienie:
Do komponentu L1 (TListView) ładowane są dane [Numer, Nazwa, Adres, Opis]
Następnie wyświetlane są na LUser (ListBox). Wielkość zaznaczenia zależy od długości opisu. Potestuj, zmodyfikuj może coś ci z tego wyjdzie. U mnie całość wyglądała mniej więcej tak:
Powodzenia. Pozdro!!!