| 1 | // All pins received data is written to main pin | 
|---|
| 2 | // Data received on main pin is sent to all pins | 
|---|
| 3 |  | 
|---|
| 4 | unit UCommConcentrator; | 
|---|
| 5 |  | 
|---|
| 6 | {$mode Delphi}{$H+} | 
|---|
| 7 |  | 
|---|
| 8 | interface | 
|---|
| 9 |  | 
|---|
| 10 | uses | 
|---|
| 11 | Classes, SysUtils, Contnrs, UCommPin, SpecializedList; | 
|---|
| 12 |  | 
|---|
| 13 | type | 
|---|
| 14 | TCommConcentrator = class; | 
|---|
| 15 |  | 
|---|
| 16 | { TPinList } | 
|---|
| 17 |  | 
|---|
| 18 | TPinList = class(TObjectList) | 
|---|
| 19 | Concentrator: TCommConcentrator; | 
|---|
| 20 | function Add(AObject: TObject): Integer; | 
|---|
| 21 | function AddNew: TCommPin; | 
|---|
| 22 | function Extract(Item: TObject): TObject; | 
|---|
| 23 | procedure Insert(Index: Integer; AObject: TObject); | 
|---|
| 24 | end; | 
|---|
| 25 |  | 
|---|
| 26 | { TCommConcentrator } | 
|---|
| 27 |  | 
|---|
| 28 | TCommConcentrator = class(TCommNode) | 
|---|
| 29 | private | 
|---|
| 30 | FActive: Boolean; | 
|---|
| 31 | FPins: TPinList; | 
|---|
| 32 | FMain: TCommPin; | 
|---|
| 33 | procedure MainReceive(Sender: TCommPin; Stream: TListByte); | 
|---|
| 34 | procedure MainSetStatus(Sender: TCommPin; Status: Integer); | 
|---|
| 35 | procedure Receive(Sender: TCommPin; Stream: TListByte); | 
|---|
| 36 | procedure SetStatus(Sender: TCommPin; Status: Integer); | 
|---|
| 37 | public | 
|---|
| 38 | constructor Create(AOwner: TComponent); override; | 
|---|
| 39 | destructor Destroy; override; | 
|---|
| 40 | property Pins: TPinList read FPins write FPins; | 
|---|
| 41 | property Main: TCommPin read FMain write FMain; | 
|---|
| 42 | end; | 
|---|
| 43 |  | 
|---|
| 44 | implementation | 
|---|
| 45 |  | 
|---|
| 46 | { TPinList } | 
|---|
| 47 |  | 
|---|
| 48 | function TPinList.Add(AObject: TObject): Integer; | 
|---|
| 49 | begin | 
|---|
| 50 | Result := inherited Add(AObject); | 
|---|
| 51 | TCommPin(AObject).OnReceive := Concentrator.Receive; | 
|---|
| 52 | TCommPin(AObject).OnSetSatus := Concentrator.SetStatus; | 
|---|
| 53 | end; | 
|---|
| 54 |  | 
|---|
| 55 | function TPinList.AddNew: TCommPin; | 
|---|
| 56 | begin | 
|---|
| 57 | Result := TCommPin(Items[Add(TCommPin.Create)]); | 
|---|
| 58 | Result.Node := Concentrator; | 
|---|
| 59 | end; | 
|---|
| 60 |  | 
|---|
| 61 | function TPinList.Extract(Item: TObject): TObject; | 
|---|
| 62 | begin | 
|---|
| 63 | TCommPin(Item).OnReceive := nil; | 
|---|
| 64 | TCommPin(Item).OnSetSatus := nil; | 
|---|
| 65 | Result := inherited Extract(Item); | 
|---|
| 66 | end; | 
|---|
| 67 |  | 
|---|
| 68 | procedure TPinList.Insert(Index: Integer; AObject: TObject); | 
|---|
| 69 | begin | 
|---|
| 70 | inherited Insert(Index, AObject); | 
|---|
| 71 | TCommPin(AObject).OnReceive := Concentrator.Receive; | 
|---|
| 72 | TCommPin(AObject).OnSetSatus := Concentrator.SetStatus; | 
|---|
| 73 | end; | 
|---|
| 74 |  | 
|---|
| 75 | { TCommConcentrator } | 
|---|
| 76 |  | 
|---|
| 77 | procedure TCommConcentrator.MainReceive(Sender: TCommPin; Stream: TListByte); | 
|---|
| 78 | var | 
|---|
| 79 | I: Integer; | 
|---|
| 80 | begin | 
|---|
| 81 | if FActive then begin | 
|---|
| 82 | // Broadcast received packet to all other pins | 
|---|
| 83 | for I := 0 to FPins.Count - 1 do | 
|---|
| 84 | if Sender <> FPins[I] then | 
|---|
| 85 | TCommPin(FPins[I]).Send(Stream); | 
|---|
| 86 | end; | 
|---|
| 87 | end; | 
|---|
| 88 |  | 
|---|
| 89 | procedure TCommConcentrator.MainSetStatus(Sender: TCommPin; Status: Integer); | 
|---|
| 90 | var | 
|---|
| 91 | I: Integer; | 
|---|
| 92 | begin | 
|---|
| 93 | if FActive then begin | 
|---|
| 94 | // Broadcast received packet to all other pins | 
|---|
| 95 | for I := 0 to FPins.Count - 1 do | 
|---|
| 96 | if Sender <> FPins[I] then | 
|---|
| 97 | TCommPin(FPins[I]).Status := Status; | 
|---|
| 98 | end; | 
|---|
| 99 | end; | 
|---|
| 100 |  | 
|---|
| 101 | procedure TCommConcentrator.Receive(Sender: TCommPin; Stream: TListByte); | 
|---|
| 102 | begin | 
|---|
| 103 | if FActive then FMain.Send(Stream); | 
|---|
| 104 | end; | 
|---|
| 105 |  | 
|---|
| 106 | procedure TCommConcentrator.SetStatus(Sender: TCommPin; Status: Integer); | 
|---|
| 107 | begin | 
|---|
| 108 | if FActive then FMain.Status := Status; | 
|---|
| 109 | end; | 
|---|
| 110 |  | 
|---|
| 111 | constructor TCommConcentrator.Create(AOwner: TComponent); | 
|---|
| 112 | begin | 
|---|
| 113 | inherited; | 
|---|
| 114 | FPins := TPinList.Create; | 
|---|
| 115 | FPins.Concentrator := Self; | 
|---|
| 116 | FMain := TCommPin.Create; | 
|---|
| 117 | FMain.Node := Self; | 
|---|
| 118 | FMain.OnSetSatus := MainSetStatus; | 
|---|
| 119 | FMain.OnReceive := MainReceive; | 
|---|
| 120 | end; | 
|---|
| 121 |  | 
|---|
| 122 | destructor TCommConcentrator.Destroy; | 
|---|
| 123 | begin | 
|---|
| 124 | Active := False; | 
|---|
| 125 | FreeAndNil(FPins); | 
|---|
| 126 | FreeAndNil(FMain); | 
|---|
| 127 | inherited Destroy; | 
|---|
| 128 | end; | 
|---|
| 129 |  | 
|---|
| 130 | end. | 
|---|
| 131 |  | 
|---|