?
Solved

Colored ListBox

Posted on 1999-10-20
11
Medium Priority
?
511 Views
Last Modified: 2010-04-04
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?
0
Comment
Question by:idok
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 6
  • 3
  • 2
11 Comments
 
LVL 15

Expert Comment

by:simonet
ID: 2143787
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
 
LVL 1

Expert Comment

by:AttarSoftware
ID: 2145467
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
 

Author Comment

by:idok
ID: 2147255
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
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LVL 15

Expert Comment

by:simonet
ID: 2147308
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
 
LVL 1

Expert Comment

by:AttarSoftware
ID: 2147456
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
 
LVL 1

Accepted Solution

by:
AttarSoftware earned 200 total points
ID: 2147460
Should I submit this as an answer?

Please reject if not...

Tim.
0
 

Author Comment

by:idok
ID: 2149108
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
 
LVL 1

Expert Comment

by:AttarSoftware
ID: 2149578
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
 
LVL 1

Expert Comment

by:AttarSoftware
ID: 2158369
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
 

Author Comment

by:idok
ID: 2159873
Oh, sure.
Thanks a lot!

Sorry for the delay (Busy with the project... ;-)
0
 
LVL 1

Expert Comment

by:AttarSoftware
ID: 2161851
No worries ;O)

Good luck....

Tim.
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
Video by: ITPro.TV
In this episode Don builds upon the troubleshooting techniques by demonstrating how to properly monitor a vSphere deployment to detect problems before they occur. He begins the show using tools found within the vSphere suite as ends the show demonst…
Do you want to know how to make a graph with Microsoft Access? First, create a query with the data for the chart. Then make a blank form and add a chart control. This video also shows how to change what data is displayed on the graph as well as form…
Suggested Courses

719 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question