Solved

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

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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
PDF library for Delphi 2 105
Best Firemonkey component pack 1 87
Adoquery sql  left join does not work 25 80
How to load 2 images in same column in Delphi 2 33
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
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…
This Micro Tutorial will teach you how to censor certain areas of your screen. The example in this video will show a little boy's face being blurred. This will be demonstrated using Adobe Premiere Pro CS6.
Hi friends,  in this video  I'll show you how new windows 10 user can learn the using of windows 10. Thank you.

910 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

23 Experts available now in Live!

Get 1:1 Help Now