Entwickler-Ecke :: Thema anzeigen - ListBox jeweils 2 Items färben

Popov - Sa 10.05.14 14:32

Also mit MOD färbt man das nicht ein. Ich denke du spielst auf den Wechsel hin. Das geht aber auch mit ODD. Hier zuerst ein Code mit dem man ein Zebraeffekt ereichen kann:

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:

procedure DrawListBox(Control: TWinControl; Index: Integer; Rect: TRect;
  State: TOwnerDrawState);
const
  ColBrush: array [Boolean] of TColor = (clYellow, clAqua); //Zebra-Wunschfarben
  ColFont: array [Boolean] of TColor = (clInactiveCaptionText, clWindowText);
var
  LB: TListBox;
  TopDifTxt: Integer;
begin
  LB := Control as TListbox;

  if odSelected in State then
    LB.Canvas.Font.Color := clCaptionText
  else
  begin
    LB.Canvas.Brush.Color := ColBrush[Odd(Index)];
    LB.Canvas.Font.Color := ColFont[LB.Enabled];
  end;

  TopDifTxt := (LB.ItemHeight div 2) - (LB.Canvas.TextHeight(LB.Items[Index]) div 2);

  LB.Canvas.TextRect(Rect, Rect.Left + 2, Rect.Top + TopDifTxt,
    ExtractFileName(LB.Items[Index]));
end;

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
begin
  DrawListBox(Control, Index, Rect, State);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  Path: String;
  SR: TSearchRec;
begin
  Path := 'c:\';

  with ListBox1 do
  begin
    Style := lbOwnerDrawFixed;

    if FindFirst(Path + '*.*', faAnyFile, SR) = 0 then
    begin
      repeat
        Items.Add(Path + SR.Name);
      until FindNext(SR) <> 0;

      SysUtils.FindClose(SR);
    end;
  end;
end;

Was wir jetzt anpassen müssen ist dieser Teil:

Delphi-Quelltext

1:
2:
3:
4:

  begin
    LB.Canvas.Brush.Color := ColBrush[Odd(Index)];
    ...
  end;

Zum Beispiel so:

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:

function Abc(Index: Integer): Boolean;
begin
  Result := Frac(Index / 4) >= 0.5;
end;

...
  begin
    LB.Canvas.Brush.Color := ColBrush[Abc(Index)];
    ...
  end;

galagher - Sa 10.05.14 15:16

Popov hat folgendes geschrieben :

Also mit MOD färbt man das nicht ein. Ich denke du spielst auf den Wechsel hin. Das geht aber auch mit ODD.

Dass es mit odd geht, wusste ich, mit mod kenne ich erst seit ein paar Tagen durch googeln!

Um auf deinen Code zu kommen: Danke erstmal!

Ich hätte vielleicht erwähnen sollen, dass ich nur solche Items färben möchte, deren Text mit bestimmten Zeichen beginnt.
Konkret: Die ersten 13 Items nicht färben, dann 2, dann 1 nicht, ab dann immer je 2. Da funktioniert dein Code aber nicht korrekt: Irgendwo ist immer ein einzelnes Item statt zwei gefärbt.

galagher - Sa 10.05.14 17:04

Popov hat folgendes geschrieben :

Mein Code funktioniert schon richtig und ich hab auch eine Anpassung eingebaut, wie du sie oben angegeben hast.

Genau das funktioniert so auch!

Popov hat folgendes geschrieben :

Ich hab dir die Zeile genannt in der es um die Färbung geht. Das einzige was du nur noch machen mußt ist die Farbe entsprechend deinen Anforderungen anzupassen. Wo ist also das Problem?

Hier zunächst gibt's kein Problem!

Popov hat folgendes geschrieben :

Du kannst ohne weiteres Abfragen stellen wie if LB.Items[Index] = ...

Ja - siehe oben - das funktioniert so! Da ich aber nicht ab Index 0 beginnen möchte, sondern erst ab Index 14 erstmal 2 Items färben möchte (also 14 und 15) und dann ein Item (16) auslasse, und erst ab Index 17 weitermache, tritt der Effekt auf, dass ein Item gefärbt wird, dann erst wieder je zwei - siehe Grafik.

Ich möchte jedes Item, das mit [ oder mit mit einem Leerzeichen beginnt, färben, und zwar je zwei in derselben Farbe!

Popov - Sa 10.05.14 22:25

Das Problem hier ist, dass du die Problem eventuell nicht korrekt wiedergibst (denke ich mir mal).

Demnach sollen die ersten 14 Items nicht eingefärbt werden, dann Zeilen die mit "[" oder Leerzeichen beginnen, und das abwechselnd. Klingt einfach, ich denke aber, dass das nicht die korrekte Beschreibung ist.

Ich hab hier ein Beispiel mit der Regel: nach "[" die nächste Zeile in der gleichen Farbe zeichnen, vorausgesetzt sie fängt mit "[" oder Leerzeichen an. Alle anderen Zeilen ignorieren. Ich hoffe damit das Problem erkannt zu haben.

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:

var
  ColCount: Integer = -1;
  ColNum: Integer = 0;

procedure DrawListBox(Control: TWinControl; Index: Integer; Rect: TRect;
  State: TOwnerDrawState);
const
  ColBrush: array [Boolean] of TColor = (clYellow, clAqua); //Zebra-Wunschfarben
  ColFont: array [Boolean] of TColor = (clInactiveCaptionText, clWindowText);
var
  LB: TListBox;
  TopDifTxt: Integer;
  S: String;
begin
  LB := Control as TListbox;

  if odSelected in State then
    LB.Canvas.Font.Color := clCaptionText
  else
  begin
    S := LB.Items[Index];

    if (Length(S) > 0) and (S[1] = '[') then
    begin
      ColCount := 0;
      Inc(ColNum);
    end;

    if (Length(S) > 0) and ((S[1] = '[') or (S[1] = ' ')) then
      LB.Canvas.Brush.Color := ColBrush[Odd(ColNum)];

    LB.Canvas.Font.Color := ColFont[LB.Enabled];
  end;

  TopDifTxt := (LB.ItemHeight div 2) - (LB.Canvas.TextHeight(LB.Items[Index]) div 2);

  LB.Canvas.TextRect(Rect, Rect.Left + 2, Rect.Top + TopDifTxt,
    ExtractFileName(LB.Items[Index]));
end;

Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2025 by Christian Stelzmann Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!