Colored ListBox

I need to create a listbox in which each item's font will be colored differently (and I need control which color goes to which item, ofcourse).

I tried to use some events and TListBox canvas property to do custom draws - but no luck.

Any ideas?
idokAsked:
Who is Participating?
 
AttarSoftwareConnect With a Mentor Commented:
Should I submit this as an answer?

Please reject if not...

Tim.
0
 
simonetCommented:
The unit below is a sample ColorBox that does a similar thing, but instead of showing text it shows a colored rectangle. You can easily change it so it displays only colored text.

Yours,

Alex

*********


unit ASColorBox;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Dialogs, StdCtrls;

type
      TNewColorEvent = procedure(Sender : TObject; NewColor : TColor) of object;

type
  TASColorBox = class(TCustomComboBox)
  private
        FAllowCustom : boolean;
        FOnNewColor : TNewColorEvent;
        ASelColor : TColor;
        procedure FillColorList;
     procedure SetSelColor(AColor : TCOlor);
     function GetSelColor : TCOlor;
            procedure ItemDraw(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
     procedure SetAllowCustom(AValue : boolean);
    { Private declarations }
  protected
        procedure Change; override;
    { Protected declarations }
  public
        constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
    { Public declarations }
  published
    { Published declarations }
    property AllowCustom : boolean read FAllowCustom write SetAllowCustom default true;
    property SelColor : TColor read GetSelColor write SetSelColor;
    property ItemHeight;
    property DropDownCount;
    property TabOrder;
    property OnClick;
    Property OnDblClick;
    property OnChange;
    property OnEnter;
    property OnExit;
    property OnNewColor : TNewColorEvent read FOnNewColor write FOnNewColor;
  end;

procedure Register;

implementation

const
      CUSTOMSTR = 'Custom...';


procedure Register;
begin
  RegisterComponents(AS_REG_PALLETE, [TASColorBox]);
end;

constructor TASColorBox.Create(AOwner: TComponent);
begin
      inherited;
  Parent := TWinControl(AOwner);
  FillColorList;
  Style := csOwnerDrawFixed;
  Sorted := false;
  FAllowCustom := true;
  ControlStyle := ControlStyle + [csDoubleClicks];
  OnDrawItem := ItemDraw;
  itemindex := 0;
  invalidate;
end;

procedure TASColorBox.Change;
var
      ColorDlg : TColorDialog;
begin
  if items[itemindex]=CUSTOMSTR then
  begin
        ColorDlg := TColorDialog.Create(self);
     with ColorDlg do
           try
                 if execute then
                 SetSelColor(ColorDlg.Color)
           else
                 itemindex := items.count-2;
        finally
              free;
           end;
  end;
      inherited;
end;

procedure TASColorBox.SetSelColor(AColor : TCOlor);
var
      a : integer;
begin
      if AColor = ASelColor then exit;
  ASelColor := AColor;
  a := items.indexof(ColorToString(ASelColor));
  if a<0 then
  begin
        a := items.count-1;
     if not FAllowCustom then inc(a);
            items.Insert(a, ColorToString(ASelColor));
     if assigned(FOnNewColor) then
           FOnNewColor(self, ASelColor);
  end;
  itemindex := a;
       Change;
//  invalidate;
end;


function TASColorBox.GetSelColor : TCOlor;
begin
      Result := StringToColor(items[itemindex]);
//       ASelColor := Result;
end;



destructor TASColorBox.Destroy;
begin
      OnDrawItem := nil;
  OnMeasureItem := nil;
  inherited;
end;

procedure TASColorBox.FillColorList;
begin
      items.add('clBlack');
      items.add('clGray');
      items.add('clSilver');
      items.add('clWhite');
      items.add('$02b4fafa');
      items.add('clYellow');
      items.add('clRed');
      items.add('clMaroon');
      items.add('clPurple');
      items.add('clFuchsia');
      items.add('clAqua');
      items.add('clBlue');
      items.add('clNavy');
      items.add('clGreen');
      items.add('clLime');
      items.add('clOlive');
      items.add('clTeal');
  items.add(CUSTOMSTR);
end;


procedure TASColorBox.ItemDraw(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
      CRect : TRect;
begin
      CRect.top := Rect.Top + 2;
  CRect.Left := Rect.left  + 2;
  CRect.Bottom := Rect.Bottom - 2;
  CRect.Right := Rect.Right - 2;
      if Control is TCustomComboBox then
        with TCustomComboBox(Control) do
     begin
           Canvas.FillRect(Rect);
        Canvas.Pen.Color := clBlack;
        Canvas.Pen.Style := psSolid;
              if items[index]<>CUSTOMSTR then
        begin
              Canvas.Brush.Color := StringToColor(items[index]);
              Canvas.Rectangle(Crect.left, Crect.top, CRect.Right, CRect.Bottom);
        end
        else
              Canvas.TextOut(Crect.left, Crect.top, items[index]);
     end;
end;

procedure TASColorBox.SetAllowCustom(AValue : boolean);
var
      a : integer;
begin
      if FAllowCustom = AValue then exit;
  FAllowCustom := AValue;
  a := items.indexof(CUSTOMSTR);
  if FAllowCustom then
  begin
        if a<0 then
              items.add(CUSTOMSTR);
  end
  else
  begin
        if a>=0 then
              items.delete(a);
  end;
end;

end.
0
 
AttarSoftwareCommented:
Woohoo, here I go...

when you add the items into the list box, use:

procedure tForm1.additem( itemName : string ) ;
var
  cl : ^tColor ;
begin
  cl := allocmem( sizeof( tColor ) ) ;
  cl^ := clWindowText ;
  ListBox1.Items.AddObject( itemName, tObject( cl ) ) ;
end ;

then set the ListBox's style to OwnerDrawFixed

and in the drawItemFunction, use:

procedure tForm1.ListBox1DrawItem( control : tWinControl ;
                                   Index   : Integer ;
                                   Rect : tRect ;
                                   State : tOwnerDrawState ) ;
var
  cl : ^tColor ;
begin
  ListBox1.Canvas.FillRect( rect ) ;
  cl := pColor( ListBox1.Items.Objects[ Index ] ) ;
  ListBox1.Canvas.Font.Color := tColor( cl^ ) ;
  ListBox1.Canvas.TextOut( rect.top, rect.left, ListBox1.Items[ Index ] ) ;
end ;

That should work...  then, when you want to set the color, just change the object of the item you want to change to be a pointer to a tColor of the colour that you want (see above, but replace clWindowText with another colour -- clRed for example)

Good grief, such bad english...

Anyway, I just thought this might be a cheap and cheerful alternative...

Good luck :)

Tim.
0
Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

 
idokAuthor Commented:
Since Attar offered a shorter and better solution, I'll thank simonet, but reject his answer and allow other people to respond while I evaluate Attar solution.

Btw, Attar - for some reason Delphi(5) shouts
"incompatible types: Graphic.TColor and Unit1.TColor" about this line when I implement your solution:

cl := pColor( ListBox1.Items.Objects[ Index ] ) ;

?  
0
 
simonetCommented:
Well, I provided you with a component that would simplify your life a lot, since you won't have to rewrite code all the time.

Alex
0
 
AttarSoftwareCommented:
Above the two functions, declare:

type
  pColor = ^tColor ;

and then change the:

  cl : ^tColor ;

to:

  cl : pColor ;

inside the add function...

That should fix up the type incompatabilities

....

Simonnet...  sorry, I din't mean to steal your answer, I just knew that there was a faster fix to this problem than the one you suggested, although yours was more complete and forward thinking (due to its easy reuasablitiy)

your inefficiently,

Tim.
0
 
idokAuthor Commented:
Thank you guys.

Alex - I am sorry, I don't have enough experience messing around with custom components (how do I register that unit anyway? When I try to compile Delphi shouts about AS_REG_PALETTE), and seems like it implements a combobox rather than a listbox.

Tim - Your solution has a bug in the drawitem event handler which causes all the items to be drawn on the top line with a blue rectangle over it.
I managed to fix it up and enhance the solution to also support the Bidimodes..  Here's the full working solution:
(Notice the TextRect usage and X,Y offsets calculation)

Procedure TForm1.ListBox1AddItem(ItemName : String; Color : TColor);
var
  Cl : PColor;
begin
  New(Cl);
  Cl^ := Color;
  ListBox1.Items.AddObject(ItemName, TObject(cl));
End;


Procedure TForm1.ListBox1RemoveItem(Index : Integer);
var
  Cl : PColor;
begin
  cl := PColor(ListBox1.Items.Objects[Index]);
  Dispose(Cl);
  Listbox1.Items.Delete(Index);
End;



procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  cl : PColor;
  x  : Integer;
begin

With ListBox1 Do
begin
  cl := PColor(ListBox1.Items.Objects[Index]);
  Canvas.Font.Color := TColor(cl^);
  If BidiMode = bdRightToLeft Then
       X := (ClientWidth - Canvas.TextWidth(Items[Index]))-3
  Else
      X := 0;
  Canvas.TextRect(Rect,X,((Index-TopIndex)*ItemHeight), Items[Index]);
end;

end ;


0
 
AttarSoftwareCommented:
You don't have to free the color when you remove an item...

Listbox1.Items.Delete(Index);

will suffice (I hope, as I never free it ;O) )

Tim.
0
 
AttarSoftwareCommented:
So are you going to accept my answer or not?  It does seem that I answered your question, even if there were some flaws in my code... ;O)

Tim.
0
 
idokAuthor Commented:
Oh, sure.
Thanks a lot!

Sorry for the delay (Busy with the project... ;-)
0
 
AttarSoftwareCommented:
No worries ;O)

Good luck....

Tim.
0
All Courses

From novice to tech pro — start learning today.