[D5] wiring sub object event

[Stefano Campri]

i would like to link an event (OnRecive_PortaSeriale) entered via the Objec
inspector to an event
within a sub-component (TADSWComm)
The sub-component (TADSWComm) is declared as property and work just fine
except the event

The goal is to have TADSWStrumentoSeriale component encapsulate and publish
the functionality of TADSWComm

Anyone know how to accomplish this ?
Any helps wolud be appreciate

Thanks in advance,
Stefano

(following the most relevant code)

=============================================

unit ADSWStrumentoSeriale;

interface

uses
Windows, SysUtils, Messages, Classes, Graphics, Controls,
Forms, Dialogs, ExtCtrls, ADSWDefine, ADSWComm, ADSWeverLiquidIndicator;

type

TADSWStrumentoSeriale = class(TADSWeverLiquidIndicator)
private
FPortaSeriale: TADSWComm;
FReadBufferFull: TReadBufferFull;
FReadBufferThreshold: TReadBufferThreshold;
FReceive: TReceive;
FReceiveEventChar: TReceiveEventChar;
protected
procedure SetPortaSeriale(const Value: TADSWComm);
procedure ProcessOnRecive_PortaSeriale;
public
constructor Create (AOwner : TComponent);override;
destructor Destroy;override;
procedure Loaded;override;
function GetChildOwner : TComponent;override;
function GetChildParent : TComponent;override;
procedure GetChildren(Proc: TGetChildProc; Root: TComponent);override;
published
property PortaSeriale : TADSWComm read FPortaSeriale write
SetPortaSeriale;
property OnReceive_PortaSeriale : TReceive read FReceive write
FReceive;
end;

implementation

{ TADSWStrumentoSeriale }

constructor TADSWStrumentoSeriale.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
if not (csLoading in AOwner.ComponentState) then begin
FPortaSeriale := TADSWComm.Create(Self);
end;
end;

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

destructor TADSWStrumentoSeriale.Destroy;
begin
FPortaSeriale.Free;
inherited Destroy;
end;

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

function TADSWStrumentoSeriale.GetChildOwner: TComponent;
begin
Result := Self;
end;

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

function TADSWStrumentoSeriale.GetChildParent: TComponent;
begin
Result := Self;
end;

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

procedure TADSWStrumentoSeriale.GetChildren(Proc: TGetChildProc;
Root: TComponent);
begin
inherited;
Proc(PortaSeriale);
end;

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

procedure TADSWStrumentoSeriale.Loaded;
var
i : integer;

begin
inherited;
FPortaSeriale := TADSWComm(Components[0]);
end;

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

procedure TADSWStrumentoSeriale.ProcessOnRecive_PortaSeriale
begin
if Assigned(FReceive) then begin
FReceive(Sender, Buffer, Count);
end;
end;

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

procedure TADSWStrumentoSeriale.SetPortaSeriale(const Value: TADSWComm);
begin
FPortaSeriale.Assign(Value);
end;

initialization
RegisterClass(TADSWComm);

end.

=======================================

unit ADSWComm;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, ADSWDefine;



type
TADSWComm = class(TADSWComponent)
private
{ Private declarations }
hCommFile : THandle;

FReceive : TReceive;
FReceiveEventChar : TReceiveEventChar;
FReadBufferFull : TReadBufferFull;
FReadBufferThreshold : TReadBufferThreshold;

FPort : TPort;
FBaudRate : TBaudRate;
FParity : TParity;
FStopBits : TStopBits;
FDataBits : TDataBits;

FThreshold : Word;

FRxInterval : integer;

FEventChar : Byte;

Error : boolean;

Timer : TTimer;

gClose : boolean;
ThresholdExceed : boolean;
sBuffer : array[0..BUFF_TMP_SIZE-1] of char;
sRead : array [0..BUFF_SIZE-1] of char;
nRead : integer;

procedure SetThreshold (Value: Word);
procedure SetPort (Value: TPort);
procedure SetDataBits (Value: TDataBits);
procedure SetStopBits (Value: TStopBits);
procedure SetParity (Value: TParity);
procedure SetBaudRate (Value: TBaudRate);
procedure SetRxInterval (Value : integer);
function GetInCount: LongInt;
function CharIn (szInputBuffer: PChar; Start: integer;
nNumberOfBytesRead: integer; Ch:Char): boolean;
procedure TimerEvent (Sender: TObject);

protected
{ Protected declarations }
procedure DoReceive;
procedure DoReceiveEventChar;
procedure DoReadBufferFull;
procedure DoReadBufferThreshold;

public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Assign(Source : TPersistent);override;
function StartComm(P:TPort): Boolean;
procedure StopComm;
function Write( Data: PChar; Len: Word ): Boolean;
function IsError: Boolean;
procedure Flush;
published
{ Published declarations }
property EventChar: Byte read FEventChar write FEventChar
default DEF_EVENTCHAR;
property Threshold: word read FThreshold write SetThreshold
default DEF_THRESHOLD;
property BaudRate: TBaudRate read FBaudRate write SetBaudRate
default DEF_BAUDRATE;
property Parity: TParity read FParity write SetParity
default DEF_PARITY;
property StopBits: TStopBits read FStopBits write SetStopBits
default DEF_STOPBITS;
property DataBits: TDataBits read FDataBits write SetDataBits
default DEF_DATABITS;
property Port: TPort read FPort write FPort;
property RxInterval: integer read FRxInterval write FRxInterval;
property OnReceive : TReceive read FReceive write FReceive;
property OnReceiveEventChar : TReceiveEventChar read FReceiveEventChar
write FReceiveEventChar;
property OnReadBufferFull: TReadBufferFull read FReadBufferFull write
FReadBufferFull;
property OnReadBufferThreshold: TReadBufferThreshold read
FReadBufferThreshold write FReadBufferThreshold;

end;


implementation

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


constructor TADSWComm.Create(AOwner: TComponent);
begin

inherited Create(AOwner);

hCommFile := 0;
gClose := TRUE;

FEventChar := DEF_EVENTCHAR;
FThreshold := DEF_THRESHOLD;
FBaudRate := DEF_BAUDRATE;
FDataBits := DEF_DATABITS;
FStopBits := DEF_STOPBITS;
FParity := DEF_PARITY;
FPort := DEF_PORT;
FRxInterval := DEF_RXINTERVAL;

Error := FALSE;

Timer := TTimer.Create(Self);
Timer.Enabled := FALSE;
Timer.Interval := FRxInterval;
Timer.OnTimer := TimerEvent;

nRead := 0;
ThresholdExceed := FALSE;
StrCopy (sBuffer,'');
StrCopy (sRead,'');

end;

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

procedure TADSWComm.DoReceive;
var B : LPSTR;
begin
B := sRead;
if Assigned(FReceive) then begin
FReceive (Self,B,nRead);
nRead := 0;
ThresholdExceed := FALSE;
StrCopy (sBuffer,'');
StrCopy (sRead,'');
end;
end;

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

procedure TADSWComm.Assign(Source: TPersistent);
begin
if Source is TADSWComm then begin
Self.Port := TADSWComm(Source).Port;
Self.RxInterval := TADSWComm(Source).RxInterval;
Self.BaudRate := TADSWComm(Source).BaudRate;
Self.Parity := TADSWComm(Source).Parity;
Self.StopBits := TADSWComm(Source).StopBits;
Self.EventChar := TADSWComm(Source).EventChar;
Self.DataBits := TADSWComm(Source).DataBits;
Self.Threshold := TADSWComm(Source).Threshold;

//
// Self.OnReceive := TADSWComm(Source).FReceive;
//
end
else begin
// raise an exception
end;
end;

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

procedure TADSWComm.TimerEvent (Sender: TObject);
var Len,NCharRead : DWord;
bReceive : boolean;
bReceiveEventChar : boolean;
bReadBufferThreshold : boolean;
bReadBufferFull : boolean;

begin

Timer.Enabled := FALSE;

Len := GetInCount;
while Len > 0 do begin
{ Azzero i flag degli eventi }
bReceive := FALSE;

if Len > BUFF_TMP_SIZE-1 then
Len := BUFF_TMP_SIZE-1;

ReadFile( hCommFile,
sBuffer, Len,
NCharRead,nil);

{--------- OnReceive ----------}
bReceive := TRUE;

sBuffer[NCharRead] := #0;

{ La concateno al buffer principale }
strCat (sRead,sBuffer);
Inc(nRead,NCharRead);

if bReceive then
DoReceive;

Len := GetInCount;
if Len > 0 then { Se ci sono altri caratteri nella seriale
do il controllo anche alle altre applicazioni }
Application.ProcessMessages;
end;


Timer.Enabled := TRUE;

end;

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

end.

[Joao Paulo Antao]

Hi, I dont understand exacly what do you want, But I imagine that you
want raise a event on a linked subcomponent ever that you have a event of
your own component.
I think that you can do like that...

-- New Code --
procedure TADSWStrumentoSeriale.ProcessOnRecive_PortaSeriale
begin
if Assigned(PortaSeriale) then
PortaSeriale.DoEvent(....);

if Assigned(FReceive) then begin
FReceive(Sender, Buffer, Count);
end;
end;


-- Original Code --
procedure TADSWStrumentoSeriale.ProcessOnRecive_PortaSeriale
begin
if Assigned(FReceive) then begin
FReceive(Sender, Buffer, Count);
end;
end;

[Stefano Campri]

Hi Joao Paulo
Thanks for your reply

Post by Joao Paulo Antao
Hi, I dont understand exacly what do you want,

i need OnRecive_PortaSeriale be fired

procedure TForm1.ADSWStrumentoSeriale1Receive_PortaSeriale(Sender: TObject;
Buffer: Pointer; Count: Word);
begin
//
ShowMessage('Received');
end;

until now it's not fired because
running my test program i get always ADSWStrumentoSeriale.FRecive = nil

i don't know what i'm missing :-(
i think i'm missig a lot of things

any help would be appreciate

Thanks in advance
Stefano

Post by Joao Paulo Antao
But I imagine that you want raise a event on a linked subcomponent ever

that you have a event of

Post by Joao Paulo Antao
your own component.
I think that you can do like that...
-- New Code --
procedure TADSWStrumentoSeriale.ProcessOnRecive_PortaSeriale
begin
if Assigned(PortaSeriale) then
PortaSeriale.DoEvent(....);
if Assigned(FReceive) then begin
FReceive(Sender, Buffer, Count);
end;
end;
-- Original Code --
procedure TADSWStrumentoSeriale.ProcessOnRecive_PortaSeriale
begin
if Assigned(FReceive) then begin
FReceive(Sender, Buffer, Count);
end;
end;

TReceive = procedure ( Sender: TObject; Buffer: Pointer; Count: Word ) of
object;

TADSWComm = class(TADSWComponent)
private
{ Private declarations }
FReceive : TReceive;
protected
{ Protected declarations }
procedure DoReceive;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Assign(Source : TPersistent);override;
published
{ Published declarations }
property OnReceive : TReceive read FReceive write FReceive;
end;

procedure TADSWComm.DoReceive;
var B : LPSTR;
begin
B := sRead;
if Assigned(FReceive) then begin
FReceive (Self,B,nRead);
nRead := 0;
ThresholdExceed := FALSE;
StrCopy (sBuffer,'');
StrCopy (sRead,'');
end;
end;

procedure TADSWComm.TimerEvent (Sender: TObject);
var Len,NCharRead : DWord;
bReceive : boolean;
bReceiveEventChar : boolean;
bReadBufferThreshold : boolean;
bReadBufferFull : boolean;

begin

Timer.Enabled := FALSE;

Len := GetInCount;
while Len > 0 do begin
{ Azzero i flag degli eventi }
bReceive := FALSE;

if Len > BUFF_TMP_SIZE-1 then
Len := BUFF_TMP_SIZE-1;

ReadFile( hCommFile,
sBuffer, Len,
NCharRead,nil);

{--------- OnReceive ----------}
bReceive := TRUE;

sBuffer[NCharRead] := #0;

{ La concateno al buffer principale }
strCat (sRead,sBuffer);
Inc(nRead,NCharRead);

if bReceive then
DoReceive;

Len := GetInCount;
if Len > 0 then { Se ci sono altri caratteri nella seriale
do il controllo anche alle altre applicazioni }
Application.ProcessMessages;
end;

Timer.Enabled := TRUE;
end;


rocedure TADSWComm.Assign(Source: TPersistent);
begin
if Source is TADSWComm then begin
Self.Port := TADSWComm(Source).Port;
Self.RxInterval := TADSWComm(Source).RxInterval;
Self.BaudRate := TADSWComm(Source).BaudRate;
Self.Parity := TADSWComm(Source).Parity;
Self.StopBits := TADSWComm(Source).StopBits;
Self.EventChar := TADSWComm(Source).EventChar;
Self.DataBits := TADSWComm(Source).DataBits;
Self.Threshold := TADSWComm(Source).Threshold;

//Self.OnReceive := TADSWComm(Source).FReceive;

end
else begin
// raise an exception
end;
end;

TADSWStrumentoSeriale = class(TADSWeverLiquidIndicator)
private
FPortaSeriale: TADSWComm;
FReceive: TReceive;
protected
procedure SetPortaSeriale(const Value: TADSWComm);
procedure ProcessOnRecive_PortaSeriale (Sender: TObject; Buffer:
Pointer; Count: Word);
public
constructor Create (AOwner : TComponent);override;
destructor Destroy;override;
procedure Loaded;override;
function GetChildOwner : TComponent;override;
function GetChildParent : TComponent;override;
procedure GetChildren(Proc: TGetChildProc; Root: TComponent);override;
published
property PortaSeriale : TADSWComm read FPortaSeriale write
SetPortaSeriale;
property OnReceive_PortaSeriale : TReceive read FReceive write
FReceive;
end;

implementation

{ TADSWStrumentoSeriale }

constructor TADSWStrumentoSeriale.Create(AOwner: TComponent);
begin

inherited Create(AOwner);
if not (csLoading in AOwner.ComponentState) then begin
FPortaSeriale := TADSWComm.Create(Self);
FPortaSeriale.OnReceive := ProcessOnRecive_PortaSeriale;
end;
end;

//--------------------------------------------------------------------------
----

destructor TADSWStrumentoSeriale.Destroy;
begin
FPortaSeriale.Free;
inherited Destroy;
end;

//--------------------------------------------------------------------------
----

function TADSWStrumentoSeriale.GetChildOwner: TComponent;
begin
Result := Self;
end;

//--------------------------------------------------------------------------
----

function TADSWStrumentoSeriale.GetChildParent: TComponent;
begin
Result := Self;
end;

//--------------------------------------------------------------------------
----

procedure TADSWStrumentoSeriale.GetChildren(Proc: TGetChildProc;
Root: TComponent);
begin
inherited;
Proc(PortaSeriale);
end;

//--------------------------------------------------------------------------
----

procedure TADSWStrumentoSeriale.Loaded;
var
i : integer;

begin
inherited;
FPortaSeriale := TADSWComm(Components[0]);
end;

//--------------------------------------------------------------------------
----

procedure TADSWStrumentoSeriale.ProcessOnRecive_PortaSeriale(
Sender: TObject; Buffer: Pointer; Count: Word);
begin
if Assigned(PortaSeriale) then begin
PortaSeriale.DoReceive;
end;

if Assigned(FReceive) then begin
FReceive(Sender, Buffer, Count);
end;
end;

//--------------------------------------------------------------------------
----

procedure TADSWStrumentoSeriale.SetPortaSeriale(const Value: TADSWComm);
begin
FPortaSeriale.Assign(Value);
end;

//--------------------------------------------------------------------------
----

initialization
RegisterClass(TADSWComm);

[Stefano Campri]

Hi Joao Paulo

Post by Joao Paulo Antao
Hi, I dont understand exacly what do you want

i need OnRecive_PortaSeriale be fired
when TADSWComm.DoRecive is executed

so in other words i would like
OnRecive_PortaSeriale inheriting from TADSWComm.OnRecive

Thanks in advance
Stefano