MSGCENT

Top  Previous  Next

{Egy központi komponens színváltozására másik két komponensnek is reagálnia

kell}

 

unit msgcent;

 

interface

 

uses

SysUtils, WinTypes, WinProcs, Messages, Classes,

Graphics, Controls, Forms, Dialogs, stdctrls, Extctrls ;

 

const

CM_COLOR = WM_USER + $100;

 

type

TColorModify =  procedure(Sender: TObject; Color: TColor) of object;

 

  TCMCHANGECOLOR = record

    Msg: word;

    szo: word;

    Color : longint;

    Result: Longint;

  end;

 

 

TCent = class(TPanel)

private

  Fszin : TColor;

  FColorModify : TColorModify;

  procedure SetSzin(Value:TColor);

protected

  procedure CMChangeColor(var Message: TMessage); message CM_COLOR;

public

  constructor Create(AOwner:TComponent);override;

  destructor Destroy;override;

published

  property szin: TColor read Fszin write setszin;

  property OnColorModify : TColorModify read FColorModify write FColorModify;

end;

 

TClientA = class(TPanel)

private

  FCent: TCent;

  FColor : TColor;

  FHandle: THandle;

  procedure SetCent(Value:TCent);

protected

  procedure CMChangeColor(var Message: TMessage); message CM_COLOR;

public

  constructor Create(AOwner:TComponent);override;

  destructor Destroy;override;

  procedure OnColorModify(Sender: TObject; Color: TColor);

published

  property Cent: TCent read FCent write SetCent;

  property Handle: THandle read FHandle write FHandle;

end;

 

 

TClientB = class(TEdit)

private

  FCent: TCent;

  FColor : TColor;

  FHandle: THandle;

  procedure SetCent(Value:TCent);

protected

  procedure CMChangeColor(var Message: TMessage); message CM_COLOR;

public

  constructor Create(AOwner:TComponent);override;

  destructor Destroy;override;

  procedure OnColorModify(Sender: TObject; Color: TColor);

published

  property Cent: TCent read FCent write SetCent;

  property Handle: THandle read FHandle write FHandle;

end;

 

procedure Register;

 

implementation

 

procedure Register;

begin

   RegisterComponents('AL',[TCent,TClientA,TClientB]);

end;

 

constructor TCent.Create(AOwner:TComponent);

begin

   inherited Create(AOwner);

   Fszin:=clYellow;

end;

 

destructor TCent.Destroy;

begin

   inherited Destroy;

end;

 

procedure TCent.CMChangeColor(var Message: TMessage);

begin

Color := Message.lParam;

PostMessage(CM_COLOR,CM_COLOR,0,Message.lParam);

inherited;

end;

 

procedure TCent.SetSzin(Value:TColor);

var Message: TMessage;

  i: integer;

begin

Try

Fszin:=Value;

Color := Value;

Message.Msg := CM_COLOR;

Message.lParam:=Value;

If (ComponentState = []) then begin

For i:=0 to Owner.ComponentCount-1 do begin

  If Owner.Components[i] is TClientA then

     PostMessage((Owner.Components[i] as TWincontrol).handle,CM_COLOR,0,Message.lParam);

  If Owner.Components[i] is TClientB then

     PostMessage((Owner.Components[i] as TWincontrol).handle,CM_COLOR,0,Message.lParam);

end;

end;

finally

If Assigned(FColorModify) then FColorModify(Self,Value);

end;

end;

 

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

constructor TClientA.Create(AOwner:TComponent);

begin

   inherited Create(AOwner);

   Width:=50;

   height:=50;

end;

 

destructor TClientA.Destroy;

begin

   inherited Destroy;

end;

 

procedure TClientA.CMChangeColor(var Message: TMessage);

begin

Color := Message.lParam;        { set color from long parameter }

inherited;

invalidate;

end;

 

procedure TClientA.OnColorModify(Sender: TObject; Color: TColor);

begin

  Brush.Color:=FCent.Color;

  invalidate;

end;

 

procedure TClientA.SetCent(Value:TCent);

begin

 FCent:=Value;

{   If FCent<>nil then

    FCent.OnColorModify:=OnColorModify;}

end;

 

constructor TClientB.Create(AOwner:TComponent);

begin

   inherited Create(AOwner);

end;

 

destructor TClientB.Destroy;

begin

   inherited Destroy;

end;

 

procedure TClientB.CMChangeColor(var Message: TMessage);

begin

Color := Message.lParam;        { set color from long parameter }

inherited;

invalidate;

end;

 

procedure TClientB.OnColorModify(Sender: TObject; Color: TColor);

begin

  Color:=FCent.Color;

  invalidate;

end;

 

procedure TClientB.SetCent(Value:TCent);

begin

 FCent:=Value;

{   If FCent<>nil then

    FCent.OnColorModify:=OnColorModify;}

end;

 

initialization

 RegisterClasses([TClientA,TClientB]);

end.