比较变态的问题--如何替换类的某个方法吗?

Question

Form1上有个Button1, 我想在运行时. 把Button1.Click替换成Form1.DoButtonClick方法.  public
    constructor Create(AOwner: TComponent); override;
    procedure Click; override; 
    function UseRightToLeftAlignment: Boolean; override;
  published解决的给全分,如果解决不了,就当散分了.

Answer 1

參考FixVCL，我之前有玩過一個替代的

Answer 2

rzDBNumericEdit原先不會觸發Field ongettext，以下demo使得可以觸發....unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Mask, RzDBEdit, db, RzEdit, Grids, DBGrids, ADODB;type
  TJumpOfs = Integer;
  PPointer = ^Pointer;  PXRedirCode = ^TXRedirCode;
  TXRedirCode = packed record
    Jump: Byte;
    Offset: TJumpOfs;
  end;  PWin9xDebugThunk = ^TWin9xDebugThunk;
  TWin9xDebugThunk = packed record
    PUSH: Byte;
    Addr: Pointer;
    JMP: TXRedirCode;
  end;  PAbsoluteIndirectJmp = ^TAbsoluteIndirectJmp;
  TAbsoluteIndirectJmp = packed record
    OpCode: Word;   //$FF25(Jmp, FF /4)
    Addr: PPointer;
  end;  TMyNumericEdit = class(TRzDBNumericEdit)  public
    procedure NewDataChanged;
  end;  TForm1 = class(TForm)
    ADOConnection1: TADOConnection;
    ADOTable1: TADOTable;
    DBGrid1: TDBGrid;
    DataSource1: TDataSource;
    RzDBNumericEdit1: TRzDBNumericEdit;
    ADOTable1BS01001: TStringField;
    ADOTable1BS01002: TStringField;
    ADOTable1BS01003: TStringField;
    ADOTable1BS01035: TFloatField;
    ADOTable1BS01036: TIntegerField;
    ADOTable1BS01037: TIntegerField;
    ADOTable1BS01038: TIntegerField;
    ADOTable1BS01995: TAutoIncField;
    ADOTable1BS01996: TStringField;
    ADOTable1BS01997: TStringField;
    ADOTable1BS01998: TDateTimeField;
    ADOTable1BS01999: TDateTimeField;
    ADOTable1BS01063: TStringField;
    ADOTable1BS01064: TStringField;
    ADOTable1BS01065: TStringField;
    ADOTable1BS01066: TStringField;
    ADOTable1BS01067: TStringField;
    ADOTable1BS01068: TStringField;
    ADOTable1BS01069: TIntegerField;
    ADOTable1BS01070: TIntegerField;
    procedure ADOTable1BS01037GetText(Sender: TField; var Text: String;
      DisplayText: Boolean);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;
  BackupDataChanged : TXRedirCode;
implementation{$R *.dfm}
function GetActualAddr(Proc: Pointer): Pointer;  function IsWin9xDebugThunk(AAddr: Pointer): Boolean;
  begin
    Result := (AAddr <> nil) and
              (PWin9xDebugThunk(AAddr).PUSH = $68) and
              (PWin9xDebugThunk(AAddr).JMP.Jump = $E9);
  end;begin
  if Proc <> nil then
  begin
    if (Win32Platform <> VER_PLATFORM_WIN32_NT) and IsWin9xDebugThunk(Proc) then
      Proc := PWin9xDebugThunk(Proc).Addr;
    if (PAbsoluteIndirectJmp(Proc).OpCode = $25FF) then
      Result := PAbsoluteIndirectJmp(Proc).Addr^
    else
      Result := Proc;
  end
  else
    Result := nil;
end;procedure HookProc(Proc, Dest: Pointer; var BackupCode: TXRedirCode);
var
  n: DWORD;
  Code: TXRedirCode;
begin
  Proc := GetActualAddr(Proc);
  Assert(Proc <> nil);
  if ReadProcessMemory(GetCurrentProcess, Proc, @BackupCode, SizeOf(BackupCode), n) then
  begin
    Code.Jump := $E9;
    Code.Offset := PAnsiChar(Dest) - PAnsiChar(Proc) - SizeOf(Code);
    WriteProcessMemory(GetCurrentProcess, Proc, @Code, SizeOf(Code), n);
  end;
end;procedure UnhookProc(Proc: Pointer; var BackupCode: TXRedirCode);
var
  n: Cardinal;
begin
  if (BackupCode.Jump <> 0) and (Proc <> nil) then
  begin
    Proc := GetActualAddr(Proc);
    Assert(Proc <> nil);
    WriteProcessMemory(GetCurrentProcess, Proc, @BackupCode, SizeOf(BackupCode), n);
    BackupCode.Jump := 0;
  end;
end;
{ TMyNumericEdit }procedure TMyNumericEdit.NewDataChanged;begin
  if Field <> nil then
  begin
    if AllowBlank and Field.IsNull then
      Text := ''
    else
    begin
      Value := strtofloat(DataLink.Field.Text);
      Text := FormatText( Value );
    end;
  end
  else
  begin
    if csDesigning in ComponentState then
      EditText := Name
    else
      EditText := '';
  end;
end;procedure TForm1.ADOTable1BS01037GetText(Sender: TField; var Text: String;
  DisplayText: Boolean);
begin
  ShowMessage(Text);
end;procedure TForm1.FormCreate(Sender: TObject);
begin
  ADOTable1.Active := True;
end;initialization
  HookProc(@TMyNumericEdit.DataChanged, @TMyNumericEdit.NewDataChanged, BackupDataChanged);
finalization
  UnhookProc(@TMyNumericEdit.DataChanged, BackupDataChanged);
end.

Answer 3

直接在form寫個WM_COMMAND消息方法, 所有在form.button click都可攔截到。這個方法有個弊端是，對于button的父窗口不是form 本身的，form不會收到此消息。此消息只會給父窗口。

Answer 4

谢谢各位! 我先研究一上三楼的代码.我的本意是这样;var
  P: Pointer;
begin
  P := Button1.Click;
  //调用之前我要处理些东西. DoSomething中再调用P.
  Button1.Click := Form1.DoSomething;  //这步有些麻烦.
end;

Answer 5

可能是举例不好.
应该是像TButton的protected
    procedure CreateWnd; override;和消息/事件没关系的一个方法.

Answer 6

那我前面的建議，應該還是蠻適合他的需求。
用消息只能一一處理需要改的button click

Answer 7

其实我认为这样这样替换挺容易出问题。新版本DELPHI的Class Helper好像可以从外部修改类的方法，查查资料。

Answer 8

參考FixVCL，我之前有玩過一個替代的

Answer 9

Mark
顶！ 
 

Answer 10

呵呵，要是我.
我换可以 来个TMyButton继承TButton，然后你先做了你的处理，在做父类的。

Answer 11

也许我没理解对，在formcreate时，
Button1.OnClick:=DoButtonClick;

Answer 12

SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS

Answer 13

用钩子。试试这个：HookDLL
library HookDLL;uses
  SysUtils, Windows, Messages, Classes;var
  oldhook: HHook;procedure FillData(Dialog: hwnd; pt: TPoint);
var
  dc, hdc: hwnd;
  buffer: array[0..255] of char;
begin
  GetClassName(Dialog, buffer, 20);
  if (buffer = 'TBitBtn') then
  begin
    hdc := WindowFromPoint(pt);
    GetWindowText(hdc, buffer, 20);
    if buffer = 'OK' then
    begin
      dc := GetWindow(GetParent(hdc), GW_CHILD);
      hdc := GetWindow(dc, GW_HWNDFIRST);
      while (hdc <> 0) do
      begin        //此处自已完善下
        MessageBox(Dialog, pchar('单击刷新按钮：执行自定义过程！'), '提示', MB_ICONINFORMATION);        GetClassName(hdc, buffer, 255);
        if strpas(buffer) = 'TEdit' then
          SendMessage(hdc, WM_SETTEXT, 0, integer(pchar(timetostr(now))));
        hdc := GetWindow(hdc, GW_HWNDNEXT);
      end;
    end;
  end;
end;function MouseHookProc(nCode: integer; wParam: wParam; LParam: LParam): LRESULT; stdcall;
begin
  Result := 0;
  if (nCode = HC_ACTION) and (wParam = WM_LBUTTONDOWN) then
    FillData(PMouseHookStruct(LParam).hwnd, PMouseHookStruct(LParam).pt);
  Result := CallNextHookEx(oldhook, nCode, wParam, LParam);
end;procedure HookOn();
begin
  oldhook := SetWindowsHookEx(WH_MOUSE, @MouseHookProc, HInstance, 0);
end;procedure HookOff();
begin
  UnHookWindowsHookEx(oldhook);
end;exports HookOn, HookOff;begin
end.调用：
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    ...{ Private declarations }
  public
    ...{ Public declarations }
  end;procedure HookOn(); external 'HookDLL.dll';
procedure HookOff(); external 'HookDLL.dll';var
  Form1: TForm1;implementation...{$R *.dfm}procedure TForm1.FormCreate(Sender: TObject);
begin
  HookOn();
end;procedure TForm1.FormDestroy(Sender: TObject);
begin
  HookOff();
end;end.

Answer 14

LZ要想在运行时狸猫换太子，似乎只能HOOK了。

Answer 15

看你的标题,我想到了同事提过JAVA好像可以,好像叫返射什么的
看你的帖子,还不算是在运行时改变类的方法.应该是改变窗体消息的响应函数.
 那么你可以看下"子类化",百度百科里有.SetWindowLong
子类化可以运行时改变窗口的消息响应方法,以后还可以设置回来.
当然,钩子也是可以做到的

Answer 16

public partial class Form3 : Form
    {
        string strxslogo;
        public Form3(string s_xsid)
        {
            InitializeComponent();
            strxslogo = s_xsid;
        }        private void Form3_Load(object sender, EventArgs e)
        {
            this.CenterToScreen();
         
            if (strxslogo == "")
            {
                NewAdd();
            }
            else
            {
                ShowInfo();
                
                this.btnOk.Text = "修改";
                
                tbSname.Focus();
            }        }       private void NewAdd()
        {
            this.tbSno.Text = getxsid();
            this.tbSname.Clear();
            this.tbSage.Clear();
           
            this.btnOk.Text = "保存";
            //i_State = 0;
        } private void btnOk_Click(object sender, EventArgs e)
        {
            if (this.btnOk.Text == "保存")
            {
     ........        
            }
             else
           {
...........
             }这样一个按钮就可以实现两个甚至更多的不同的操作。

Answer 17

运行期，可随时执行Button1.OnClick:=DoButtonClick;使方法替换掉。

Answer 18

不行吗？type
  TNewClick=procedure of object;
type
  TNewBtn=Class(TButton)
  private
    FNewClick:TNewClick;
    procedure SetNewClick(const Value: TNewClick);
  public
    Procedure Click;Override;
    property NewClick:TNewClick Read FNewClick Write SetNewClick;
  end;
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    procedure DoButtonClick;
    { Public declarations }
  end;
var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.FormCreate(Sender: TObject);
var
  TemBtn:TNewBtn;
begin
  TemBtn:=TNewBtn.Create(Self);
  TemBtn.NewClick:=DoButtonClick;
  TemBtn.Parent:=self;
end;{ TNewBtn }procedure TNewBtn.Click;
begin
  if assigned(FNewClick) then FNewClick;
end;
procedure TForm1.DoButtonClick;
begin
  showmessage('adsfadsf');
end;procedure TNewBtn.SetNewClick(const Value: TNewClick);
begin
  FNewClick:=Value;
end;

Answer 19

晕，无意中来到delphi，以为是.net~~~

Answer 20

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;type
  CallEvent = procedure(Sender: TObject) of object;  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure DoButtonClick(Sender: TObject);
  private
    FCallEvent: CallEvent;
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.Button1Click(Sender: TObject);
begin
   Memo1.Lines.Add('Call Button1Click . . .'+TButton(Sender).Caption);
end;procedure TForm1.Button2Click(Sender: TObject);
begin
  if not Assigned(FCallEvent) then
  begin
    FCallEvent := Button1Click;
    Button1.OnClick := DoButtonClick;
  end;
end;procedure TForm1.DoButtonClick(Sender: TObject);
begin
  Memo1.Lines.Add('Call DoButtonClick . . .'+TButton(Sender).Caption);
  if Assigned(FCallEvent) then
     FCallEvent(Sender);
end;end.

Answer 21

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;type
  CallEvent = procedure(Sender: TObject) of object;  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure DoButtonClick(Sender: TObject);
  private
    FCallEvent: CallEvent;
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.Button1Click(Sender: TObject);
begin
   Memo1.Lines.Add('Call Button1Click . . .'+TButton(Sender).Caption);
end;procedure TForm1.Button2Click(Sender: TObject);
begin
  if not Assigned(FCallEvent) then
  begin
    FCallEvent := Button1Click;
    Button1.OnClick := DoButtonClick;
  end;
end;procedure TForm1.Button3Click(Sender: TObject);
begin
  if Assigned(FCallEvent) then
  begin
    Button1.OnClick := Button1Click;;
    FCallEvent := nil;
  end;
end;procedure TForm1.DoButtonClick(Sender: TObject);
begin
  Memo1.Lines.Add(#13#10'Call DoButtonClick . . .'+TButton(Sender).Caption);
  if Assigned(FCallEvent) then
     FCallEvent(Sender);
end;end.

Answer 22

用函数指针...
不过DoButtonClick 这个将要指向的函数必须存在...否则.也许会当当机啥的...

Answer 23

好多朋友　后面　的朋友没有看清问题．只有
# Avan_Lau
# (OnlyYou) 
给出相应的解决办法．
过几天结贴．

Answer 24

YOU  DIAN MA  FAN

Answer 25

Button1.Click := Form1.DoSomething; //这步有些麻烦.
改为Button1.OnClick := Form1.DoSomething; //这步有些麻烦.
DoSomething 定义: procedure DoSomething(Sender: TObject);

Answer 26

怎么搞的这么复杂？惯性思维在作怪？Button1.Click := Form1.DoButtonClick;不就完了么，有楼上的兄弟们想的那么复杂嘛，还勾子消息什么的。

Answer 27

真是不懂你的意思 我的那段代码 已经把button的click事件，重写并且重新定义函数指针，在创建时指向方法，这样实现不了你要的？

Answer 28

LZ是想使用原來的類，但要想替換這個類原先的方法。Tbutton只是一個例子。

Answer 29

或者這么說，原先類的做法，不去改動，只是在運行期、特定的程序里，去替換原先的方法。這個適用于特定場合。
比如你想對原先的程序中的button.click的行為先有一個統一的動作，如果程序很大，透過新的類或者重新給onclick會是很大的工作量。
倘若替換他的方法，只這一步，創建出來的buttton就具有此類動作，不必那么費勁。還有，比如說，vcl中存在bug，這時我們又沒源碼可修正編譯，怎么辦？ 這個方法就派上用場了。

Answer 30

  TDBGridInplaceEdit = class(TInplaceEditList)
  private
    FDataList: TDBLookupListBox;
    FUseDataList: Boolean;
    FLookupSource: TDatasource;
  protected
    procedure CloseUp(Accept: Boolean); override;
    procedure DoEditButtonClick; override;
    procedure DropDown; override;   //!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!11
    procedure UpdateContents; override;
  public
    constructor Create(Owner: TComponent); override;
    property  DataList: TDBLookupListBox read FDataList;
  end;DBComboBox有ondropdown事件.
而TDBGridInplaceEdit的dropdown方法是受保护的.而且是override的.
我是想动态替换了这个方法. 进行相关初始化工作.
p := TDBGridInplaceEdit.DropDown;
TDBGridInplaceEdit.DropDown := MyDropDown;
MyDropDown方法中
初始化一些代码;
再 call P;

Answer 31

你说的似乎就是我说的ClassHelper的用法http://www.cnblogs.com/del/archive/2009/10/13/1582789.html或者干脆自己继承控件OVERRIDE下该方法吧

Answer 32

没有仔细研究过Delphi,关注一下

Answer 33

看了半天
总算看到有人提示这是  Delphi

Answer 34

Delphi 2007的话，有类补丁！非私有方法可以随意修改！

Answer 35

换个思路，用个全局变量标识，在点button1时，先判断变量，处理完你的动作后，改变变量值，根据变量不同决定是否调用DoButtonClick。