DX: TMethod

From

Leonid Troyanovsky (2:5020/175.2)

To

Vlad Kiselev ()

Date

2002-04-05T08:43:20Z

Area

RU.DELPHI

From: "Leonid Troyanovsky" <lv.t@eco-pro.ru>

Приветствую, Vlad.

Fri Apr 05 2002 01:22, Vlad Kiselev wrote to All:

 > Каким образом нужно заполнять эту структуру для передачи в процедуру
 > SetMethodProp ?

uses
  TypInfo;

function ObjPropInfo(AObject: TObject; const PropName: String): PPropInfo;
begin
  Result := GetPropInfo(AObject.ClassInfo, PropName);
  if Result = nil then
    raise Exception.Create('Property not exist');
end;

procedure SetOrdProperty( AObject: TObject; const PropName:String;
                          const Value: Longint);
begin
  SetOrdProp(AObject, ObjPropInfo(AObject, PropName), Value);
end;

procedure SetStrProperty( AObject: TObject; const PropName:String;
                          const Value: String);
begin
  SetStrProp(AObject, ObjPropInfo(AObject, PropName), Value);
end;

procedure SetFloatProperty( AObject: TObject; const PropName:String;
                            const Value: Extended);
begin
  SetFloatProp(AObject, ObjPropInfo(AObject, PropName), Value);
end;

procedure SetVariantProperty( AObject: TObject; const PropName:String;
                              const Value: Variant);
begin
  SetVariantProp(AObject, ObjPropInfo(AObject, PropName), Value);
end;

procedure SetMethodProperty( AObject: TObject; const PropName:String;
                             const Value: Pointer);
var
  AMethod: TMethod;
begin
  AMethod.Code := Value;
  AMethod.Data := AObject;
  SetMethodProp(AObject, ObjPropInfo(AObject, PropName), AMethod);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  AFont: TFont;
begin
  SetOrdProperty(Button1, 'Width', 100);

  AFont := TFont.Create;
  AFont.Style := [fsBold];
  SetOrdProperty(Button1, 'Font', Longint(AFont));
  AFont.Free;

  SetMethodProperty(Button1, 'OnClick', @TForm1.Button2Click);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  ShowMessage((Sender as TButton).Caption);
end;

С уважением,   LVT

--- ifmail v.2.15
 * Origin: FidoNet Online - http://www.fido-online.com (2:5020/175.2)