Author: William Egge
Have you ever written an application where things have to know when things happen,
such as when an object gets freed then you need to update some UI screen or remove
some depency. Or in the case of a paint program where when a mode change requires a
cursor change, buttons to enable or disable or push down... if something gets
deleted then you have to do this and that etc... I have a solution that will keep
your code clean of linking code.
Answer:
There are times when you write an application that turns into a linking nightmare
when your system needs to react to certain conditions. Examples are Mode changing
in a paint program requires cursor changes, an object being updated needs to update
some UI element or disable and enable controls, when an object gets freed you need
to remove dependencies. In other words there are side effects that you need to
happen as a result of something changing in your application. Coding these side
effects can produce some nasty code that is like a big spider web.
The solution to the problem is to use a "Message Center". I have created a easy to
use MessageCenter class that uses the built in messaging capablity already built
into TObject. Source code is at the end of this artical.
1. Concept of the message center
The concept is simple, you have a central "hub" that receives maybe all actions
that happen in your program. Certain parts of your program need to change when
these events happen. Instead of hard coding these "reactions" into your code, you
send the message of the event to the message center in a record structure.
Anything that needs to react or change based on the event is registered with and
notified by the MessageCenter.
2. Example Implementation
This app is an image editor where you can have multiple images opened at once.
Each Image is opened in a Form class of TForm_ImageEdit.
A graphical list of buttons are listed at the top of the main form, there is one
button per opened image and a picture of the image is drawn on the surface of the
button. Users can click the button and active the form for that image.
The rule of the system is
A button should be added when a new form is added.
The button should remove when the form is removed.
The button should push down when the editor form becomes active.
First define the MessageID and the record for the message.
1 const
2 MID_ImageEdit = 14936;
3
4 type
5 TMID_ImageEdit = packed record
6 MessageID: Cardinal; // This is required field for Dispatching
7 Action: (aDestroyed, aActivated);
8 ImageEdit: TForm_ImageEdit;
9 end;
10
11 then within the TForm_ImageEdit Broadcast the messages...
12
13 procedure TForm_ImageEdit.FormDestroy(Sender: TObject);
14 var
15 M: TMID_ImageEdit;
16 begin
17 with M do
18 begin
19 M.MessageID := MID_ImageEdit;
20 M.Action := aClosed;
21 M.ImageEdit := Self;
22 end;
23 GetMessageCenter.BroadcastMessage(Self, M);
24 end;
25
26 procedure TForm_ImageEdit.FormActivate(Sender: TObject);
27 var
28 M: TMID_ImageEdit;
29 begin
30 with M do
31 begin
32 M.MessageID := MID_ImageEdit;
33 M.Action := aActivated;
34 M.ImageEdit := Self;
35 end;
36 GetMessageCenter.BroadcastMessage(Self, M);
37 end;
38
39 Now to edit the main form
40
41 {At some point in your main form when you create the Image Editor, add this code
42 after creation: }
43
44 F := TForm_ImageEdit.Create(Self);
45 // Listen to messages
46 GetMessageCenter.AttachListner(Self, F);
47
48 // Next few lines will add the button for the new form at the top of the main
49 window.
50 {.
51 .
52 . }
This way the Main form will receive messages from the ImageEditor window.
So now Add this MessageHandler to your main form:
Create this method to receive messages of type MID_IMageEdit:
procedure ImageEditorWindowChanged(var Msg: TMID_ImageEdit); message MID_ImageEdit;
And implement it in this way
53
54 procedure TForm_NMLDA.ImageEditorWindowChanged(var Msg: TMID_ImageEdit);
55 begin
56 case Msg.Action of
57 aDestroyed:
58 begin
59 ImageEditorClosed(Msg.ImageEdit);
60 GetMessageCenter.DetachListner(Self, Msg.ImageEdit);
61 end;
62 aActivated: EditorFocused(Msg.ImageEdit);
63 end;
64 end;
ImageEditorClosed method will remove the button from the main form EditorFocused
will push down the button associated with the ImageEditor.
Thats all, you have low coupling and you may attach as many listners as you like.
This concept has a lot of potential and it will make your complex apps very simple
and maintainable.
Here is the code:
65 unit MessageCenter;
66 {
67 William Egge public@eggcentric.com
68 Created Feb - 28, 2002
69 You can modify this code however you wish and use it in commercial apps. But
70 it would be cool if you told me if you decided to use this code in an app.
71
72 The goal is to provide an easy way to handle notifications between objects
73 in your system without messy coding. The goal was to keep coding to a minimum
74 to accomplish this. That is why I chose to use Delphi's built in
75 Message dispatching.
76 This unit/class is intended to be a central spot for messages to get dispatched,
77 every object in the system can use the global GetMessageCenter function.
78 You may also create your own isolated MessageCenter by creating your own
79 instance of TMessageCenter.. for example if you had a large subsystem and
80 you feel it would be more effecient to have its own message center.
81
82 The goal is to capture messages from certain "Source" objects.
83
84 Doc:
85 procedure BroadcastMessage(MessageSource: TObject; var Message);
86 The message "Message" will be sent to all objects who called AttachListner
87 for the MessageSource.
88 If no objects have ever called AttachListner then nothing will happen and
89 the code will not blow up :-). Notice that there is no registration for
90 a MessageSource, this is because the MessageSource registration happens
91 automatically when a listner registers itself for a sender.
92 (keeping external code simpler)
93
94 procedure AttachListner(Listner, MessageSource: TObject);
95 This simply tells the MessageCenter that you want to receive messages from
96 MessageSource.
97
98 procedure DetachListner(Listner, MessageSource: TObject);
99 This removes the Listner so it does not receive messages from MessageSource.
100
101 Technique for usage with interfaces:
102 If your program is interface based then its not possible to pass a
103 MessageSource but it IS possible to pass an object listner if it is being
104 done from within the object wanting to "listen" (using "self").
105 To solve the problem of not being able to pass a MessageSource, you can
106 add 2 methods to your Sender interface definition,
107 AttachListner(Listner: TObject) and DetachListner(Listner: TObject).
108 Internally within those methods your interfaced object can call the
109 MessageCenter and pass its object pointer "Self".
110
111 Info:
112 Performance and speed were #1 so...
113
114 MessageSources are sorted and are searched using a binary search so that
115 a higher number of MessageSources should not really effect runtime performance.
116 The only performance penalty for this is on adding a new MessageSource because
117 it has to do an insert rather than an add, this causes all memory to be shifted
118 to make room for the new element. The benifit is fast message dispatching.
119
120 There is no check for duplicate MesssageListners per Sender, this would have
121 slowed things down and this coding is usefull only when you have bugs. And
122 hoping you prevent bugs, you do not have to pay for this penalty when your
123 code has no bugs.
124 }
125
126 interface
127 uses
128 Classes, SysUtils;
129
130 type
131 TMessageCenter = class
132 private
133 FSenders: TList;
134 FBroadcastBuffers: TList;
135 function FindSenderList(Sender: TObject; var Index: Integer): TList;
136 public
137 constructor Create;
138 destructor Destroy; override;
139 procedure BroadcastMessage(MessageSource: TObject; var message);
140 procedure AttachListner(Listner, MessageSource: TObject);
141 procedure DetachListner(Listner, MessageSource: TObject);
142 end;
143
144 // Shared for the entire application
145 function GetMessageCenter: TMessageCenter;
146
147 implementation
148 var
149 GMessageCenter: TMessageCenter;
150 ShuttingDown: Boolean = False;
151
152 function GetMessageCenter: TMessageCenter;
153 begin
154 if GMessageCenter = nil then
155 begin
156 if ShuttingDown then
157 raise
158 Exception.Create('Shutting down, do not call GetMessageCenter during
159 shutdown.'
160 GMessageCenter := TMessageCenter.Create;
161 end;
162
163 Result := GMessageCenter;
164 end;
165
166 { TMessageCenter }
167
168 procedure TMessageCenter.AttachListner(Listner, MessageSource: TObject);
169 var
170 L: TList;
171 Index: Integer;
172 begin
173 L := FindSenderList(MessageSource, Index);
174 if L = nil then
175 begin
176 L := TList.Create;
177 L.Add(MessageSource);
178 L.Add(Listner);
179 FSenders.Insert(Index, L);
180 end
181 else
182 L.Add(Listner);
183 end;
184
185 procedure TMessageCenter.BroadcastMessage(MessageSource: TObject; var message);
186 var
187 L, Buffer: TList;
188 I: Integer;
189 Index: Integer;
190 Obj: TObject;
191 begin
192 L := FindSenderList(MessageSource, Index);
193 if L <> nil then
194 begin
195 // Use a buffer because objects may detach or add during the broadcast
196 // Broadcast can be recursive. Only broadcast to objects that existed
197 // before the broadcast and not new added ones. But do not broadcast to
198 // objects that are deleted during a broadcast.
199 Buffer := TList.Create;
200 try
201 FBroadcastBuffers.Add(Buffer);
202 try
203 for I := 0 to L.Count - 1 do
204 Buffer.Add(L[I]);
205
206 // skip 1st element because it is the MessageSender
207 for I := 1 to Buffer.Count - 1 do
208 begin
209 Obj := Buffer[I];
210 // Check for nil because items in the buffer are set to nil when they are
211 removed
212 if Obj <> nil then
213 Obj.Dispatch(message);
214 end;
215 finally
216 FBroadcastBuffers.Delete(FBroadcastBuffers.Count - 1);
217 end;
218 finally
219 Buffer.Free;
220 end;
221 end;
222 end;
223
224 constructor TMessageCenter.Create;
225 begin
226 inherited;
227 FSenders := TList.Create;
228 FBroadcastBuffers := TList.Create;
229 end;
230
231 destructor TMessageCenter.Destroy;
232 var
233 I: Integer;
234 begin
235 for I := 0 to FSenders.Count - 1 do
236 TList(FSenders[I]).Free;
237 FSenders.Free;
238 FBroadcastBuffers.Free;
239 inherited;
240 end;
241
242 procedure TMessageCenter.DetachListner(Listner, MessageSource: TObject);
243 var
244 L: TList;
245 I, J: Integer;
246 Index: Integer;
247 begin
248 L := FindSenderList(MessageSource, Index);
249 if L <> nil then
250 begin
251 for I := L.Count - 1 downto 1 do
252 if L[I] = Listner then
253 L.Delete(I);
254
255 if L.Count = 1 then
256 begin
257 FSenders.Remove(L);
258 L.Free;
259 end;
260
261 // Remove from Broadcast buffers
262 for I := 0 to FBroadcastBuffers.Count - 1 do
263 begin
264 L := FBroadcastBuffers[I];
265 if L[0] = MessageSource then
266 for J := 1 to L.Count - 1 do
267 if L[J] = Listner then
268 L[J] := nil;
269 end;
270 end;
271 end;
272
273 function TMessageCenter.FindSenderList(Sender: TObject;
274 var Index: Integer): TList;
275 function ComparePointers(P1, P2: Pointer): Integer;
276 begin
277 if LongWord(P1) < LongWord(P2) then
278 Result := -1
279 else if LongWord(P1) > LongWord(P2) then
280 Result := 1
281 else
282 Result := 0;
283 end;
284 var
285 L, H, I, C: Integer;
286 begin
287 Result := nil;
288 L := 0;
289 H := FSenders.Count - 1;
290 while L <= H do
291 begin
292 I := (L + H) shr 1;
293 C := ComparePointers(TList(FSenders[I])[0], Sender);
294 if C < 0 then
295 L := I + 1
296 else
297 begin
298 H := I - 1;
299 if C = 0 then
300 begin
301 Result := FSenders[I];
302 L := I;
303 end;
304 end;
305 end;
306 Index := L;
307 end;
308
309 initialization
310 finalization
311 ShuttingDown := True;
312 FreeAndNil(GMessageCenter);
313
314 end.
Component Download: http://www.eggcentric.com/download/MCDemo.zip
|