Solved

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

Posted on 2006-07-14
3
443 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

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

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

Suggested Solutions

In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
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…
Microsoft Active Directory, the widely used IT infrastructure, is known for its high risk of credential theft. The best way to test your Active Directory’s vulnerabilities to pass-the-ticket, pass-the-hash, privilege escalation, and malware attacks …
The Email Laundry PDF encryption service allows companies to send confidential encrypted  emails to anybody. The PDF document can also contain attachments that are embedded in the encrypted PDF. The password is randomly generated by The Email Laundr…

789 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