Solved

Change the color of a TDBEdit when its focused also using XP-Manifest component

Posted on 2006-07-14
3
435 Views
Last Modified: 2010-04-05
Hi,

I want to write a custom component to that is dervied from a TDBEdit so that the color of the TDBEdit changes when it receives focus.
So far I have this:
--------------------------------------------------------------------------------------------
type
  TColorDBEdit = class(TDBEdit)
  private
    FFocusOnColor: TColor;
    FFocusOffColor: TColor;
    procedure SetFocusOnColor(Value: TColor);
    procedure SetFocusOffColor(Value: TColor);
    { Private declarations }
  protected
    { Protected declarations }
     procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
     procedure CMExit(var Message: TCMExit); message CM_EXIT;
  public
    { Public declarations }
  published
    { Published declarations }
    property FocusOnColor:TColor read FFocusOnColor write SetFocusOnColor;
    property FocusOffColor:TColor read FFocusOffColor write SetFocusOffColor;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Standard', [TColorDBEdit]);
end;

{ TCMEdit }

procedure TColorDBEdit.CMEnter(var Message: TCMEnter);
begin
  inherited;

  Self.Color := FFocusOnColor;
  Self.Invalidate;
end;

procedure TColorDBEdit.CMExit(var Message: TCMExit);
begin
  inherited;

  Self.Color := FFocusOffColor;
  Self.Invalidate;
end;

procedure TColorDBEdit.SetFocusOnColor(Value: TColor);
begin
 if (FFocusOnColor <> Value) then
    FFocusOnColor := Value;
end;

procedure TColorDBEdit.SetFocusOffColor(Value: TColor);
begin
  if (FocusOffColor <> Value) then
    FFocusOffColor := Value;
end;

end.
--------------------------------------------------------------------------------------------

This code almost works, but for some reason there is a white border inside the blue (XP) border.
The white border doesn't change color until you move the mouse outside the TDBEdit.

The same thing occurs when the control looses focus. A colored border is left until you move outside the control and it returns back to white.

Is there something that I have missed with painting the control?



I'm using Delphi 7 Pro, with an XP-Manifest component on the form.

Regards,
Chris
0
Comment
Question by:ChrisLM
  • 2
3 Comments
 

Author Comment

by:ChrisLM
ID: 17126436
Is there no solution to this problem?

Regards,
Chris
0
 
LVL 26

Accepted Solution

by:
Russell Libby earned 500 total points
ID: 17138768
Chris, try the following component code. I was able to get it to work correctly with themeing enabled for the project, both with keyboard set/lose focus, mouse set/lose focus, SetFocus calls, regardless of mouse being over the edit or not. Hopefully you will get the same results

Regards,
Russell

---

unit ColorDBEdit;

interface

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

type
  TColorDBEdit      =  class(TDBEdit)
  private
     // Private declarations
     FFocusOnColor: TColor;
     FFocusOffColor:TColor;
     procedure      SetFocusOnColor(Value: TColor);
     procedure      SetFocusOffColor(Value: TColor);
  protected
     // Protected declarations
     procedure      WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
     procedure      WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
     procedure      WMPaint(var Message: TWMPaint); message WM_PAINT;
  public
     // Public declarations
     constructor    Create(AOwner: TComponent); override;
  published
     // Published declarations
     property       FocusOnColor: TColor read FFocusOnColor write SetFocusOnColor;
     property       FocusOffColor: TColor read FFocusOffColor write SetFocusOffColor;
  end;

procedure Register;

implementation

procedure TColorDBEdit.WMSetFocus(var Message: TWMSetFocus);
begin
  Color:=FFocusOnColor;
  InvalidateRect(Handle, nil, True);
  inherited;
end;

procedure TColorDBEdit.WMKillFocus(var Message: TWMKillFocus);
begin
  Color:=FFocusOffColor;
  InvalidateRect(Handle, nil, True);
  inherited;
end;

procedure TColorDBEdit.WMPaint(var Message: TWMPaint);
var  DC:         HDC;
begin
  inherited;
  DC:=GetWindowDC(Handle);
  try
     SetBKColor(DC, Color);
     FrameRect(DC, Rect(1, 1, Pred(Width), Pred(Height)), CreateSolidBrush(ColorToRGB(Color)));
  finally
     ReleaseDC(Handle, DC);
  end;
end;

procedure TColorDBEdit.SetFocusOnColor(Value: TColor);
begin
  if (FFocusOnColor <> Value) then FFocusOnColor:=Value;
end;

procedure TColorDBEdit.SetFocusOffColor(Value: TColor);
begin
  if (FocusOffColor <> Value) then FFocusOffColor := Value;
end;

constructor TColorDBEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  DoubleBuffered:=True;
  FFocusOnColor:=clYellow;
  FFocusOffColor:=clWindow;
end;

procedure Register;
begin
  RegisterComponents('Standard', [TColorDBEdit]);
end;

end.

0
 

Author Comment

by:ChrisLM
ID: 17152009
Russell,

Thank you very much. Greatly appreciated.
Works exactly how I wanted.

Regards,
Chris
0

Featured Post

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
This video discusses moving either the default database or any database to a new volume.
Illustrator's Shape Builder tool will let you combine shapes visually and interactively. This video shows the Mac version, but the tool works the same way in Windows. To follow along with this video, you can draw your own shapes or download the file…

758 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

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now