如何将重载窗体的事件写成组件，在整个Application中有效？

Question

写了一个重载窗体的事件，功能是获得焦点时改变颜色，失去焦点后还原颜色，想做成一个组件，让所有窗体都有这个功能，或者写成一个公共函数亦可。像ApplicationEvents一样。
function TForm1.SetFocusedControl(Control: TWinControl): Boolean;
begin
  inherited SetFocusedControl(Control);
  if GetPropInfo(Control.ClassInfo, 'Color') <> nil then
  begin
    Control.Invalidate;
    SetPropValue(Control, 'Color', clRed);
  end;  if Assigned(FLastActive) then
  begin
    //Caption := FLastActive.ClassName;
    if GetPropInfo(FLastActive.ClassInfo, 'Color') <> nil then
    begin
      FLastActive.Invalidate;
      SetPropValue(FLastActive, 'Color', clWhite);
    end;
  end;
 FLastActive := ActiveControl;
end;

Answer 1

截获取OnMessage应该可以，但暂时无法实现，查SetFocusedControl，使用了CM_ACTIVE消息，但不知道为什么，只能截一实，以后就没有了

Answer 2

发现使用到CM_ENTER消息，但不知道如何截获，属自定义消息，是否不经过消息队列？

Answer 3

改成
procedure TForm1.ActiveControlChanged(Sender: TObject);
var
  Control: TWinControl;
begin
  //if Control.ClassName <> 'TEdit' then Exit;
  //if not (Sender is TWinControl) then Exit;
  Control := Screen.ActiveControl;
  Control.ClassName;
  Exit;
    if GetPropInfo(Control.ClassInfo, 'Color') <> nil then
    begin
      Control.Invalidate;
      SetPropValue(Control, 'Color', clRed);
    end;
    if Assigned(old) then
    begin
      if GetPropInfo(old.ClassInfo, 'Color') <> nil then
      begin
        old.Invalidate;
        SetPropValue(old, 'Color', clWhite);
      end;
    end;
    old := Control;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
  Screen.OnActiveControlChange:=ActiveControlChanged;
end;但出现读取内存错误，为何？

Answer 4

if Screen.ActiveControl<>nil ........

Answer 5

不好意思，上面得回答无法解决；刚才开了delphi ，加入即可procedure TForm1.FormDestroy(Sender: TObject);
begin
 Screen.OnActiveControlChange:=nil;
end;

Answer 6

帮你修改为一个vcl 组件，可以直接放窗体上实现该功能了：）unit uFocusControl;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, TypInfo; //这里有些没用得unit,你剔吧。type  TFocusControl = class(TComponent)
  private
    old: TWinControl;
    oldColor: TColor; //保存历史颜色
    FColorBackground: TColor; //聚焦颜色，默认red
    procedure SetColorBackground(const Value: TColor);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  protected
    procedure ActiveControlChanged(Sender: TObject);
  published
    property ColorBackground: TColor read FColorBackground write
      SetColorBackground;
  end;procedure Register;implementation{ TFocusTest }procedure Register;
begin
  RegisterComponents('S.F.', [TFocusControl]);
end;procedure TFocusControl.ActiveControlChanged(Sender: TObject);
var
  Control           : TWinControl;
begin  if csDesigning in ComponentState then  //非设计期间
    exit;  if Screen.ActiveControl = nil then //application end
  begin
    Screen.OnActiveControlChange := nil;
    Exit;
  end;  Control := Screen.ActiveControl;
  if GetPropInfo(Control.ClassInfo, 'Color') <> nil then
    oldColor := GetPropValue(Control, 'Color');  if GetPropInfo(Control.ClassInfo, 'Color') <> nil then
  begin
    Control.Invalidate;
    SetPropValue(Control, 'Color', FColorBackground);
  end;
  if Assigned(old) then
  begin
    if GetPropInfo(old.ClassInfo, 'Color') <> nil then
    begin
      old.Invalidate;
      SetPropValue(old, 'Color', oldColor);
    end;
  end;  old := Control;end;constructor TFocusControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FColorBackground := clRed;
  Screen.OnActiveControlChange := ActiveControlChanged;
end;destructor TFocusControl.Destroy;
begin
  if Assigned(Screen.OnActiveControlChange) then
    Screen.OnActiveControlChange := nil;
  inherited;
end;procedure TFocusControl.SetColorBackground(const Value: TColor);
begin
  FColorBackground := Value;
end;end.//可以试试，支持grid,edit,memo,checkbox,list ...

Answer 7

回复:S.F.
我需要的是做一个组件,使用OnClose的方法我也知道,但组件不能占用OnClose的

Answer 8

哈哈,昨天晚上看了书,说使用csDesigning可以解决问题,你就来了,晕呼呼
还没有试,理论上加一个csDesigning就可以解决问题

Answer 9

哈哈，忙了半天，其实只有一点
把Screen.ActiveControl = nil则退出就搞定了