[Lazarus] How do you set an event at runtime?

[Peter Williams]

Hi Frank,

Date: Tue, 4 Jan 2011 17:56:54 +0000
From: vfclists at gmail.com
To: lazarus at lists.lazarus.freepascal.org
Subject: [Lazarus] How do you set an event at runtime?



>I need to create some databases at runtime which use same event handling code as a component created at design time.

>Is there some way to set the event handling property of a component at runtime?



I am not sure about databases but with a TMainMenu's TMenuItems component, in Delphi 7 I do this:

This code is all ten+ years old !
// modified by P.Williams 28 Sept 2000



uses collect_two_wd_cmd;


procedure TeditForm.CommandHandler(Sender: TObject);

begin

  // do whatever you like

end;

  

procedure TeditForm.define_commands_menu;


var


  j : integer;


  amenuitem : tmenuitem;


begin


  commands1.clear;


  amenuitem := tmenuitem.create( self );


  amenuitem.caption := '<New 2 Word Command>';


  amenuitem.OnClick := CommandHandler;


  commands1.add( amenuitem );


 

  for j := 0 to command.count - 1 do


    if command.items[ j ].command_name <> '' then


    begin


      amenuitem := tmenuitem.create( self );


      amenuitem.caption := command.items[ j ].command_name;


      amenuitem.OnClick := CommandHandler;


      commands1.add( amenuitem );


    end;


end; { define_commands_menu }


{---------------------------------------------------------}



// Collect_two_wd_cmd.PAS -- defines the custom components TNodeList and TNode, based

//                on the Delphi components TCollection and TCollectionItem,

//                respectively. Author: Steve Koterski; 9/4/97.

//

// modified by P.Williams 11 Oct 2000

 
unit collect_two_wd_cmd;

 
interface

 
uses

  Windows, SysUtils, Classes, collect2;

  // collect2 is one of my own components
 
type

  string20 = string[20];

 
  TNode = class(TCollectionItem)

  private

    // this is the private data variables

    fcommand_name: string20;

    fcommand_effect_table: t2_wd_cmd_sub_nodelist;

  protected

  public

  published

    procedure Assign(Source: TPersistent); override;

    // this is the published data variables

    property command_name: string20 read fcommand_name write fcommand_name;

    property command_effect_table: t2_wd_cmd_sub_nodelist

      read fcommand_effect_table write fcommand_effect_table;

  end;

 
  T2_wd_cmd_NodeList = class(TCollection)

  private

    FOwner: TPersistent;

    function GetItem(Index: Integer): TNode;

    procedure SetItem(Index: Integer; Value: TNode);

  protected

    function GetOwner: TPersistent; override;

  public

    constructor Create(Owner: TPersistent);

//    destructor Destroy; override;

    procedure Add(command_name: string20; command_effect_table: t2_wd_cmd_sub_nodelist);

    property Items[Index: Integer]: TNode read GetItem write SetItem; default;

  published

  end;


implementation

{TNode}

 
procedure TNode.Assign(Source: TPersistent);

begin

  command_name := TNode(Source).command_name;

  command_effect_table := TNode(Source).command_effect_table;

end;

 
{TNodeList}

 
constructor T2_wd_cmd_NodeList.Create(Owner: TPersistent);

begin

  FOwner := Owner;

  inherited Create(TNode);

end;

{

destructor T2_wd_cmd_NodeList.Destroy;

var

  i: Integer;

begin

  for i := 0 to Count - 1 do

    if Assigned(Items[i]) then

      Items[i].Free;

  Inherited;

end;

}

 
function T2_wd_cmd_NodeList.GetItem(Index: Integer): TNode;

begin

  Result := TNode(inherited GetItem(Index));

end;

 
procedure T2_wd_cmd_NodeList.SetItem(Index: Integer; Value: TNode);

begin

  inherited SetItem(Index, TCollectionItem(Value));

end;

 
procedure T2_wd_cmd_NodeList.Add(command_name: string20;

  command_effect_table: t2_wd_cmd_sub_nodelist);

var

  n: TNode;

begin

  n := TNode(inherited Add);

  n.command_name := command_name;

  n.command_effect_table := command_effect_table;

end;

 
function T2_wd_cmd_NodeList.GetOwner: TPersistent;

begin

  Result := FOwner;

end;

 
end.


// COLLECT.PAS -- defines the custom components TNodeList and TNode, based

//                on the Delphi components TCollection and TCollectionItem,

//                respectively. Author: Steve Koterski; 9/4/97.

//

// modified by P.Williams 28 Sept 2000

 
unit collect2;

 
interface

 
uses

  Windows, SysUtils, Classes;

 
type

  TNode = class(TCollectionItem)

  private

    // this is the private data variables

    fobject_no,

      feffect_code,

      fconditional_on: integer;

  protected

  public

  published

    procedure Assign(Source: TPersistent); override;

    // this is the published data variables

    property object_no: integer read fobject_no write fobject_no;

    property effect_code: integer read feffect_code write feffect_code;

    property conditional_on: integer read fconditional_on write fconditional_on;

  end;

 
  T2_wd_cmd_sub_NodeList = class(TCollection)

  private

    FOwner: TPersistent;

    function GetItem(Index: Integer): TNode;

    procedure SetItem(Index: Integer; Value: TNode);

  protected

    function GetOwner: TPersistent; override;

  public

    constructor Create(Owner: TPersistent);

//    destructor Destroy; override;

    procedure Add(object_no, effect_code, conditional_on: integer);

    property Items[Index: Integer]: TNode read GetItem write SetItem; default;

  published

  end;

 
implementation

 
{TNode}

 
procedure TNode.Assign(Source: TPersistent);

begin

  object_no := TNode(Source).object_no;

  effect_code := TNode(Source).effect_code;

  conditional_on := TNode(Source).conditional_on;

end;

 
{TNodeList}

 
constructor T2_wd_cmd_sub_NodeList.Create(Owner: TPersistent);

begin

  FOwner := Owner;

  inherited Create(TNode);

end;

{

destructor T2_wd_cmd_sub_NodeList.Destroy;

var

  i: Integer;

begin

  for i := 0 to Count - 1 do

    if Assigned(Items[i]) then

      Items[i].Free;

  Inherited;

end;

}

 
function T2_wd_cmd_sub_NodeList.GetItem(Index: Integer): TNode;

begin

  Result := TNode(inherited GetItem(Index));

end;

 
procedure T2_wd_cmd_sub_NodeList.SetItem(Index: Integer; Value: TNode);

begin

  inherited SetItem(Index, TCollectionItem(Value));

end;

 
procedure T2_wd_cmd_sub_NodeList.Add(object_no, effect_code, conditional_on: integer);

var

  n: TNode;

begin

  n := TNode(inherited Add);

  n.object_no := object_no;

  n.effect_code := effect_code;

  n.conditional_on := conditional_on;

end;

 
function T2_wd_cmd_sub_NodeList.GetOwner: TPersistent;

begin

  Result := FOwner;

end;

 
end.



pew


-- 
>Frank Church

>=======================
>http://devblog.brahmancreations.com


--
_______________________________________________
Lazarus mailing list
Lazarus at lists.lazarus.freepascal.org
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus 		 	   		  
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.lazarus-ide.org/pipermail/lazarus/attachments/20110105/faf81845/attachment-0003.html>