Delphi小技巧

今天偶尔在csdn论坛看到些不错的东西，贴来大家瞧瞧：

－－－－－－－－－－－－－－－－－－－－－－－－－－－

我认为自己最能拿出手的东西，
可以做个基类使用，主要功能就是是子类的用户输入控件可以自动变色，
不必考虑种类繁多的第三方控件,
只要是有Color，OnEnter，OnExit，OnChange属性就行。
unit   Ufrmbase;

interface

uses
    Windows,   Messages,   SysUtils,   Variants,   Classes,   Graphics,   Controls,   Forms,
    Dialogs,   StdCtrls,   Buttons,typinfo;
type
    Tfrmbase   =   class(TForm)
        procedure   FormCreate(Sender:   TObject);
    private
        {   Private   declarations   }
        procedure   CmpEnter(Sender:   TObject);   //用户获得焦点
        procedure   CmpExit(Sender:   TObject);   //用户失去焦点
    public
        {   Public   declarations   }
    protected
        procedure   pSetComponents;
    end;

var
    frmbase:   Tfrmbase;
    //以后应该是可以设置的。风格管理，可以保存在注册表中
const
    ENTERC0LOR   =   $00CDBDB4;
    EXITCOLOR   =   $00DAF3DD;
implementation
{$R   *.dfm}
procedure   Tfrmbase.CmpEnter(Sender:   TObject);
var
    sProp:   PPropInfo;
begin
    sProp   :=   GetPropInfo(Sender.ClassInfo,   'Color');
    if   sProp   <>   nil   then
        SetOrdProp(Sender,   sProp,   ENTERC0LOR);
end;

procedure   Tfrmbase.CmpExit(Sender:   TObject);
var
    sProp:   PPropInfo;
begin
    sProp   :=   GetPropInfo(Sender.ClassInfo,   'Color');
    if   sProp   <>   nil   then
        SetOrdProp(Sender,   sProp,   EXITCOLOR);
end;

procedure   Tfrmbase.pSetComponents;
var
    i:   Integer;
    sColor,   sEnter,   sExit,   sChanged:   PPropInfo;
    vEnter,   vExit:   TMethod;
    mEvent:   TNotifyEvent;
begin
    for   i   :=   0   to   componentcount   -   1   do
    begin
        sColor   :=   GetPropInfo(Components[i].ClassInfo,   'Color');
        sEnter   :=   GetPropInfo(Components[i].ClassInfo,   'OnEnter');
        sExit   :=   GetPropInfo(Components[i].ClassInfo,   'OnExit');
        sChanged   :=   GetPropInfo(Components[i].ClassInfo,   'OnChange');
        if   (sChanged   <>   nil)   and   (sEnter   <>   nil)   and
            (sExit   <>   nil)   and   (sColor   <>   nil)   then
        begin
            SetOrdProp(Components[i],   sColor,   EXITCOLOR);
            mEvent   :=   CmpEnter;
            vEnter.Code   :=   @mEvent;
            vEnter.Data   :=   Self;
            SetMethodProp(Components[i],   sEnter,   vEnter);
            mEvent   :=   CmpExit;
            vExit.Code   :=   @mEvent;
            vExit.Data   :=   Self;
            SetMethodProp(Components[i],   sExit,   vExit);
        end;
    end;

end;

procedure   Tfrmbase.FormCreate(Sender:   TObject);
begin
    pSetComponents;
end;
end. 

该帖子论坛链接地址：

http://topic.csdn.net/u/20071126/11/55c5b4c0-adc4-40c1-9b43-1a5d10e20cf8.html