Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

Change Listbox color with OnEnter and OnExit

Posted on 2004-08-12
17
Medium Priority
?
465 Views
Last Modified: 2011-04-14
Hi
   I would like to change the Listbox color when you click on it and another color once another control has focus.
Listbox has focus, color = red.
Listbox has no focus, color = white.
I tryed:

procedure TForm1.ListBox1Enter(Sender: TObject);
begin
  ListBox1.Color := clBlue;
end;

procedure TForm1.ListBox1Exit(Sender: TObject);
begin
  ListBox1.Color := clWindow;
end;

But once the listbox has a few lines the color doesn't changed properly.

Thanks
Chris.
0
Comment
Question by:ChrisLM
[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
  • 8
  • 7
  • 2
17 Comments
 
LVL 12

Expert Comment

by:Ivanov_G
ID: 11781546
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Edit1: TEdit;
    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure ListBox1Enter(Sender: TObject);
    procedure ListBox1Exit(Sender: TObject);
  private
    ListBoxColor  : TColor;
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
begin
  with ListBox1.Canvas do
    begin
      Brush.Color := ListBoxColor;
      FillRect(Rect);
      TextOut(Rect.Left + 2, Rect.Top + 2, ListBox1.Items[index]);
    end;
end;

procedure TForm1.ListBox1Enter(Sender: TObject);
begin
  ListBoxColor := clRed;
  ListBox1.Invalidate;
end;

procedure TForm1.ListBox1Exit(Sender: TObject);
begin
  ListBoxColor := clWhite;
  ListBox1.Invalidate;
end;

end.
0
 
LVL 12

Expert Comment

by:Ivanov_G
ID: 11781578
in addition to the above, you will have to draw the whole rectangle of the ListBox somewhere in OnDrawItem

  with FullRect do
    begin
      Left   := 0;
      Top    := 0;
      Right  := Width;
      Bottom := Height;
    end;
  FillRect(FullRect);

  and after that draw the items
0
 

Author Comment

by:ChrisLM
ID: 11790631
Thanks for your input.

Can you send the code for the whole form, with the additional piece of code added, as I tryed what your last two comments said, but I cannot get it too work,

Thanks
Chris
0
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!

 
LVL 12

Expert Comment

by:Ivanov_G
ID: 11790745
Aaaa, yes, not I understand what I forgot (in order to draw the ListBox, you have to set it's style to lbOwnerDrawFixed). I set this in Design time, but it can be done in OnCreate

procedure TForm1.FormCreate(Sender: TObject);
begin
  ListBox1.Style := lbOwnerDrawFixed;
end;
0
 

Author Comment

by:ChrisLM
ID: 11790796
That helped a little, but 1 slight problem.

The items are not being displayed, so I must be doing something wrong with the OnDrawItem procedure. I have this:
var
  FullRect: TRect;
begin
with ListBox1.Canvas do
    begin
      Brush.Color := ListBoxColor;
      FillRect(Rect);
      TextOut(Rect.Left + 2, Rect.Top + 2, ListBox1.Items[index]);
end;
with FullRect do
    begin
      Left   := 0;
      Top    := 0;
      Right  := Width;
      Bottom := Height;
    end;
  Listbox1.Canvas.FillRect(FullRect);
end;
0
 
LVL 12

Expert Comment

by:Ivanov_G
ID: 11790856
 There are 2 problems here:

  1) You draw the item and the FullRect, which hides the items.

  2) My suggestion with the FullRect was NOT good, because OnDrawItem is called for all items. And if you draw FullRect for the second item, it Hides the first one, which was already drawn.

  Wait few minutes, I am trying something...
0
 
LVL 12

Expert Comment

by:Ivanov_G
ID: 11790872
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Button1: TButton;
    Edit1: TEdit;
    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure ListBox1Enter(Sender: TObject);
    procedure ListBox1Exit(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    ListBoxColor  : TColor;
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
begin
  with ListBox1.Canvas do
    begin
      Brush.Color := ListBoxColor;
      FillRect(Rect);
      Font.Color := clBlack;
      TextOut(Rect.Left + 2, Rect.Top + 2, ListBox1.Items[index]);
    end;
end;

procedure TForm1.ListBox1Enter(Sender: TObject);
begin
  ListBoxColor := clRed;
  ListBox1.Refresh;
end;

procedure TForm1.ListBox1Exit(Sender: TObject);
begin
  ListBoxColor := clWhite;
  ListBox1.Refresh;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ListBox1.Style := lbOwnerDrawFixed;
end;

end.
0
 

Author Comment

by:ChrisLM
ID: 11791375
Appreciate your help mate.

Your example paints the items properly, but doesn't paint the rest of the listbox?

Thanks.
0
 
LVL 12

Expert Comment

by:Ivanov_G
ID: 11791447
Yes, I notices that problem. But the ONLY solution I found here is to set the ListBox height in a proper way - to display exact number of items and you will not have additional space.

I couldn't solve this problems, because as I told you in problem 2) - if you draw the background for item 2 - you will erase item 1...
0
 

Author Comment

by:ChrisLM
ID: 11791714
Thanks for the help buddy.

I don't know what to do know since the question wasn't answered.
I would still like to give you a few points for your troubles though and then close the question.

Any ideas on how to give you some points??
0
 
LVL 12

Expert Comment

by:Ivanov_G
ID: 11791775
You can if you open a new question "Points for Ivanov_G" and refer to this question.

But this is not the case here. The problems comes to be solved. But sometimes, due to some limitation we can not proceed in the way we won't, so we have to think for another alternative.
0
 

Author Comment

by:ChrisLM
ID: 11791808
"due to some limitation we can not proceed in the way we won't, so we have to think for another alternative."

Are you saying to leave it open to wait for a solution or due to limitations this problem cannot be solved?
0
 
LVL 12

Expert Comment

by:Ivanov_G
ID: 11791817
No, I don't say it can not be solved. Each problem have its solution.

But now because of not so good written VCL there is a bug. And we are trying to override it. I've done the same this you want, but with TEdit-s and there is works file. This is what I mean.
0
 

Author Comment

by:ChrisLM
ID: 11791969
ok thanks.
I posted a comment "Points for Ivanov_G" for some points to you.

I will leave the solution open for a few days to see if anyone else can come up with something.

Thanks.
0
 
LVL 3

Accepted Solution

by:
Tyrsis earned 2000 total points
ID: 11797474
This method worked for me, give it a try:

unit Unit1;

interface

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

type
    TForm1 = class(TForm)
        Button1: TButton;
        Edit1: TEdit;
        ListBox1: TListBox;
        procedure ListBox1Enter(Sender: TObject);
        procedure ListBox1Exit(Sender: TObject);
        procedure Button1Click(Sender: TObject);
    private
    public

    end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ListBox1Enter(Sender: TObject);
var
    Rect : TRect;
begin
    ListBox1.Color := clRed;

    Rect := ListBox1.ClientRect;
    ListBox1.Canvas.Brush.Color := ListBox1.Color;
    ListBox1.Canvas.FillRect(Rect);

    ListBox1.Invalidate;
end;

procedure TForm1.ListBox1Exit(Sender: TObject);
var
    Rect : TRect;
begin
    ListBox1.Color := clWhite;

    Rect := ListBox1.ClientRect;
    ListBox1.Canvas.Brush.Color := ListBox1.Color;
    ListBox1.Canvas.FillRect(Rect);

    ListBox1.Invalidate;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
    ListBox1.Items.Add(Edit1.Text);
end;

end.
0
 
LVL 3

Expert Comment

by:Tyrsis
ID: 11797481
Also, note to the above code sample.  You don't need to set ownerdraw or anything.  Just use lbStandard.  

Tyrsis
0
 

Author Comment

by:ChrisLM
ID: 11797943
Thanks Tyrsis.

That was exactly what I needed and worked perfectly. Points are yours.

Chris.
0

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
In this video you will find out how to export Office 365 mailboxes using the built in eDiscovery tool. Bear in mind that although this method might be useful in some cases, using PST files as Office 365 backup is troublesome in a long run (more on t…
In response to a need for security and privacy, and to continue fostering an environment members can turn to for support, solutions, and education, Experts Exchange has created anonymous question capabilities. This new feature is available to our Pr…
Suggested Courses

609 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