examples/Delphi/Medtr.pas

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower SysTools
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

unit Medtr;

interface

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

type
  TMediatorForm = class(TForm)
    Panel1: TPanel;
    ASelectBox: TCheckBox;
    BSelectBox: TCheckBox;
    CSelectBox: TCheckBox;
    DSelectBox: TCheckBox;
    ESelectBox: TCheckBox;
    Start: TButton;
    Panel2: TPanel;
    Ch1Lbl: TLabel;
    Ch2Lbl: TLabel;
    Ch3Lbl: TLabel;
    Ch4Lbl: TLabel;
    Panel3: TPanel;
    AEvents: TRadioGroup;
    H1Result: TLabel;
    H2Result: TLabel;
    H3Result: TLabel;
    H4Result: TLabel;
    BEvents: TRadioGroup;
    CEvents: TRadioGroup;
    DEvents: TRadioGroup;
    EEvents: TRadioGroup;
    procedure StartClick(Sender: TObject);
  private
    TheMediator: TStMediator;

    procedure MediatedFunction1(aInputData, aResultData : TObject);
    procedure MediatedFunction2(aInputData, aResultData : TObject);
    procedure MediatedFunction3(aInputData, aResultData : TObject);
    procedure MediatedFunction4(aInputData, aResultData : TObject);
    procedure SetupMediator(Letter: String; Which: TRadioGroup);
    { Private declarations }

  public
    { Public declarations }
  end;

var
  MediatorForm: TMediatorForm;

implementation

{$R *.DFM}

procedure TMediatorForm.StartClick(Sender: TObject);
begin
  TheMediator := TStMediator.create;
  H1Result.Caption := '';
  H2Result.Caption := '';
  H3Result.Caption := '';
  H4Result.Caption := '';
  SetupMediator('A', AEvents);
  SetupMediator('B', BEvents);
  SetupMediator('C', CEvents);
  SetupMediator('D', DEvents);
  SetupMediator('E', EEvents);

  if (ASelectBox.Checked) then
    TheMediator.Handle('A', nil, nil);
  if (BSelectBox.Checked) then
    TheMediator.Handle('B', nil, nil);
  if (CSelectBox.Checked) then
    TheMediator.Handle('C', nil, nil);
  if (DSelectBox.Checked) then
    TheMediator.Handle('D', nil, nil);
  if (ESelectBox.Checked) then
    TheMediator.Handle('E', nil, nil);

  TheMediator.free;

end;

procedure TMediatorForm.SetupMediator(Letter: String; Which: TRadioGroup);
begin
  If (Which.ItemIndex = 0) then
      TheMediator.Add(Letter, MediatedFunction1)
  else If (Which.ItemIndex = 1) then
      TheMediator.Add(Letter, MediatedFunction2)
  else If (Which.ItemIndex = 2) then
      TheMediator.Add(Letter, MediatedFunction3)
  else If (Which.ItemIndex = 3) then
      TheMediator.Add(Letter, MediatedFunction4);
end;

procedure TMediatorForm.MediatedFunction1(aInputData, aResultData : TObject);
begin
  H1Result.Caption := 'I worked';
end;

procedure TMediatorForm.MediatedFunction2(aInputData, aResultData : TObject);
begin
  H2Result.Caption := 'I worked';
end;

procedure TMediatorForm.MediatedFunction3(aInputData, aResultData : TObject);
begin
  H3Result.Caption := 'I worked';
end;

procedure TMediatorForm.MediatedFunction4(aInputData, aResultData : TObject);
begin
  H4Result.Caption := 'I worked';
end;

procedure InitUnit;
begin
end;

procedure DoneUnit;
begin
end;


initialization
  InitUnit;

finalization
  DoneUnit;

end.
1	torben	2671	(* *** BEGIN LICENSE BLOCK ***
2			* Version: MPL 1.1
3			*
4			* The contents of this file are subject to the Mozilla Public License Version
5			* 1.1 (the "License"); you may not use this file except in compliance with
6			* the License. You may obtain a copy of the License at
7			* http://www.mozilla.org/MPL/
8			*
9			* Software distributed under the License is distributed on an "AS IS" basis,
10			* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
11			* for the specific language governing rights and limitations under the
12			* License.
13			*
14			* The Original Code is TurboPower SysTools
15			*
16			* The Initial Developer of the Original Code is
17			* TurboPower Software
18			*
19			* Portions created by the Initial Developer are Copyright (C) 1996-2002
20			* the Initial Developer. All Rights Reserved.
21			*
22			* Contributor(s):
23			*
24			* *** END LICENSE BLOCK *** *)
25
26			unit Medtr;
27
28			interface
29
30			uses
31			Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
32			StdCtrls, StPtrns, ExtCtrls;
33
34			type
35			TMediatorForm = class(TForm)
36			Panel1: TPanel;
37			ASelectBox: TCheckBox;
38			BSelectBox: TCheckBox;
39			CSelectBox: TCheckBox;
40			DSelectBox: TCheckBox;
41			ESelectBox: TCheckBox;
42			Start: TButton;
43			Panel2: TPanel;
44			Ch1Lbl: TLabel;
45			Ch2Lbl: TLabel;
46			Ch3Lbl: TLabel;
47			Ch4Lbl: TLabel;
48			Panel3: TPanel;
49			AEvents: TRadioGroup;
50			H1Result: TLabel;
51			H2Result: TLabel;
52			H3Result: TLabel;
53			H4Result: TLabel;
54			BEvents: TRadioGroup;
55			CEvents: TRadioGroup;
56			DEvents: TRadioGroup;
57			EEvents: TRadioGroup;
58			procedure StartClick(Sender: TObject);
59			private
60			TheMediator: TStMediator;
61
62			procedure MediatedFunction1(aInputData, aResultData : TObject);
63			procedure MediatedFunction2(aInputData, aResultData : TObject);
64			procedure MediatedFunction3(aInputData, aResultData : TObject);
65			procedure MediatedFunction4(aInputData, aResultData : TObject);
66			procedure SetupMediator(Letter: String; Which: TRadioGroup);
67			{ Private declarations }
68
69			public
70			{ Public declarations }
71			end;
72
73			var
74			MediatorForm: TMediatorForm;
75
76			implementation
77
78			{$R *.DFM}
79
80			procedure TMediatorForm.StartClick(Sender: TObject);
81			begin
82			TheMediator := TStMediator.create;
83			H1Result.Caption := '';
84			H2Result.Caption := '';
85			H3Result.Caption := '';
86			H4Result.Caption := '';
87			SetupMediator('A', AEvents);
88			SetupMediator('B', BEvents);
89			SetupMediator('C', CEvents);
90			SetupMediator('D', DEvents);
91			SetupMediator('E', EEvents);
92
93			if (ASelectBox.Checked) then
94			TheMediator.Handle('A', nil, nil);
95			if (BSelectBox.Checked) then
96			TheMediator.Handle('B', nil, nil);
97			if (CSelectBox.Checked) then
98			TheMediator.Handle('C', nil, nil);
99			if (DSelectBox.Checked) then
100			TheMediator.Handle('D', nil, nil);
101			if (ESelectBox.Checked) then
102			TheMediator.Handle('E', nil, nil);
103
104			TheMediator.free;
105
106			end;
107
108			procedure TMediatorForm.SetupMediator(Letter: String; Which: TRadioGroup);
109			begin
110			If (Which.ItemIndex = 0) then
111			TheMediator.Add(Letter, MediatedFunction1)
112			else If (Which.ItemIndex = 1) then
113			TheMediator.Add(Letter, MediatedFunction2)
114			else If (Which.ItemIndex = 2) then
115			TheMediator.Add(Letter, MediatedFunction3)
116			else If (Which.ItemIndex = 3) then
117			TheMediator.Add(Letter, MediatedFunction4);
118			end;
119
120			procedure TMediatorForm.MediatedFunction1(aInputData, aResultData : TObject);
121			begin
122			H1Result.Caption := 'I worked';
123			end;
124
125			procedure TMediatorForm.MediatedFunction2(aInputData, aResultData : TObject);
126			begin
127			H2Result.Caption := 'I worked';
128			end;
129
130			procedure TMediatorForm.MediatedFunction3(aInputData, aResultData : TObject);
131			begin
132			H3Result.Caption := 'I worked';
133			end;
134
135			procedure TMediatorForm.MediatedFunction4(aInputData, aResultData : TObject);
136			begin
137			H4Result.Caption := 'I worked';
138			end;
139
140			procedure InitUnit;
141			begin
142			end;
143
144			procedure DoneUnit;
145			begin
146			end;
147
148
149			initialization
150			InitUnit;
151
152			finalization
153			DoneUnit;
154
155			end.