تبليغاتX
دلفی باز - نكات ريز و درشت در دلفي
دلفی_مهندسی عمران
چگونه تمامي رويدادهاي يك شيء را در زمان اجرا به Nil تنظيم ‌كنيم؟

در اين مقاله روشي را جهت اينكه تمامي رويدادهاي يك شيء تعريف شده در دلفي را در زمان اجرا به Nil تنظيم كنيد براي شما بازگو مي‌كنيم. شما مي‌توانيد از RTTIها جهت رسيدن به اهداف خود استفاده كنيد اما فقط براي زمان طراحي و اجرا و اين امكان براي رويدادها وجود ندارد. استفاده از RTTI، تا حدودي پيچيده است بنابراين من رويه‌اي را براي نسبت دادن Nil به يك شيء موجود در زمان اجراي يك برنامه در دلفي آورده‌ام كه نحوه انجام اين كار را به شما نشان مي‌دهد.

unit uNilEvent;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{Private declarations}
public
{Public declarations}
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

uses
Typlnfo;

procedure NilEvents(lnstance: TObject);
var
Typelnfo: PTypelnfo;
I, Count: Integer;
PropList: PPropList;
Proplnfo: PProplnfo;
Method: TMethod;
begin
Typelnfo := Instance.Classlnfo;
Method.Code := nil;
Method.Data := nil;
Count := GetPropList(Typelnfo, [tkMethod], nil);
GetMem(PropList, Count * SizeOf(Pointer));
try
GetPropList(Typelnfo, [tkMethod], PropList);
for I := 0 to Count -1 do
begin
Proplnfo := PropList^[I];
SetMethodProp(lnstance, Proplnfo, Method);
end;
finally
FreeMem(PropList);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
const
sText = 'The 2nd time you click Button1 the event will not fire';
begin
NilEvents(Button1);
ShowMessage(sText);
end;

end.

چگونه رويداد مربوط به تمامي اجزاء درون برنامه خود را تغيير دهيم؟

گاهي لازم مي‌شود تا ما فراميني را براي يكي از رويدادهاي برنامه خود به تمامي اشياء استفاده شده در برنامه نسبت دهيم اينكار مي‌تواند با استفاده از RTTI دلفي صورت گيرد شما مثالي را مي‌بينيد كه اين كار را شبيه‌سازي كرده است.

uses
Typlnfo;

procedure TFrmRTTIOnChange.Button1Click(Sender: TObject);
var
proplnfo: PProplnfo;
thisEvent: TNotifyEvent;
begin
proplnfo := GetProplnfo(Memo1.Classlnfo, 'OnChange');
if proplnfo <> nil then
begin
thisEvent := Memo1AltChange;
SetOrdProp(Memo1, Proplnfo, integer(@thisEvent));
end;
end;

procedure TFrmRTTIOnChange.Memo1Change(Sender: TObject);
begin
Caption := 'Normal On Change';
end;

procedure TFrmRTTIOnChange.Memo1AltChange(Sender: TObject);
begin
Caption := 'Alternate On Change';
end;
+ نوشته شده در  چهارشنبه دوم فروردین 1385ساعت 2:27  توسط حمید رادان  |