很希望大家把自己做项目中的小技巧共享出来

jwpl190
车五
等级:

发表于：2007-11-27 21:24:3823楼得分:2

我认为自己最能拿出手的东西，
可以做个基类使用，主要功能就是是子类的用户输入控件可以自动变色，
不必考虑种类繁多的第三方控件,
只要是有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.

修改删除举报引用回复

function TForm1.getlist:Tstringlist; begin result:=TStringList.Create; result.Add('1'); result.Add('2'); end; procedure TForm1.Button1Click(Sender: TObject); var str:TStrings; begin // str:=TStringList.Create;内存泄露 str:=getlist; showmessage(str.Text); str.Free; end;