您的位置:首页 > 编程语言 > Delphi

做个基类使用,主要功能是子类的用户输入控件可以自动变色---Delphi

2008-11-13 16:01 453 查看
unit U_BaseForm;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Buttons, Typinfo;

type

TFm_BaseForm = class(TForm)

Edit1: TEdit;

Edit2: TEdit;

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

procedure CmpEnter(Sender: TObject); //用户获得焦点

procedure CmpExit(Sender: TObject); //用户失去焦点

public

{ Public declarations }

protected

procedure pSetComponents;

end;

var

Fm_BaseForm: TFm_BaseForm;

//以后应该是可以设置的。风格管理,可以保存在注册表中

const

ENTERC0LOR = $00CDBDB4;

EXITCOLOR = $00DAF3DD;

implementation

{$R *.dfm}

{ TFm_BaseForm }

procedure TFm_BaseForm.CmpEnter(Sender: TObject);

var

sProp: PPropInfo;

begin

sProp := GetPropInfo(Sender.ClassInfo, 'Color');

if sProp <> nil then

SetOrdProp(Sender, sProp, ENTERC0LOR);

end;

procedure TFm_BaseForm.CmpExit(Sender: TObject);

var

sProp: PPropInfo;

begin

sProp := GetPropInfo(Sender.ClassInfo, 'Color');

if sProp <> nil then

SetOrdProp(Sender, sProp, EXITCOLOR);

end;

procedure TFm_BaseForm.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 TFm_BaseForm.FormCreate(Sender: TObject);

begin

pSetComponents;

end;

end.
内容来自用户分享和网络整理,不保证内容的准确性,如有侵权内容,可联系管理员处理 点击这里给我发消息
标签: 
相关文章推荐