Einträge in einer TListbox unterschiedlich gestalten

[dadu]

Hi Leute!

Kann man die Einträge von einer TListbox unterschiedlich gestalten(Schriftart,Farbe). Kann man auch einen Rahmen um einen Eintrag zeichnen ohne das der zB. beim scrollen wieder weg ist?

DaDu

[Luckie]

Kuck dir mal das Ereignis OnOwnerDraw an.

[APP]

Hallo,

anbei ein Beispiel für eine zweipaltige Listbox mit Scrollbars, unterschiedlichen Zeilenfarben und einer Spaltentrennlinie (Du kannst hier leicht den Font udgl. ändern):

Achtung:
Listbox1.Style :=lbOwnerDrawFixed;
Listbox.Items.Add('WAIT ; C:\DOWNLOADaTex.txt'); // wobei ';' das Trennzeichn zweier Spalten ist!!


Quelle: Mischung aus 2. Postings, eine ist von der Borland-Community, die 2. von hier oder von http://www.delphi-forum.de/ (Sorry, weiß ich jetzt nicht mehr )

Delphi-Quellcode:

UNIT uMain;

INTERFACE

USES
  Windows,
  Messages,
  SysUtils,
  // Variants,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  Tlhelp32,
  StdCtrls,
  ShellAPI,
  ExtCtrls;

TYPE
  TListbox = CLASS(StdCtrls.TListbox)
  PRIVATE
    PROCEDURE wmEraseBkGnd(VAR Msg: TWMEraseBkGnd); MESSAGE WM_ERASEBKGND;
  END;

  TForm1 = CLASS(TForm)
    ListBox1: TListBox;
    Button1: TButton;
    PROCEDURE FormCreate(Sender: TObject);
    PROCEDURE ListBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    PROCEDURE Button1Click(Sender: TObject);
  PRIVATE

    { Private declarations }
  PUBLIC
    { Public declarations }
  END;

VAR
  Form1                            : TForm1;

CONST
  // ListBox Spalten zeichnen
  LB_RowWidth                      : ARRAY[0..1] OF integer = (0, 50);
  // ListBox (ungerade/gerade) Spalten Farben
  LB_arrColors                     : ARRAY[Boolean] OF TColor = ($CCCCCC, $99FFFF);

IMPLEMENTATION

{$R *.dfm}

PROCEDURE TListbox.wmEraseBkGnd(VAR Msg: TWMEraseBkGnd);
VAR
  cv                               : TCanvas;
  h, max                           : Integer;
  r, rc                            : TRect;
  b                                : Boolean;
BEGIN
  Msg.Result := 1;
  h := Perform(LB_GETITEMHEIGHT, 0, 0);
  IF h = LB_ERR THEN h := ItemHeight;
  cv := TCanvas.Create;
  TRY
    cv.Handle := Msg.DC;
    r := Rect(0, 0, ClientWidth, h);
    b := Odd(TopIndex) AND (TopIndex >= 0);
    max := ClientHeight;
    cv.Brush.Style := bsSolid;
    WHILE r.Top < max DO
      BEGIN
        cv.Brush.Color := LB_arrColors[b];
        b := NOT b;
        cv.FillRect(r);
        { Zeichenbereich für erste Spalte }
        rc.Left := r.Left + LB_RowWidth[0] + 2;
        rc.Right := r.Left + LB_RowWidth[1] - 2;
        rc.Top := r.Top;
        rc.Bottom := r.Bottom;
        { Trennlinie zwischen Spalten zeichnen }
        Canvas.MoveTo(rc.Right, rc.Top);
        Canvas.LineTo(rc.Right, rc.Bottom);
        OffsetRect(r, 0, h);
      END;
  FINALLY
    cv.Handle := 0;
    cv.Free;
  END;
END;

PROCEDURE TForm1.FormCreate(Sender: TObject);
BEGIN
  SetWindowPos(Form1.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE OR SWP_NOSIZE);
END;

PROCEDURE TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
VAR
  strVal, strAll                   : STRING;
  pos1, RowWidth                   : integer;
  rc                               : TRect;
BEGIN
  WITH Control AS TListbox DO
    BEGIN
      Canvas.Brush.Style := bsSolid;
      Canvas.FillRect(Rect);
      { Die einzelnen Spalten müssen durch ';' getrennt sein }
      strAll := Items[Index];
      RowWidth := Width;
      { Zeichenbereich für erste Spalte }
      rc.Left := Rect.Left + LB_RowWidth[0] + 2;
      rc.Right := Rect.Left + LB_RowWidth[1] - 2;
      rc.Top := Rect.Top;
      rc.Bottom := Rect.Bottom;
      { Text für erste Spalte ausfiltern }
      pos1 := Pos(';', strAll);
      strVal := Copy(strAll, 1, pos1 - 1);
      // Spalten färben
      IF NOT (odSelected IN State) THEN
        BEGIN
          Canvas.Brush.Color := LB_arrColors[Odd(Index)];
          Canvas.Brush.Style := bsSolid;
        END;
      WITH Control AS TListbox DO
        BEGIN
          Canvas.FillRect(Rect);
          Canvas.Brush.Style := bsClear;
          { Text ausgeben }
          Canvas.TextRect(rc, rc.Left, rc.Top, strVal);
          { Trennlinie zwischen Spalten zeichnen }
          Canvas.MoveTo(rc.Right, rc.Top);
          Canvas.LineTo(rc.Right, rc.Bottom);
          { Zeichenbereich für zweite Spalte }
          rc.Left := Rect.Left + LB_RowWidth[1] + 2;
          rc.Right := Rect.Left + RowWidth - 2;
          { Text für zweite Spalte ausfiltern }
          strAll := Copy(strAll, pos1 + 1, Length(strAll) - pos1);
          pos1 := Pos(';', strAll);
          IF pos1 > 0 THEN
            strVal := Copy(strAll, 1, pos1 - 1)
          ELSE
            strVal := strAll;
          { Text ausgeben }
          Canvas.TextRect(rc, rc.Left, rc.Top, strVal);
          { Trennlinie zwischen Spalten zeichnen }
          Canvas.MoveTo(rc.Right, rc.Top);
          Canvas.LineTo(rc.Right, rc.Bottom);
        END;
    END;
END;

PROCEDURE TForm1.Button1Click(Sender: TObject);
BEGIN
  SendMessage(ListBox1.Handle,                    // This is the Handle of the ListBox to add the scroll bar to
    LB_SetHorizontalExtent,                       // The message to add the scroll bar
    5000,                                         // The width in pixels that you wish to be scrollable
    longint(0));                                  // not used
END;

END.

[EDIT] ACHTUNG, die Scrollbars werden zwar eingeblendet, funktionieren aber nicht, hatte noch keine Zeit nachzusehen warum, Sorry [/EDIT]

[dadu]

Sorry!
Es handlet sich nicht, wie ich geschrieben hatte um eine TListbox sondern um ein TListView.(3 Spalten/Reportstyle)