Solved

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

Posted on 2006-07-14
3
449 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
[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
  • 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

Technology Partners: 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

Suggested Solutions

Title # Comments Views Activity
Create Database on Android via Delphi dbExpress 3 143
find a node in VST 2 93
Delphi: sending SMS on android platform 1 106
Can Live bindings change TGrid Cell Colour ? 1 64
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 I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
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…

752 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