Zeilen in einer Listbox färben

[Chrissi91]

Hi,

die Suche ergab bei mir zwar einige Treffer, jedoch wurde ich aus den Lösungen nicht schlau. Ich habe eine Listbox, die ich mit Einträgen fülle. Jetzt möchte ich eine Zeile färben, und zwar diese, die ich gerade eintrage. Am liebsten wäre es mir, wenn ich die Schriftfarbe ändern kann, aber die Hintergrundfarbe kann ich, wenn es nicht anders geht, auch ändern.

Wie mache ich das jetzt?

Ich fand u.a. folgenden Code, verstehe ihn aber immer noch nicht:

Delphi-Quellcode:

procedure TFmLog.OnDrawItem(Control: TWinControl; Index: Integer; 
  Rect: TRect; State: TOwnerDrawState); 
var 
  TopDif: Integer; // Gleicht die Höhendifferenz aus 
begin 
  with (Control as TListbox) do begin 
    Canvas.Brush.Color := GetBackColor(Items[Index]); // <=== 
    Canvas.Font.Color := clBlack; //Schriftfarbe 

    TopDif := (ItemHeight div 2) - (Canvas.TextHeight(#32) div 2); 
    Canvas.TextRect(Rect, Rect.Left, Rect.Top + TopDif, Items[Index]); 
  end; 
end; 

function TFmLog.GetBackColor(const value:string):Tcolor; 
begin 
   result := clWhite; 
   if Pos(FedSearch.Text, value) >= 0 then 
      Result := $00FF7777; 
end;

Ist er denn richtig und kann mir mal jemand erklären, was das alles bedeutet? Ich blicke da nicht durch.

[Sharky]

Hai Chrissi,

da ich nicht genau weiss wo das Problem liegt hier mal ein anderes Beispiel für den Code:

Delphi-Quellcode:

var
  newItemPos: Integer;

function NewLBItem(aListBox: TListBox; aValue: string; aIndex: Integer = -1): Integer;
begin
  if (aIndex = -1) then // Wenn -1 dann anhängen
  begin
    result := aListBox.Items.Add(aValue);
  end else // ansonsten einfügen
  begin
    aListBox.Items.Insert(aIndex, aValue);
    result := aIndex;
  end;
end;

procedure TDemoForm.AddItemClick(Sender: TObject);
begin
  newItemPos := NewLBItem(ListBox1, Edit1.Text); // Beispiel für anhägen
end;

procedure TDemoForm.InsertItemClick(Sender: TObject);
begin
  newItemPos := NewLBItem(ListBox1, Edit1.Text, 2); // Beispiel für einfügen
end;

procedure TDemoForm.FormCreate(Sender: TObject);
begin
  newItemPos := -1; // Variablen schön initialisieren
  ListBox1.Style := lbOwnerDrawFixed; // Sonst können wir nicht selber zeichnen
end;

procedure TDemoForm.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  TopDif: Integer; // Gleicht die Höhendifferenz aus
begin
  with (Control as TListbox) do
  begin
    if (Index = newItemPos) then // Nur wenn das zuletzt eingefügte Item gezeichnet wird
    begin
      Canvas.Brush.Color := clRed; // Hintergrundfarbe
      Canvas.Font.Color  := clBlack; //Schriftfarbe
    end;
    TopDif := (ItemHeight div 2) - (Canvas.TextHeight(#32) div 2);
    // Damit es in der Mitte der Zeile steht.
    Canvas.TextRect(Rect, Rect.Left, Rect.Top + TopDif, Items[Index]);
    // Und hier wird der Text gezeichnet
  end;
end;

[Chrissi91]

Hi,

danke Sharky, jetzt ist mir doch so einiges klarer geworden.

Allerdings bin ich mir noch nicht ganz im Klaren über folgenden Code:

1. newItemPos Kommt in fast jeder Procedure vor, aber wozu brauche ich das, wenn ich es immer nur ans Ende der Listbox anhängen muss?

2.

Delphi-Quellcode:

procedure TDemoForm.ListBox1DrawItem(Control: TWinControl; Index: Integer; 
  Rect: TRect; State: TOwnerDrawState); 
var 
  TopDif: Integer; // Gleicht die Höhendifferenz aus <== Welche Höhendifferenz
begin 
  with (Control as TListbox) do 
  begin 
    if (Index = newItemPos) then // Nur wenn das zuletzt eingefügte Item gezeichnet wird <== Verstehe ich nicht :gruebel:
    begin 
      Canvas.Brush.Color := clRed; // Hintergrundfarbe 
      Canvas.Font.Color  := clBlack; //Schriftfarbe 
    end; 
    TopDif := (ItemHeight div 2) - (Canvas.TextHeight(#32) div 2); 
    // Damit es in der Mitte der Zeile steht. <== Also zentriere ich damit den Eintrag in der Zeile, ist aber nicht notwenig, oder?
    Canvas.TextRect(Rect, Rect.Left, Rect.Top + TopDif, Items[Index]); 
    // Und hier wird der Text gezeichnet <== nun gut, text kann man auch zeichnen. ^^
  end; 
end;

Hinter einige Kommentare habe ich nochmal Unklarheiten aufgezählt. z.T. habe ich auch meine Schlussfolgerungen daneben geschrieben. Vielleicht ist ein Teil von mir ja richtig wiedergegeben worden.

Ansonsten danke nochmal.

[Sharky]

Hai Chrissi,

wenn neue Einträge immer nur am ende der ListBox stehen dann braucht man die HilfsVariable newItemPos natürlich nicht ;-)
In diesem Fall musst Du im DrawItem-Ereigniss nur prüfen ob der Index des aktuell gezeichneten Items der Anzahl der Items (.Count -1) entspricht.

Das mit dem Zentrieren ist leider etwas unglücklich formuliert. Durch diese Berechnung wird der Text nicht Horizontal sonder Vertikal in den Zeilen zentriert. Probiere doch einfach mal aus wie es aussieht wenn Du es weglassen würdest.

P.S. Es ist schon reichtig von zeichnen zu reden. Da Du etwas auf dem Canvas (Leinwand) ausgibst ist dies immer als zeichnen zu sehen. Wenn das gezeichnete jetzt zufällig Buchstaben sind -> Gut, es könnte aber auch alles andere sein *g*

[Chrissi91]

So, jetzt habe ich das auf meine Bedüfnisse umgeschrieben, aber an der Farbe ändert isch nichts.

Delphi-Quellcode:

    function  NewLBItem(aListBox: TListBox; aValue: string; aIndex: Integer = -1): Integer;
    procedure ltbUserDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
    procedure LoadFromArray;
    procedure btnAddProfilClick(Sender: TObject);
    procedure btnChangeProfilClick(Sender: TObject);
    procedure cmbEntryChange(Sender: TObject);
    procedure btnAddUserClick(Sender: TObject);
    procedure btnReloadClick(Sender: TObject);
    procedure btnChangeClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;
  Adressen: Array[1..100, 1..2] of String;
  Eintraege: Integer;
implementation

{$R *.dfm}

function TfrmMain.NewLBItem(aListBox: TListBox; aValue: string; aIndex: Integer = -1): Integer;
begin
    result := aListBox.Items.Add(aValue);
end;

procedure TfrmMain.ltbUserDrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  TopDif: Integer; // Gleicht die Höhendifferenz aus
begin
  with (Control as TListbox) do
  begin
    Canvas.Brush.Color := clBlack; // Hintergrundfarbe
    Canvas.Font.Color  := clRed; //Schriftfarbe
  end;
  TopDif := (ltbUser.ItemHeight div 2) - (Canvas.TextHeight(#32) div 2); // Damit es in der Mitte der Zeile steht.
  Canvas.TextRect(Rect, Rect.Left, Rect.Top + TopDif, ltbUser.Items[Index]); // Und hier wird der Text gezeichnet
end;

Damit rufe ich es auf:

Delphi-Quellcode:

procedure TfrmMain.btnReloadClick(Sender: TObject);
var
  I: Integer;
begin
  ltbUser.Clear;
  For I := 1 to Eintraege do
    begin
      WebBrowser.Navigate('http://wwp.icq.com/scripts/online.dll?img=5&icq=' + Adressen[I,1]);
      While WebBrowser.Busy do
        begin
          Application.ProcessMessages;
        end;
      If WebBrowser.LocationURL = 'http://status.icq.com/5/online1.gif' then
        begin
          NewLBItem(ltbUser, Adressen[I,1]);
        end
      Else
        begin
          NewLBItem(ltbUser, Adressen[I,1]);
        end;
    end;
end;

auch wenn die obere procedure im Moment wenig Sinn macht, müsste doch eigentlich doch was passieren, oder?

Im OI habe ich den Style auch auf lbOwnerDrawFixed gesetzt.

[Sharky]

Hai Christopher,

die Farbe sollte er aber eigentlich ändern.
Aber ersteinmal zu deinem Code ;-)
Da Du neue Zeilen immer am ende der ListBox anhängst brauchst Du die Funktion NewLBItem so natürlich nicht.
Wenn ich deinen Code sehe denke ich mal Du möchtest in einer LB den Onlinestatus von ICQ-Usern anzeigen. Unabhängig davon das dies über die URL wohl nicht sicher zu machen ist würde ich die Information über den Status in dem Eintrag speichern. Stichwort AddItem.

Zum einfärben habe ich Dir noch mal ein Demo angehängt. Dabei arbeite ich zum ausgeben des Textes mit DrawText(). Dadurch erspare ich mir die Berechnung um den Text zu zentrieren da ich das bei DrawText einfach als Parameter angeben kann.

[DP-Maintenance]

Dieses Thema wurde von "Sharky" von "Sonstige Fragen zu Delphi" nach "VCL / WinForms / Controls" verschoben.
Passt besser hier.