procedure TForm1.MyClick(Sender: TObject); begin ......... end;procedure TForm1.FormCreate(Sender: TObject); begin Button1.OnClick := MyClick; end;
下例是为dbgrid增加鼠标滚轮的事件代码(转贴)://///////////// unit WJDBGrid; //增加了3个功能 //1:鼠标滚轮相应;如果定义了ONCELLCLICK事件,那么在滚动时,自动调用此事件 //2:初始化时将READONLY赋为TRUE; //3:如果DATASET为TCUSTOMADODATASET,则在单击行标题时,进行排序; interfaceuses SysUtils, Classes, Controls, Grids, DBGrids, AdoDB;type TWJDBGrid = class(TDBGrid) private { Private declarations } protected { Protected declarations } procedure CMMouseWheel(var Message: TCMMouseWheel); message CM_MOUSEWHEEL; public { Public declarations } constructor Create(AOwner: TComponent); override; procedure TitleClick(Column:TColumn); published { Published declarations } //property OnMouseWheel; end;procedure Register;implementationprocedure Register; begin RegisterComponents('Data Controls', [TWJDBGrid]); end;{ TWJDBGrid }procedure TWJDBGrid.CMMouseWheel(var Message: TCMMouseWheel); begin if Enabled then if Assigned(DataSource) and Assigned(DataSource.DataSet) and DataSource.DataSet.Active and (DataSource.DataSet.RecordCount>0) then begin if Message.WheelDelta<0 then DataSource.DataSet.Next; if Message.WheelDelta>0 then DataSource.DataSet.prior; if Assigned(OnCellClick) then OnCellClick(nil); message.Result:=1; //这里要关闭 Inherited,否则会有上面所提及的问题 end else begin Inherited; end; end;constructor TWJDBGrid.Create(AOwner: TComponent); begin inherited; Readonly:=true; OnTitleClick:=TitleClick; end;procedure TWJDBGrid.TitleClick(Column: TColumn); var i:integer; tem:string; begin if Enabled then if Assigned(DataSource) and Assigned(DataSource.DataSet) and DataSource.DataSet.Active and (DataSource.DataSet.RecordCount>0) then begin if DataSource.DataSet is TCustomAdoDataSet then with DataSource.DataSet as TCustomAdoDataSet do begin tem:=Column.FieldName; if Sort='' then Sort:=tem+' ASC' else if Sort=tem+' ASC' then Sort:=tem+' DESC' else Sort:=tem+' ASC'; end; end; end;end.
type TMyEvent=procedure(Sender:TObject;其他参数) of ObjectFMyEvent:TMyEvent; property MyEvent:TMyEvent read FMyEvent write FMyEvent; if Assigned(FMyEvent) then FMyEvent(Self,参数)
begin
.........
end;procedure TForm1.FormCreate(Sender: TObject);
begin
Button1.OnClick := MyClick;
end;
unit WJDBGrid;
//增加了3个功能
//1:鼠标滚轮相应;如果定义了ONCELLCLICK事件,那么在滚动时,自动调用此事件
//2:初始化时将READONLY赋为TRUE;
//3:如果DATASET为TCUSTOMADODATASET,则在单击行标题时,进行排序;
interfaceuses
SysUtils, Classes, Controls, Grids, DBGrids, AdoDB;type
TWJDBGrid = class(TDBGrid)
private
{ Private declarations }
protected
{ Protected declarations }
procedure CMMouseWheel(var Message: TCMMouseWheel); message CM_MOUSEWHEEL;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
procedure TitleClick(Column:TColumn);
published
{ Published declarations }
//property OnMouseWheel;
end;procedure Register;implementationprocedure Register;
begin
RegisterComponents('Data Controls', [TWJDBGrid]);
end;{ TWJDBGrid }procedure TWJDBGrid.CMMouseWheel(var Message: TCMMouseWheel);
begin
if Enabled then
if Assigned(DataSource) and Assigned(DataSource.DataSet)
and DataSource.DataSet.Active and (DataSource.DataSet.RecordCount>0) then
begin
if Message.WheelDelta<0 then
DataSource.DataSet.Next;
if Message.WheelDelta>0 then
DataSource.DataSet.prior;
if Assigned(OnCellClick) then
OnCellClick(nil);
message.Result:=1;
//这里要关闭 Inherited,否则会有上面所提及的问题
end else
begin
Inherited;
end;
end;constructor TWJDBGrid.Create(AOwner: TComponent);
begin
inherited;
Readonly:=true;
OnTitleClick:=TitleClick;
end;procedure TWJDBGrid.TitleClick(Column: TColumn);
var i:integer;
tem:string;
begin
if Enabled then
if Assigned(DataSource) and Assigned(DataSource.DataSet)
and DataSource.DataSet.Active and (DataSource.DataSet.RecordCount>0) then
begin
if DataSource.DataSet is TCustomAdoDataSet then
with DataSource.DataSet as TCustomAdoDataSet do
begin
tem:=Column.FieldName;
if Sort='' then
Sort:=tem+' ASC'
else if Sort=tem+' ASC' then
Sort:=tem+' DESC'
else Sort:=tem+' ASC';
end;
end;
end;end.
TMyEvent=procedure(Sender:TObject;其他参数) of ObjectFMyEvent:TMyEvent;
property MyEvent:TMyEvent read FMyEvent write FMyEvent;
if Assigned(FMyEvent) then
FMyEvent(Self,参数)
同意