Both Windows and Android support a messaging system. It is well known by Windows developers who use it with PostMessage, GetMessage, PeekMessage and similar Windows API call. It is much less known by Android developers. Android has a 「looper」 API which has the same purpose as Windows own messaging system although it is implemented differently and has somewhat more features.
Often, we use FireMonkey framework to build multi-platform applications. Thanks to Delphi XE5, we can build an application for different targets such as Win32, Win64, Android, iOS and MAC OSx. If correctly written, the same application source code can be recompiled for different target and run unchanged. Embarcadero made a lot of efforts to hide differences between the supported platforms.
Speaking about the messaging system, it must admit that Embarcadero forgot to write the abstraction layer required for the platforms. They made some work but it is incomplete and undocumented. This is why I wrote it. At least for Win32, Win64 and Android which are the 3 platforms I currently use.
The layer I wrote is made of a single class I named 「TMessagingSystem」. I made two different implementations: one for Android and one for Win 32/64. TMessagingSystem class allows you to register any number of custom messages to a form and associate a custom message handler. Of course it also allows you to call PostMessage to put a message into the message queue.
At the application level, you use the exact same code for Windows or Android. You just have to make use of one of the implementations. You’ll do that using a conditional compilation.
Before showing the implementation details, I will present a demo application. That you can target for Windows or Android without changing a single line.
Demo application for Windows and Android
I built a simple application to emphasize how to use TMessagingSystem. Actually it does not do anything very interesting. It is made of a single form having a button and a memo. When you click on the button, it starts a new thread which will periodically PostMessage a custom message to the main form. You can click many times on the button to start many threads. Each thread will do the same.
The image above shows on the left a screen dump of the application running under Win7 and on the right, the same application running on my Nexus7.
All you see is a memo with messages. Nevertheless, this is really one of the main usages of a messaging system: organize asynchronous operation between threads.
Each line looks like this:
8380] Thread=2 Count=8 ThreadID=7528
「8380」 is the thread ID of the thread doing the display. This is always the same and is the main thread ID. 「Thread=2」 is the sequential thread number having generated the message, 「Count=8」 is the number of messages generated by this thread and finally, 「ThreadID=7528」 is the thread ID of the thread generating the message. The later change according to each started thread.
Demo application source code
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
unit
FmxMultiplatformPostMessageDemoMain;
interface
uses
System
.
SysUtils, System
.
Types, System
.
UITypes, System
.
Classes,
Generics
.
Collections,
FMX
.
Types, FMX
.
Controls, FMX
.
Forms, FMX
.
Graphics, FMX
.
Dialogs,
FMX
.
StdCtrls, FMX
.
Layouts, FMX
.
Memo,
FMX
.
Overbyte
.
MessageHandling;
const
WM_SHOW_MESSAGE = WM_USER +
1
;
type
TWorkerThread =
class
(TThread)
public
MsgSys : TMessagingSystem;
Id :
Integer
;
procedure
Execute; override;
end
;
TForm1 =
class
(TForm)
RunThreadButton: TButton;
DisplayMemo : TMemo;
ToolPanel: TPanel;
procedure
RunThreadButtonClick(Sender: TObject);
private
FMsgSys : TMessagingSystem;
FThreadCount :
Integer
;
procedure
Display(
const
Msg:
String
);
procedure
WorkerThreadTerminate(Sender: TObject);
procedure
WMShowMessage(
var
Msg: TMessage);
protected
procedure
CreateHandle; override;
procedure
DestroyHandle; override;
end
;
var
Form1: TForm1;
implementation
{$R *.fmx}
{ TForm1 }
procedure
TForm1
.
CreateHandle;
begin
inherited
CreateHandle;
FMsgSys := TMessagingSystem
.
Create(Self);
FMsgSys
.
RegisterMessageHandler(WM_SHOW_MESSAGE, WMShowMessage);
end
;
procedure
TForm1
.
DestroyHandle;
begin
FreeAndNil(FMsgSys);
inherited
DestroyHandle;
end
;
procedure
TForm1
.
RunThreadButtonClick(Sender: TObject);
var
WorkerThread : TWorkerThread;
begin
Inc(FThreadCount);
Display(
'Start thread '
+ IntToStr(FThreadCount));
WorkerThread := TWorkerThread
.
Create(
TRUE
);
WorkerThread
.
MsgSys := FMsgSys;
WorkerThread
.
Id := FThreadCount;
WorkerThread
.
FreeOnTerminate :=
TRUE
;
WorkerThread
.
OnTerminate := WorkerThreadTerminate;
WorkerThread
.
Start;
end
;
procedure
TForm1
.
WorkerThreadTerminate(Sender: TObject);
begin
Display(
'Thread '
+
IntToStr((Sender
as
TWorkerThread).Id) +
' terminated'
);
end
;
procedure
TForm1
.
WMShowMessage(
var
Msg: TMessage);
var
Buffer :
PChar
;
begin
Buffer :=
PChar
(Msg
.
LParam);
Display(Buffer);
FreeMem(Buffer);
end
;
procedure
TForm1
.
Display(
const
Msg:
String
);
begin
Displaymemo
.
Lines
.
Add(IntToStr(GetCurrentThreadID) +
'] '
+ Msg);
end
;
{ TWorkerThread }
procedure
TWorkerThread
.
Execute;
var
I :
Integer
;
Buffer :
PChar
;
const
MaxLen =
100
;
begin
// For demo, let's do it 10 times
for
I :=
1
to
10
do
begin
// Simulate some processing time by sleeping
Sleep(
1000
);
// Allocate memory to hold a message, take care of the ending nul char
GetMem(Buffer, SizeOf(
Char
) * (MaxLen +
1
));
// Copy message to allocated memory, protecting overflow
StrLCopy(Buffer,
PChar
(
'Thread='
+ IntToStr(Id) +
' Count='
+ IntToStr(I) +
' ThreadID='
+ IntToStr(GetCurrentThreadID)),
MaxLen);
// Force a nul char at the end of buffer
Buffer[MaxLen] := #
0
;
// Post a message to the main thread which will display
// the message and then free memory
MsgSys
.
PostMessage(WM_SHOW_MESSAGE, I, LParam(Buffer));
end
;
end
;
end
.
|
This source code is really simple, isn’t it? The beauty is that it can be compiled for Win32, Win64 and Android targets without changing anything.
All the code depending on the platform has been moved to 「FMX.Overbyte.MessageHandling」 unit. That one takes care of calling the correct API function according to the compiler used. This is the power of OOP.
There is nothing special in the demo application except one thing: The worker thread generates messages to be displayed by the main thread. We have to take care of what happens with the storage used for the message. We cannot simply pass a string because messages are limited to two parameters of type WParam and LParam, both mapped to NativeInt. We can neither pass a reference to a string variable because it is possible a new message is generated before the previous is consumed (This happens if the main thread is heavily busy while the worker thread runs at full speed). We have to dynamically allocate storage for the message and pass the reference thru one of the message parameters. I’ve chosen to use a simple memory block allocated by GetMem and freed by FreeMem. The pointer is then passed thru the LParam parameter. The thread allocates the memory and the main thread frees it. The same allocation size is always used regardless of the message length. It is better for the memory allocator, limiting memory fragmentation.
How to use it?
TMessagingSystem class must be instantiated when the form is allocated a handle. It must be freed when the form’s handle is destroyed. After instantiation, or at any point in time, RegisterMessageHandler must be called for each custom message. That’s all!
Single unit, multiple platforms
We have seen in the demo code that the same unit to 「FMX.Overbyte.MessageHandling」 is used whatever the target platform is. The magic is in that unit. Here is very short source code:
|
1
2
3
4
5
6
7
8
|
unit
FMX
.
Overbyte
.
MessageHandling;
{$DEFINE OVERBYTE_INCLUDE_MODE}
{$IFDEF ANDROID}
{$I FMX.Overbyte.Android.MessageHandling.pas}
{
$ENDIF
}
{$IFDEF MSWINDOWS}
{$I FMX.Overbyte.Windows.MessageHandling.pas}
{
$ENDIF
}
|
The magic is into the conditional compilation. Symbols ANDROID and MSWINDOWS are automatically defined by the compiler according to the target platform you compile for. So that small unit actually includes the Android or the Windows specific unit depending on the compiler target platform.
The two included units are just normal unit, well almost. You cannot include a unit into another one without having a problem with the 「unit」 line. You cannot have two such lines. This is why the symbol 「OVERBYTE_INCLUDE_MODE」 is defined. In the two included units, this symbol is used to conditionally compile the 「unit」 line.
Implementation for Android
Messaging system on Android platform is hidden in the 「Looper」 API. Basically, the idea is simple: Android monitors a list of handle for data availability. The list of handles is maintained by the API. You can add a new handle using ALooper_addFd API function. Each handle is associated with a callback function that Android calls when data is available.
As a handle, I use the read side of a pipe. A pipe, under Android as well as other operating systems, is like a first-in first-out queue. It has two ends identified by two handles. One is the writing end; the other is the reading end. What you write at one end is available for reading at the other end. Between both ends is a buffer. Reads and writes are asynchronous. If writing is faster than reading, the buffer is filled and nothing is lost.
This pipe is used here is the message queue. When PostMessage is called, a record with the parameters is written to the pipe. When data is available for reading, the looper API will call the LooperCallBack function we registered. From this callback, we read the pipe to remove one record at a time. When a record is read, the message number written in it is used to fetch the message handler to be executed.
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
|
{$IFNDEF OVERBYTE_INCLUDE_MODE}
unit
FMX
.
Overbyte
.
Android
.
MessageHandling;
{
$ENDIF
}
interface
uses
System
.
SysUtils, System
.
Types, System
.
Classes, System
.
SyncObjs,
Generics
.
Collections,
FMX
.
Platform
.
Android,
Androidapi
.
AppGlue, Androidapi
.
Looper,
Posix
.
UniStd, Posix
.
Errno, Posix
.
StrOpts, Posix
.
PThread;
const
WM_USER =
1024
;
type
LPARAM = NativeInt;
WPARAM = NativeInt;
LRESULT = NativeInt;
TMessage =
record
Msg : NativeInt;
WParam : WPARAM;
LParam : LPARAM;
Result : LRESULT;
end
;
TMessageHandler =
procedure
(
var
Msg: TMessage)
of
object
;
TMessagingSystem =
class
(TComponent)
protected
FPipeFD : TPipeDescriptors;
FData :
Byte
;
FHandlers : TDictionary<nativeint tmessagehandler="">;
FLastError :
String
;
FCritSect : TCriticalSection;
procedure
HandleMessage(
var
Msg : TMessage);
function
CreatePipe:
Integer
;
procedure
ClosePipe;
procedure
InstallEventHandler;
procedure
UninstallEventHandler;
public
constructor
Create(AOwner : TComponent); override;
destructor
Destroy; override;
function
RegisterMessageHandler(uMsg : NativeInt;
Handler : TMessageHandler) :
Boolean
;
function
PostMessage(uMsg : NativeInt;
WParam : WPARAM;
LParam : LPARAM) :
Boolean
;
property
LastError :
String
read FLastError;
end
;
HWND = TMessagingSystem;
function
GetCurrentThreadID : TThreadID;
implementation
function
LooperCallback(
FileDescriptor :
Integer
;
Events :
Integer
;
Data :
Pointer
):
Integer
; cdecl;
var
Len :
Integer
;
Msg : TMessage;
Obj : TMessagingSystem;
begin
Result :=
1
;
// Data contains a reference to our class
if
Data =
nil
then
Exit;
// Ready to cast to our class
Obj := TMessagingSystem(Data);
// Check if it's our ReadDes
Obj
.
FCritSect
.
Enter;
try
if
FileDescriptor <> Obj
.
FPipeFD
.
ReadDes
then
Exit;
finally
Obj
.
FCritSect
.
Leave;
end
;
while
TRUE
do
begin
Len := __read(FileDescriptor, @Msg, SizeOf(Msg));
if
Len <=
0
then
break;
Obj
.
HandleMessage(Msg);
end
;
end
;
{ TMessagingSystem }
constructor
TMessagingSystem
.
Create(AOwner: TComponent);
begin
inherited
Create(AOwner);
FCritSect := TCriticalSection
.
Create;
FHandlers := TDictionary<nativeint tmessagehandler="">.Create;
CreatePipe;
InstallEventHandler;
end
;
destructor
TMessagingSystem
.
Destroy;
begin
UninstallEventHandler;
ClosePipe;
FreeAndNil(FCritSect);
inherited
Destroy;
end
;
function
TMessagingSystem
.
CreatePipe:
Integer
;
var
Status :
Integer
;
Val
:
Integer
;
const
FIONBIO =
$5421
;
begin
FCritSect
.
Enter;
try
if
(FPipeFD
.
ReadDes <>
0
)
or
(FPipeFD
.
WriteDes <>
0
)
then
begin
FLastError :=
'Pipe already created'
;
Result := -
1
;
Exit;
end
;
Status := Pipe(FPipeFD);
if
Status = -
1
then
begin
Result := errno;
FLastError :=
'Pipe() failed. Error #'
+ IntToStr(Result);
end
else
begin
Result :=
0
;
Val
:=
1
;
if
ioctl(FPipeFD
.
ReadDes, FIONBIO, @
Val
) = -
1
then
begin
Result := errno;
FLastError :=
'ioctl(FIONBIO) failed. Error #'
+ IntToStr(Result);
Exit;
end
;
end
;
finally
FCritSect
.
Leave;
end
;
end
;
procedure
TMessagingSystem
.
ClosePipe;
begin
FCritSect
.
Enter;
try
if
FPipeFD
.
ReadDes <>
0
then
begin
__close(FPipeFD
.
ReadDes);
FPipeFD
.
ReadDes :=
0
;
end
;
if
FPipeFD
.
WriteDes <>
0
then
begin
__close(FPipeFD
.
WriteDes);
FPipeFD
.
WriteDes :=
0
;
end
;
finally
FCritSect
.
Leave;
end
;
end
;
procedure
TMessagingSystem
.
InstallEventHandler;
var
AndroidApp : PAndroid_app;
Data :
Pointer
;
const
LOOPER_ID_MESSAGE_OVERBYTE = LOOPER_ID_USER;
begin
AndroidApp := GetAndroidApp;
Data := Self;
ALooper_addFd(AndroidApp
.
looper,
FPipeFD
.
ReadDes,
LOOPER_ID_MESSAGE_OVERBYTE,
ALOOPER_EVENT_INPUT,
LooperCallback,
Data);
end
;
procedure
TMessagingSystem
.
UninstallEventHandler;
var
AndroidApp : PAndroid_app;
begin
FCritSect
.
Enter;
try
if
FPipeFD
.
ReadDes <>
0
then
begin
AndroidApp := GetAndroidApp;
ALooper_removeFd(AndroidApp
.
looper, FPipeFD
.
ReadDes);
end
;
finally
FCritSect
.
Leave;
end
;
end
;
function
TMessagingSystem
.
RegisterMessageHandler(
uMsg : NativeInt;
Handler : TMessageHandler):
Boolean
;
begin
FCritSect
.
Enter;
try
FHandlers
.
AddOrSetValue(uMsg, Handler);
finally
FCritSect
.
Leave;
end
;
Result :=
TRUE
;
end
;
function
TMessagingSystem
.
PostMessage(
uMsg : NativeInt;
WParam : WParam;
LParam : LParam):
Boolean
;
var
Msg : TMessage;
begin
Result :=
FALSE
;
FCritSect
.
Enter;
try
if
FPipeFD
.
WriteDes =
0
then
begin
FLastError :=
'Pipe is not open'
;
Exit;
end
;
Msg
.
Msg := uMsg;
Msg
.
WParam := WParam;
Msg
.
LParam := LParam;
Msg
.
Result :=
0
;
if
__write(FPipeFD
.
WriteDes, @Msg, SizeOf(Msg)) = -
1
then
begin
FLastError :=
'write() failed. ErrCode='
+ IntToStr(errno);
Exit;
end
;
finally
FCritSect
.
Leave;
end
;
Result :=
TRUE
;
end
;
procedure
TMessagingSystem
.
HandleMessage(
var
Msg: TMessage);
var
Handler : TMessageHandler;
Status :
Boolean
;
begin
FCritSect
.
Enter;
try
Status := FHandlers
.
TryGetValue(Msg
.
Msg, Handler);
finally
FCritSect
.
Leave;
end
;
if
Status
then
Handler(Msg);
end
;
function
GetCurrentThreadID : TThreadID;
begin
Result := Posix
.
PThread
.
GetCurrentThreadID;
end
;
end
.
</nativeint></nativeint>
|
In that code, you’ll find a few data types frequently used in Windows applications. I used the same data types for compatibility with existing code.
TMessagingSystem class is very simple. Basically, it registers a pipe read handle with the looper API with an associated callback function. It also maintains a dictionary of message handlers. The key is the message number. The looper API also carries one pointer for you. It will give it back as an argument of the callback function. Here the pointer is used as a reference to the class instance, making is available when the callback function is called.
A critical section is used to avoid problems accessing the class data from several threads at the same time. Using this critical section makes the class fully thread safe.
Implementation for Windows
The Windows implementation makes obviously use of Windows own messaging API. There is no queue in the class because Windows queue is used.
FireMonkey forms does not provide any support for custom messages. This is not really a problem because a FireMonkey forms are just a Windows window. As any window, a FireMonkey form running on Windows has a HWND (Handle of WiNDow) and a window procedure handling all messages for the window.
To hook into this system, we must use standard Windows programming. By standard I mean it has always existed as far as I remember. What we need is to 「subclass」 the window. And surprisingly, this is very easy!
Windows internally maintain a structure for each window. In that structure you have all informations required for Windows to handle the window. This includes the pointer to the window procedure.
And Windows provides a function to access his internal structure. Our problem is just to get the current pointer to the window procedure and replace it with a pointer to our own procedure. From our own procedure, we will call the original procedure, or not. Our own window procedure has access to all messages sent/posted to the window, including those we add.
We have just one small problem: Windows does not know anything about a Delphi class instance. A window procedure is a simple procedure, not an object method. The problem is to get hand on our TMessagingSystem class instance from our own window procedure.
Fortunately Windows is incredibly well designed. We, as developer, can associate with any window a small piece of data called an 「Atom」 in Windows terminology. Once an 「Atom」 is created (It just has a name), you can associate the atom with any window along with a piece of data. That piece of data will be the reference to our TMessagingSystem class instance.
When called by Windows, our window procedure receives the handle of the window. We use it to fetch the piece of data we associated using the atom. From there we have access to TMessagingSystem class instance and check for the message to handle. if it is one of our registered messages, we just call the handler. If not one of our messages, the the original window procedure is called.
Here is the source code:
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
|
{$IFNDEF OVERBYTE_INCLUDE_MODE}
unit
FMX
.
Overbyte
.
Windows
.
MessageHandling;
{
$ENDIF
}
interface
uses
WinApi
.
Windows, WinApi
.
Messages,
System
.
Classes, System
.
SysUtils, System
.
SyncObjs,
Generics
.
Collections,
FMX
.
Forms, FMX
.
Platform
.
Win;
const
WM_USER = WinApi
.
Messages
.
WM_USER;
type
TMessage = WinApi
.
Messages
.
TMessage;
WPARAM = WinApi
.
Windows
.
WPARAM;
LPARAM = WinApi
.
Windows
.
LPARAM;
TMessageHandler =
procedure
(
var
Msg: TMessage)
of
object
;
TWndProc =
function
(hwnd : HWND;
uMsg : UINT;
wParam : WPARAM;
lParam : LPARAM): LRESULT; stdcall;
TMessagingSystem =
class
(TComponent)
protected
FHWnd : HWND;
FHandlers : TDictionary<nativeint tmessagehandler="">;
FOriginalWndProc : TWndProc;
FLastError :
String
;
FCritSect : TCriticalSection;
public
constructor
Create(AOwner : TComponent); override;
destructor
Destroy; override;
function
RegisterMessageHandler(uMsg : NativeInt;
Handler : TMessageHandler) :
Boolean
;
function
PostMessage(uMsg : NativeInt;
WParam : WPARAM;
LParam : LPARAM) :
Boolean
;
property
LastError :
String
read FLastError;
end
;
function
GetCurrentThreadId: DWORD; stdcall;
implementation
var
MsgSysAtom : TAtom;
MsgSysAtomString :
String
;
function
WndProc(hwnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
Msg : TMessage;
MsgSys : TMessagingSystem;
Handler : TMessageHandler;
Status :
Boolean
;
begin
// Search if the window handle is associated with TMessageingInstance
// We know this because we registered an atom for that purpose
if
GlobalFindAtomW(
PChar
(MsgSysAtomString)) <> MsgSysAtom
then
begin
// Not found, just do default processing
Result := DefWindowProc(hwnd, uMsg, wParam, lParam);
Exit;
end
;
// Fetch the atom property and cast it to a TMessagingSystem class
MsgSys := TMessagingSystem(GetProp(hwnd, MakeIntAtom(MsgSysAtom)));
// Now use the dictionary to see if the message is one we'll handle
MsgSys
.
FCritSect
.
Enter;
try
Status := MsgSys
.
FHandlers
.
TryGetValue(uMsg, Handler);
finally
MsgSys
.
FCritSect
.
Leave;
end
;
if
Status
then
begin
// Found the message and his message handler. Call it using
// the TMessage record to hold the values
Msg
.
Msg := uMsg;
Msg
.
WParam := wParam;
Msg
.
LParam := lParam;
Msg
.
Result :=
0
;
Handler(Msg);
Result := Msg
.
Result;
end
else
begin
// Not one of our messages, just execute original window procedure
Result := MsgSys
.
FOriginalWndProc(hwnd, uMsg, wParam, lParam);
end
;
end
;
{ TMessagingSystem }
constructor
TMessagingSystem
.
Create(AOwner: TComponent);
begin
if
not
(AOwner
is
TCommonCustomForm)
then
raise
Exception
.
Create(
'TMessagingSystem.Create failed. Invalid owner'
);
inherited
Create(AOwner);
FCritSect := TCriticalSection
.
Create;
FHandlers := TDictionary<nativeint tmessagehandler="">.Create;
// Find window handle corresponding to the owner form
FHWnd := WindowHandleToPlatform(TCommonCustomForm(AOwner).Handle).Wnd;
// If not already done, register the atom we'll use to associate
// our messaging system with the window handle
if
MsgSysAtom =
0
then
begin
MsgSysAtomString :=
'OverbyteMessagingSystem'
+
IntToHex(GetCurrentProcessID,
8
);
MsgSysAtom := GlobalAddAtomW(
PChar
(MsgSysAtomString));
end
;
// Associate our messaging system with the window handle
SetProp(FHWnd, MakeIntAtom(MsgSysAtom), THandle(Self));
// Subclass the form. That is change his handling procedure
FOriginalWndProc := TWndProc(GetWindowLongPtr(FHWnd, GWLP_WNDPROC));
SetWindowLongPtr(FHWnd, GWLP_WNDPROC, NativeInt(@WndProc));
end
;
destructor
TMessagingSystem
.
Destroy;
begin
if
Assigned(FOriginalWndProc)
then
begin
SetWindowLongPtr(FHWnd, GWLP_WNDPROC, NativeInt(@FOriginalWndProc));
FOriginalWndProc :=
nil
;
end
;
FreeAndNil(FHandlers);
FreeAndNil(FCritSect);
inherited
Destroy;
end
;
function
TMessagingSystem
.
RegisterMessageHandler(
uMsg : NativeInt;
Handler : TMessageHandler):
Boolean
;
begin
FCritSect
.
Enter;
try
FHandlers
.
AddOrSetValue(uMsg, Handler);
finally
FCritSect
.
Leave;
end
;
Result :=
TRUE
;
end
;
function
TMessagingSystem
.
PostMessage(
uMsg : NativeInt;
WParam : WPARAM;
LParam : LPARAM):
Boolean
;
begin
Result := WinApi
.
Windows
.
PostMessage(FHWnd, uMsg, WParam, LParam);
end
;
function
GetCurrentThreadId: DWORD; stdcall;
begin
Result := WinApi
.
Windows
.
GetCurrentThreadId;
end
;
end
.
</nativeint></nativeint>
|
All the code is shown above. If you are interested by the complete project as source code, just drop me a private email.
Follow me on Twitter
Follow me on LinkedIn
Follow me on Google+
Visit my website: http://www.overbyte.be
This article is available from http://francois-piette.blogspot.be
2 comments:
Can you make a demo show us the way in how to loadCursorFromFile under firemonkey desktop application ?
you have a single Png with 32 frames inside. and i would like to animate this cursor from this Frames inside the Png Picture ...
and here is the link of the same question in the Forum of Embarcadero :
https://forums.embarcadero.com/thread.jspa?messageID=666946򢵂
finally with best regards :Bravehtml
Hi hello,
nice Demo.
But I had to Change from
>>FHandlers : TDictionary;
to
FHandlers : TDictionary;
Then the Demo runs.
THXandroid