e_cmped.pas

一个关于delphi控件

      ARow:=Row;
      If Key = VK_UP then
      begin
        If (Sender=SetEdit) then With SetEdit do
          If (ItemIndex>0) then
            Exit;
        If Row>0 then
          ARow:=Row-1;
      end
      else If Row<RowCount-1 then
      begin
        If (Sender=SetEdit) then With SetEdit do
          If (ItemIndex>-1) AND (ItemIndex<Items.Count-1) then
            Exit;
        ARow:=Row+1;
      end;
      If ARow<>Row then
      begin
        FixUpOnExit(Sender);
        Row:=ARow;
        Key:=0;
      end;
    end;
  end;
end;
procedure TCompEditForm.StringGrid1KeyPress(    Sender : TObject;
                                            Var Key    : Char);
begin
  If Key=#13 then
  begin
    If (PropList=Nil) OR (StringGrid1.Col<>1) then
      Exit;
    With StringGrid1 do
      EditProperty(Col,Row);
    Key:=#0;
  end;
end;



{========================    事件程序   ==========================}

{--------------------------------}
{                                }
{       检查控件事件             }
{                                }
{--------------------------------}
function TCompEditForm.Check_Event(instance:Tobject; Event_Name:string):boolean;
var
pkinds:ttypekinds;
propinfo,ptd:ppropinfo;
nprops,i:integer;
plist:pproplist;
method:Tmethod;
begin
 result:=false;
 pkinds:=[tkMethod];
 if instance=nil then exit;
 nprops:=getproplist(instance.classinfo,pkinds,nil);
 if nprops>0 then  begin // 1
   try
    getmem(plist,nprops*sizeof(pointer));
    nprops:=getproplist(instance.classinfo,pkinds,plist);
    if nprops>0 then
       for i:=0 to nprops-1 do begin //3
       propinfo:=plist^[i];
       if propinfo.name=Event_Name then begin //kk
             result:=true;
             exit;
                                       end; //kk
                               end;  //3
                     
      finally
      freemem(plist,nprops*sizeof(pointer));
      end;//try
                   end; // 1
end;

type
  PMethodList = ^AList;
  AList = record
    name:string;
    method: Tmethod;
  end;
var
methodrecord: PMethodList;

function TcompEditForm.saveEvent(instance:Tcomponent;
                          MethodList:Tlist; Event_name:string;Data:pointer):boolean;
var
pkinds:ttypekinds;
//propinfo,ptd:ppropinfo;
nprops,i:integer;
plist:pproplist;
method:Tmethod;
begin

 result:=false;
 pkinds:=[tkMethod];
 nprops:=getproplist(instance.classinfo,pkinds,nil);
 if nprops>0 then
   try
    getmem(plist,nprops*sizeof(pointer));
    nprops:=getproplist(instance.classinfo,pkinds,plist);
    if nprops>0 then
       for i:=0 to nprops-1 do
//       propinfo:=plist^[i];
       if plist^[i].name=Event_name then begin  //123
         new(methodrecord);
         methodrecord^.name:=instance.name;
         methodrecord^.method.Code:=getmethodprop(instance,plist^[i]).code;
         methodrecord^.method.Data:=getmethodprop(instance,plist^[i]).data;
         MethodList.Add(methodrecord);
         method.code:=data;          //??
         method.Data:=self;   //??
         setmethodprop(instance,plist^[i],method );
         result:=true;
         exit;
                                        end;  //123
      finally
      freemem(plist,nprops*sizeof(pointer));
      end;//try

end;


procedure TcompEditForm.SetEvent(instance:Tcomponent;
                              MethodList:Tlist; index:integer ;Event_name:string);
var
pkinds:ttypekinds;
//propinfo:ppropinfo;
nprops,i:integer;
plist:pproplist;
begin

 pkinds:=[tkMethod];
 nprops:=getproplist(instance.classinfo,pkinds,nil);
 if nprops>0 then
   try
    getmem(plist,nprops*sizeof(pointer));
    nprops:=getproplist(instance.classinfo,pkinds,plist);
    if nprops>0 then
       for i:=0 to nprops-1 do
         if plist^[i].name=Event_name then
            setmethodprop(instance,plist^[i],Pmethodlist(MethodList.items[index])^.method );

   finally
   freemem(plist,nprops*sizeof(pointer));
   end;//try

end;


{--------------------------------}
{                                }
{       重置 OnClick 事件        }
{                                }
{--------------------------------}
procedure  TCompEditForm.set_NewOnClick(aform:Tobject;new_onclick:Tnotifyevent);

begin

if Check_Event(aform,'OnClick') then begin
{   new(ponclick);
   ponclick^:=Tform(aform).onclick;
 }   saveEvent(Tcomponent(aform), OClickList, 'OnClick',@new_Onclick);
 {  Tform(aform).onclick:=new_onclick;
   OnClickList.addobject(Tcomponent(aform).name, Tobject(ponclick) );
  }                                    end;
end;

{--------------------------------}
{                                }
{       重置 onmousedown 事件    }
{                                }
{--------------------------------}
procedure  TCompEditForm.set_NewOnmousedown(aform:Tobject;new_down:TMouseEvent);
begin

if Check_Event(aform,'OnMouseDown') then begin
   saveEvent(Tcomponent(aform), OdownList, 'OnMouseDown',@new_down);
{   new(pdown);
   pdown^:=Tform(aform).onmousedown;
   Tform(aform).onmousedown:=new_down;
   downlist.addobject(Tcomponent(aform).name, Tobject(pdown) );
 }                                     end;
end;
{--------------------------------}
{                                }
{  重置 onmousemove 事件         }
{                                }
{--------------------------------}
procedure  TCompEditForm.set_NewOnmousemove(aform:Tobject;new_move:Tmousemoveevent);
begin

if Check_Event(aform,'OnMouseMove') then begin
   saveEvent(Tcomponent(aform), Omovelist, 'OnMouseMove',@new_move);
{   new(pmove);
   pmove^:=Tform(aform).onmousemove;
   Tform(aform).onmousemove:=new_move;
   movelist.addobject(Tcomponent(aform).name, Tobject(pmove) );
 }                                     end;
end;

{--------------------------------}
{                                }
{     重置 OnMousUp 事件         }
{                                }
{--------------------------------}
procedure  TCompEditForm.set_NewOnMouseUp(aform:Tobject;new_up:Tmouseevent);
begin

if Check_Event(aform,'OnMouseUp') then begin
   saveEvent(Tcomponent(aform), Ouplist, 'OnMouseUp',@new_up);
{   new(pup);
   pup^:=Tform(aform).onmouseup;
   Tform(aform).onmouseup:=new_up;
   uplist.addobject(Tcomponent(aform).name, Tobject(pup) );
 }                                      end;
end;


{--------------------------------}
{                                }
{  置窗体内控件事件为新事件      }
{                                }
{--------------------------------}
procedure TCompEditForm.set_new_event(aform: Tform ; new_onclick: TnotifyEvent ;
                                             new_mousedown,new_mouseup: Tmouseevent ;
                                             new_mousemove: Tmousemoveevent  );
var
i:integer;
begin
if ((Onclicklist<>nil)or (downlist<>nil) or
   (uplist<>nil)or( movelist<>nil)) then exit;

  OnClickList:=Tstringlist.create;
  downlist:=Tstringlist.create;
  uplist:=Tstringlist.create;
  movelist:=Tstringlist.create;

  OClickList:=Tlist.create;
  Odownlist:=Tlist.create;
  Ouplist:=Tlist.create;
  Omovelist:=Tlist.create;


// OnClick
     set_NewOnClick(aform,new_onclick);
for i:=0 to aform.componentcount-1 do begin //1
     if aform.components[i]<>nil then
     set_NewOnClick(aform.components[i],new_onclick);
                                      end;  //1

// OnMouseDown
     set_NewOnmousedown(aform,new_mousedown);
for i:=0 to aform.componentcount-1 do begin //2
     if aform.components[i]<>nil then
       set_NewOnmousedown(aform.components[i],new_mousedown);
                                      end;  //2

// OnMouseMove
     set_NewOnmousemove(aform,new_mousemove);
for i:=0 to aform.componentcount-1 do begin //2
     if aform.components[i]<>nil then
     set_NewOnmousemove(aform.components[i],new_mousemove);
                                      end;  //2

// OnMouseup
     set_NewOnmouseup(aform,new_mouseup);
for i:=0 to aform.componentcount-1 do begin //2
     if aform.components[i]<>nil then
     set_NewOnmouseup(aform.components[i],new_mouseup);
                                      end;  //2

end;


{--------------------------------}
{                                }
{           恢复原事件           }
{                                }
{--------------------------------}
procedure TCompEditForm.resert(AForm:TForm);
var
i,m:integer;
begin
try
 if assigned(oclicklist) then
 if (OClicklist.count>0) then begin  //  A
  try
//    AForm.onclick:=pTnotifyevent(OnClickList.objects[0])^;   //窗体 OnClick 恢复
//    for i:=0 to aform.componentcount-1 do
//         for m:=0 to OnClickList.count-1 do
//              if OnClickList.strings[m]=aform.components[i].name then
//                  Tform(aform.components[i]).OnClick:=
//                                    pTnotifyevent(OnClickList.objects[m])^; //构件 OnClick 恢复
   SetEvent(aform,OClickList, 0 ,'OnClick');      //窗体 OnClick 恢复
    for i:=0 to aform.componentcount-1 do
      for m:=0 to OClickList.count-1 do
        if PmethodList(OClickList.Items[m])^.name=aform.components[i].name then
                 SetEvent(aform.components[i],OClickList, m ,'OnClick');

  finally
//   for m:=0 to OnClicklist.count-1 do
//         dispose(pTnotifyevent(OnClickList.Objects[m]));
    for m:=0 to OClicklist.count-1 do
         dispose(OClickList.items[m]);
  end;
                             end; //  A


 if assigned(ODownList) then
 if (ODownList.count>0) then begin  //  B
  try
   SetEvent(aform,ODownList, 0 ,'OnMouseDown');      //窗体 OnClick 恢复
    for i:=0 to aform.componentcount-1 do
      for m:=0 to ODownList.count-1 do
        if PmethodList(ODownList.Items[m])^.name=aform.components[i].name then
                 SetEvent(aform.components[i],ODownList, m ,'OnMouseDown');


{    AForm.OnMouseUp:=pTmouseevent(DownList.objects[0])^;   //窗体 OnDown 恢复
    for i:=0 to aform.componentcount-1 do
         for m:=0 to DownList.count-1 do
              if DownList.strings[m]=aform.components[i].name then
                  Tform(aform.components[i]).OnMouseDown:=
                                    pTMouseevent(DownList.objects[m])^; //构件 OnDown 恢复
}
  finally
//    for m:=0 to ODownList.count-1 do
//         dispose(pTMouseEvent(DownList.Objects[m]));
    for m:=0 to ODownlist.count-1 do
         dispose(ODownList.items[m]);
  end;
                             end; //  B


 if assigned(OMovelist) then
 if (OMoveList.count>0) then begin  //  C
  try
   SetEvent(aform,OMoveList, 0 ,'OnMouseMove');      //窗体 OnClick 恢复
    for i:=0 to aform.componentcount-1 do
      for m:=0 to OMoveList.count-1 do
        if PmethodList(OMoveList.Items[m])^.name=aform.components[i].name then
                 SetEvent(aform.components[i],OMoveList, m ,'OnMouseMove');


{    AForm.OnMouseMove:=pTmousemoveevent(MoveList.objects[0])^;   //窗体 MouseMove 恢复
    for i:=0 to aform.componentcount-1 do
         for m:=0 to MoveList.count-1 do
              if MoveList.strings[m]=aform.components[i].name then
                  Tform(aform.components[i]).OnMouseMove:=
                                    pTMouseMoveevent(MoveList.objects[m])^; //构件 MouseMove 恢复
}
  finally
{    for m:=0 to MoveList.count-1 do
        dispose(pTMouseMoveEvent(MoveList.Objects[m]));
}    for m:=0 to OMovelist.count-1 do
         dispose(OMoveList.items[m]);
  end;
                             end; //  C


 if assigned(OUplist) then
 if (OUpList.count>0) then begin  //  D
  try
   SetEvent(aform,OupList, 0 ,'OnMouseUp');      //窗体 OnClick 恢复
    for i:=0 to aform.componentcount-1 do
      for m:=0 to OUpList.count-1 do
        if PmethodList(OUpList.Items[m])^.name=aform.components[i].name then
                 SetEvent(aform.components[i],OupList, m ,'OnMouseUp');

 {   AForm.OnMouseUp:=pTmouseevent(UpList.objects[0])^;   //窗体 MouseDown 恢复
    for i:=0 to aform.componentcount-1 do
         for m:=0 to UpList.count-1 do
              if UpList.strings[m]=aform.components[i].name then
                  Tform(aform.components[i]).OnMouseUp:=
                                    pTMouseEvent(UpList.objects[m])^; //构件 MouseDown 恢复
}
  finally
{    for m:=0 to UpList.count-1 do
         dispose(pTMouseEvent(UpList.Objects[m]));
}    for m:=0 to Ouplist.count-1 do
         dispose(OupList.items[m]);
  end;
                             end; //  D

finally
 if assigned(onclicklist) then onclicklist.free;
 if assigned(uplist) then uplist.free;
 if assigned(downlist) then downlist.free;
 if assigned(movelist) then  movelist.free;

 if assigned(Oclicklist) then oclicklist.free;
 if assigned(Ouplist) then Ouplist.free;
 if assigned(Odownlist) then Odownlist.free;
 if assigned(Omovelist) then  Omovelist.free;
 Oclicklist:=nil;
 Ouplist:=nil;
 Odownlist:=nil;
 Omovelist:=nil;

 onclicklist:=nil;
 uplist:=nil;
 downlist:=nil;
 movelist:=nil;
end;

end;

{--------------------------------}
{                                }
{       OnClick  新单击事件      }
{                                }
{--------------------------------}
procedure TCompEditForm.new_onClick(Sender: TObject);
var
i:integer;
begin
for i:=0 to componentbox.items.count-1 do
   if  (Pos(Tcontrol(sender).name+':',ComponentBox.items[i])=1) then begin
                                        componentbox.itemindex:=i;
                                        ShowCurrentComponent;
                                                               end;
end;


procedure TCompEditForm.new_MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if posflag then begin
 oldx:=x;
 oldy:=y;
   posflag:=false;end;
if button=mbleft then begin
  Screen.Cursor := crDrag;                  { Always restore to normal }
  downflag:=true;     end;
end;

procedure TCompEditForm.new_MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if downflag then begin
   Tcontrol(sender).top :=Tcontrol(sender).top +y-oldy;
   Tcontrol(sender).left:=Tcontrol(sender).left+x-oldx ;
                 end;
end;

procedure TCompEditForm.new_MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if button=mbleft then begin
 downflag:=false;
 posflag:=true;
 Screen.Cursor := crDefault;                  { Always restore to normal }
  end;
end;




end.