TAxThread - Inter thread message based communication - Delphi
http://www.cybletter.com/index.php?id=3
http://www.cybletter.com/index.php?id=30
Source Code
http://www.cybletter.com/index.php?s=file_download&id=3
Full Paper
www.cybletter.com/index.php?s=file_download&id=4
Alexandr Štefek
Military Academy in Brno
alexandr@stefek.cz
Abstract
This paper present implementation of parallel execution.
If we use parallel proces in programs we have to solve synchronization.
We show the effective implementation of parallel execution without using critical sections, semaphores, mutexes or events.
Thread
The thread is system object defined on platform Win32.
SDK defines some method for thread creating and handling.
In real implementation must be defined the procedure for all parallel procedures.
If in system Win32 thread create new window handle then all messages are handled by this thread.
For this fact commes the idea of problem solution.
We can simply create window handle on executing thread.
When this thread executes loop for message handling it is possible to send special message to thread window handle.
The parameters of message can be method to execute and parameter for this method.
But method has 8 bytes and the message parameter only 4.
So we have allocate memory block, copy method to this block and send adress of allocated block.
Coding the method
We want to create class that has method for sync parallel and async parallel execution of methods.
Now we show, how to code the 8 byte method to 4 byte adress of method.
function TAxThread.NotifyEventToPointer( Proc : TNotifyEvent ) : Longint;
var
Method : TMethod absolute Proc;
PMethod : ^TMethod;
begin
New( PMethod );
PMethod^ := Method;
Result := Longint( PMethod );
end; procedure TAxThread.AsyncExecuteParallel( Proc : TNotifyEvent; ParamSender : TObject );
begin
InterlockedIncrement( FMethodsToExecute );
PostMessageParallel( CM_EXECPROC_WORK_TRHREAD, NotifyEventToPointer( Proc ), Longint( ParamSender ) );
end; procedure TAxThread.ExecProcedure( var Message : TMessage );
var
PMethod : ^TMethod;
Method : TMethod;
Event : TNotifyEvent absolute Method;
begin
PMethod := Pointer( message.WParam );
Method := PMethod^;
Event( TObject( message.LParam ) );
Dispose( PMethod );
if FThreadID = GetCurrentThreadId then
InterlockedDecrement( FMethodsToExecute );
end;
NotifyEventToPointer is method for copying method to memory block.
Result of this method is adress of memory block.
Method ExeProcedure takes WParam of message, convert it back to method
and call decoded method with parametr defined by LParam of message.
Thread loop
We have to define thread message loop.
Delphi define basic thread class TThread.
This class has virtual method execute.
Defined class TAxThread is inherited from TThread.
Method TAxThread.Execute is overrided;
procedure TAxThread.Execute;
var
Msg : TMsg;
Done : Boolean;
begin
CreateHandleParallel;
FThreadID := GetCurrentThreadId;
while not Terminated do
begin
if Done then
begin
FIdleData := nil;
WaitMessage;
end;
while ProcessMessage( Msg ) do { loop };
Idle( FIdleData, Done );
end;
end;
At first the class has to create handle (CreateHandleParallel).
Loop while waits for messages and handles incomming messages (ProcessMessage).
function TAxThread.ProcessMessage( var Msg : TMsg ) : Boolean;
begin
Result := False;
if PeekMessage( Msg, , , , PM_REMOVE ) thenbegin
Result := True;
if Msg.Message <> WM_QUIT then
begin
TranslateMessage( Msg );
DispatchMessage( Msg );
end
else
Terminate;
end;
end;
Calling DispatchMessage dispatch current message to objects for execution.
If incomming method is CM_EXECUTE (defined in Delphi), then method ExecProcedure is called.
Sync and async execution
All parallel processing is sended to execution by message.
If we use for sending the API function SendMessage then the execution is synchronized
(actual thread is suspend, the context is switched, message is immediately handled and control is returned to sending thread).
The API function PostMessage puts the message to message queue and continue in execution.
When the message is peek from queue, is handled and method is executed.
// Asynchro execute on parallel thread
procedure TAxThread.AsyncExecuteParallel( Proc : TNotifyEvent;
ParamSender : TObject );
begin
InterlockedIncrement( FMethodsToExecute );
PostMessageParallel( CM_EXECPROC, NotifyEventToPointer( Proc ),
Longint( ParamSender ) );
end; // Synchro execute on parallel thread
procedure TAxThread.SyncExecuteParallel( Proc : TNotifyEvent;
ParamSender : TObject );
begin
InterlockedIncrement( FMethodsToExecute );
SendMessageParallel( CM_EXECPROC, NotifyEventToPointer( Proc ),
Longint( ParamSender ) );
end;
Introduced method AsyncExecuteParallel is used for async parallel execution
(execution on selected thread) of method Proc with parameter ParamSender.
Method SyncExecuteParallel runs method Proc with parameter ParamSender synchronously (waits for execution).
The thread defines method for execution on main thread (AsyncExecuteMain, SyncExecuteMain).
Using
For example of using define class
type
TMainForm = class( TForm )
btnRandomize : TButton;
imgResult : TImage;
pbProgress : TProgressBar;
btnMulti : TButton;
procedure FormCreate( Sender : TObject );
procedure FormDestroy( Sender : TObject );
procedure btnRandomizeClick( Sender : TObject );
procedure btnMultiClick( Sender : TObject );
private
{ Private declarations }
FExecutingThread : TAxThread;
public
{ Public declarations }
procedure RandomizeBMP( Data : TObject );
procedure DoUpdate( Data : TObject );
procedure Progress( Data : TObject );
end;
Private variable FExecutingThread is thread on witch the metods will be executed.
There are three public method in form of TNotifyEvent (can be executed on selected thread).
procedure TMainForm.btnRandomizeClick( Sender : TObject );
var
PomBMP : TBitmap;
begin
if FExecutingThread = nil then
FExecutingThread := TAxThread.Create;
PomBMP := TBitmap.Create;
PomBMP.Width := ;
PomBMP.Height := ;
PomBMP.PixelFormat := pf24bit;
FExecutingThread.AsyncExecuteParallel( RandomizeBMP, PomBMP );
end;
When user clicked on button then method btnRandomizeClick is called.
Method calls AsyncExecuteParallel.
Main thread continue in responsing to user interaction.
When the thread contrext is switched, FExecutingThread begins execute then method RandomizeBMP.
procedure TMainForm.RandomizeBMP( Data : TObject );
var
CurrentThread : TAxThread;
PomBMP : TBitmap;
I : Longint;
X : Longint;
Y : Longint;
Color : Longint;
begin
if not( Data is TBitmap ) then
Exit;
PomBMP := Data as TBitmap;
CurrentThread := TAxThread.GetCurrentThread;
I := ;
try
PomBMP.Canvas.Lock;
while not CurrentThread.Terminated do
begin
Inc( I );
if I > MaxPoints then
Break;
X := Random( );
Y := Random( );
Color := Random( ) * * + Random( ) * + Random( );
if ( I mod ( MaxPoints div ) ) = then
CurrentThread.SyncExecuteMain( Progress, TObject( I ) );
// slow for demonstration
PomBMP.Canvas.Pixels[ X, Y ] := Color;
end;
finally
PomBMP.Canvas.Unlock;
CurrentThread.AsyncExecuteMain( DoUpdate, PomBMP );
end;
end;
Method RandomizeBMP decode parameter as Bitmap and fills it with some random points.
When randomize is finished, the thread notify main thread (CurrentThread.AsyncExecuteMain).
Conclusion
We present implementation of thread class for async (sync) execution.
The designed library has very effective method for developing of parallel computing.
unit AxThreads2; interface uses
Windows, Classes, SysUtils, Controls, Forms, Messages; const
CM_EXECPROC = $8FFF; type
TIdleEvent = procedure( var Data : TObject; var Done : Boolean ) of object; TAxThread = class( TThread )
private
FThreadID : Longint;
FOnIdle : TIdleEvent;
FIdleData : TObject;
FWndHandleParallel : LongWord;
FWndHandleMain : LongWord; FMethodsToExecute : Longint;
procedure SetOnIdle( const Value : TIdleEvent );
protected
procedure CreateHandleParallel;
procedure DestroyHandleParallel;
procedure CreateHandleMain;
procedure DestroyHandleMain; procedure MessageProcedure( var Message : TMessage ); virtual; procedure ExecProcedure( var Message : TMessage ); message CM_EXECPROC;
procedure Execute; override;
procedure Idle( var Data : TObject; var Done : Boolean ); virtual; function ProcessMessage( var Msg : TMsg ) : Boolean; function NotifyEventToPointer( Proc : TNotifyEvent ) : Longint;
public
constructor Create;
destructor Destroy; override; // Posts a null message to parallel thread
procedure WakeUp; class function GetCurrentThread : TAxThread;
// sends a message to main thread
function SendMessageMain( Msg, WParam, LParam : LongWord ) : Longint;
// posts a message to main thread
function PostMessageMain( Msg, WParam, LParam : LongWord ) : LongBool; // sends a message to parallel thread
function SendMessageParallel( Msg, WParam, LParam : LongWord ) : Longint;
// posts a message to parallel thread
function PostMessageParallel( Msg, WParam, LParam : LongWord ) : LongBool; // for compatibility
function SendMessage( Msg, WParam, LParam : LongWord ) : Longint;
function PostMessage( Msg, WParam, LParam : LongWord ) : LongBool; // Synchro execute on parallel thread
procedure SyncExecuteParallel( Proc : TNotifyEvent; ParamSender : TObject );
// Asynchro execute on parallel thread
procedure AsyncExecuteParallel( Proc : TNotifyEvent;
ParamSender : TObject ); // Synchro execute on main thread
procedure SyncExecuteMain( Proc : TNotifyEvent; ParamSender : TObject );
// Asynchro execute on main thread
procedure AsyncExecuteMain( Proc : TNotifyEvent; ParamSender : TObject ); // for compatibility
procedure SyncExecute( Proc : TNotifyEvent; ParamSender : TObject );
procedure AsyncExecute( Proc : TNotifyEvent; ParamSender : TObject ); // handle for main thread
property WndHandleMain : LongWord read FWndHandleMain; // handle for parallel thread
property WndHandleParallel : LongWord read FWndHandleParallel; // idle event for parallel thread
property OnIdle : TIdleEvent read FOnIdle write SetOnIdle; property MethodsToExecute : Longint read FMethodsToExecute; property Terminated;
end; implementation { TAxThread }
var
AxThreads : TThreadList; procedure TAxThread.CreateHandleParallel;
begin
FWndHandleParallel := AllocateHWnd( MessageProcedure );
end; procedure TAxThread.MessageProcedure( var Message : TMessage );
begin
Dispatch( message );
end; procedure TAxThread.DestroyHandleParallel;
begin
DeallocateHWnd( FWndHandleParallel );
FWndHandleParallel := ;
end; constructor TAxThread.Create;
begin
// this must by synchonized because of MainThread Context
FMethodsToExecute := ; inherited Create( False );
Synchronize( CreateHandleMain ); if AxThreads = nil then
AxThreads := TThreadList.Create; AxThreads.Add( Self );
end; destructor TAxThread.Destroy;
begin
Terminate;
WakeUp;
inherited;
DestroyHandleParallel;
DestroyHandleMain; AxThreads.Remove( Self );
end; procedure TAxThread.AsyncExecuteParallel( Proc : TNotifyEvent;
ParamSender : TObject );
begin
InterlockedIncrement( FMethodsToExecute );
PostMessageParallel( CM_EXECPROC, NotifyEventToPointer( Proc ),
Longint( ParamSender ) );
end; procedure TAxThread.SyncExecuteParallel( Proc : TNotifyEvent;
ParamSender : TObject );
begin
InterlockedIncrement( FMethodsToExecute );
SendMessageParallel( CM_EXECPROC, NotifyEventToPointer( Proc ),
Longint( ParamSender ) );
end; procedure TAxThread.ExecProcedure( var Message : TMessage );
var
PMethod : ^TMethod;
Method : TMethod;
Event : TNotifyEvent absolute Method;
begin
PMethod := Pointer( message.WParam ); Method := PMethod^;
Event( TObject( message.LParam ) ); Dispose( PMethod );
if FThreadID = GetCurrentThreadId then
InterlockedDecrement( FMethodsToExecute );
end; procedure TAxThread.Execute;
var
Msg : TMsg;
Done : Boolean;
begin
CreateHandleParallel;
FThreadID := GetCurrentThreadId; while not Terminated do
begin
if Done then
begin
FIdleData := nil;
WaitMessage;
end;
while ProcessMessage( Msg ) do { loop };
Idle( FIdleData, Done );
end;
end; procedure TAxThread.CreateHandleMain;
begin
FWndHandleMain := AllocateHWnd( MessageProcedure );
end; procedure TAxThread.DestroyHandleMain;
begin
DeallocateHWnd( FWndHandleMain );
FWndHandleMain := ;
end; procedure TAxThread.AsyncExecuteMain( Proc : TNotifyEvent;
ParamSender : TObject );
begin
PostMessageMain( CM_EXECPROC, NotifyEventToPointer( Proc ),
Longint( ParamSender ) );
end; procedure TAxThread.SyncExecuteMain( Proc : TNotifyEvent;
ParamSender : TObject );
begin
SendMessageMain( CM_EXECPROC, NotifyEventToPointer( Proc ),
Longint( ParamSender ) );
end; function TAxThread.PostMessageMain( Msg, WParam, LParam : LongWord ) : LongBool;
begin
Result := Windows.PostMessage( FWndHandleMain, Msg, WParam, LParam );
end; function TAxThread.PostMessageParallel( Msg, WParam, LParam : LongWord )
: LongBool;
begin
while FWndHandleParallel = do
SwitchToThread; Result := Windows.PostMessage( FWndHandleParallel, Msg, WParam, LParam );
end; function TAxThread.SendMessageMain( Msg, WParam, LParam : LongWord ) : Longint;
begin
Result := Windows.SendMessage( FWndHandleMain, Msg, WParam, LParam );
end; function TAxThread.SendMessageParallel( Msg, WParam, LParam : LongWord )
: Longint;
begin
while FWndHandleParallel = do
SwitchToThread; Result := Windows.SendMessage( FWndHandleParallel, Msg, WParam, LParam );
end; procedure TAxThread.Idle( var Data : TObject; var Done : Boolean );
begin
if Assigned( FOnIdle ) then
FOnIdle( Data, Done )
else
Done := True;
end; function TAxThread.ProcessMessage( var Msg : TMsg ) : Boolean;
begin
Result := False;
if PeekMessage( Msg, , , , PM_REMOVE ) then
begin
Result := True;
if Msg.Message <> WM_QUIT then
begin
TranslateMessage( Msg );
DispatchMessage( Msg );
end
else
Terminate;
end;
end; procedure TAxThread.SetOnIdle( const Value : TIdleEvent );
begin
FOnIdle := Value;
SendMessageParallel( , , );
end; procedure TAxThread.AsyncExecute( Proc : TNotifyEvent; ParamSender : TObject );
begin
AsyncExecuteParallel( Proc, ParamSender );
end; procedure TAxThread.SyncExecute( Proc : TNotifyEvent; ParamSender : TObject );
begin
SyncExecuteParallel( Proc, ParamSender );
end; function TAxThread.PostMessage( Msg, WParam, LParam : LongWord ) : LongBool;
begin
Result := PostMessageParallel( Msg, WParam, LParam );
end; function TAxThread.SendMessage( Msg, WParam, LParam : LongWord ) : Longint;
begin
Result := SendMessageParallel( Msg, WParam, LParam );
end; function TAxThread.NotifyEventToPointer( Proc : TNotifyEvent ) : Longint;
var
Method : TMethod absolute Proc;
PMethod : ^TMethod;
begin
New( PMethod );
PMethod^ := Method;
Result := Longint( PMethod );
end; procedure TAxThread.WakeUp;
begin
PostMessageParallel( , , );
end; class function TAxThread.GetCurrentThread : TAxThread;
var
PomList : TList;
PomIndex : Longint;
ThreadID : Longint;
begin
Result := nil;
if AxThreads = nil then
Exit; ThreadID := GetCurrentThreadId;
PomList := AxThreads.LockList;
try
for PomIndex := to PomList.Count - do
begin
Result := TAxThread( PomList[ PomIndex ] );
if Result.FThreadID = ThreadID then
Break;
Result := nil;
end;
finally
AxThreads.UnlockList;
end;
end; end.
TAxThread - Inter thread message based communication - Delphi的更多相关文章
- Thread message loop for a thread with a hidden window? Make AllocateHwnd safe
Thread message loop for a thread with a hidden window? I have a Delphi 6 application that has a thre ...
- WCF学习之旅—WCF中传统的异常处理(十六)
WCF中的异常处理 在软件开发过程中,不可能没有异常的出现,所以在开发过程中,对不可预知的异常进行解决时,异常处理显得尤为重要.对于一般的.NET系统来说,我们简单地借助try/catch可以很容易地 ...
- 【转】《我的WCF之旅》博文系列汇总
转自:http://www.cnblogs.com/artech/archive/2007/09/15/893838.html WCF是构建和运行互联系统的一系列技术的总称,它是建立在Web Serv ...
- REST is not the Best for Micro-Services GRPC and Docker makes a compelling case
原文:https://hackernoon.com/rest-in-peace-grpc-for-micro-service-and-grpc-for-the-web-a-how-to-908cc05 ...
- Four Ways to Create a Thread
Blaise Pascal Magazine Rerun #5: Four Ways to Create a Thread This article was originally written ...
- Inter-process Communication (IPC)
For Developers > Design Documents > Inter-process Communication (IPC) 目录 1 Overview 1.1 I ...
- [Delphi] Delphi版本号对照
VER300 Delphi Seattle / C++Builder Seattle 23 230 (Delphi:Win32/Win64/OSX/iOS32/iOS64/An ...
- Android Non-UI to UI Thread Communications(Part 2 of 5)
Original:http://www.intertech.com/Blog/android-non-ui-to-ui-thread-communications-part-2-of-5/ his i ...
- TMsgThread, TCommThread -- 在delphi线程中实现消息循环
http://delphi.cjcsoft.net//viewthread.php?tid=635 在delphi线程中实现消息循环 在delphi线程中实现消息循环 Delphi的TThread类使 ...
随机推荐
- OpenLayers调用ArcGIS Server发布的WFS服务
OpenLayers调用ArcGIS Server发布的WFS服务 原创: 蔡建良 2013-08-20 一. 开发环境 1) Openlayers2.13+arcgis server9.3 2) W ...
- RDoc
RDoc - Ruby Documentation System home github.com/rdoc/rdoc rdoc docs.seattlerb.org/rdoc bugs github. ...
- Maven安装testNG
1.Maven安装testNG (1)打开网站:http://testng.org/doc/maven.html (2)复制如下代码,粘贴到项目的pom.xml文件: 1 <dependency ...
- windows下ncl生成tiff图(案例)
一:安装软件和准备数据 1.需要安装Vapor(注意安装路径不要存在空格) 注:版本2.4.2及以后 2.安装NCL,方法见http://www.cnblogs.com/striver-zhu/p/4 ...
- 使用java开源工具httpClient及jsoup抓取解析网页数据
今天做项目的时候遇到这样一个需求,需要在网页上展示今日黄历信息,数据格式如下 公历时间:2016年04月11日 星期一 农历时间:猴年三月初五 天干地支:丙申年 壬辰月 癸亥日 宜:求子 祈福 开光 ...
- 整合git与wingIDE(代码下载)
通过多次被IDE的闪退崩溃甚至无教程调教后,我深刻认识到开发wingIDE这种IDE的小公司,在很多功能方面就是个坑…… 所以,如果你的电脑比较好,运行pycharm无压力,建议略过此文,直接去用py ...
- Linux 下C++编写
今天搞了一天Linux下C++编程,还没有什么成效.好烦躁好心焦,想砸电脑的冲动.抽根烟理下思路一定要把它拿下!! ===搞了两天,真是搞到生无可恋,试了共享文件, 试了网络配置,各种博客就是各种行不 ...
- Android Capture Android System Audio
项目需要获取播放视频的实时音量值,最简捷的方法是监听音频输出端,取得音频输出流,再进行转换. 调查时,首先找到这篇博客: http://blog.csdn.net/jinzhuojun/article ...
- Python实现模拟登陆
大家经常会用Python进行数据挖掘的说,但是有些网站是需要登陆才能看到内容的,那怎么用Python实现模拟登陆呢?其实网路上关于这方面的描述很多,不过前些日子遇到了一个需要cookie才能登陆的网站 ...
- HDOJ-ACM1009(JAVA) (传说中的贪心算法)分为数组实现 和 封装类实现
转载声明:原文转自:http://www.cnblogs.com/xiezie/p/5564311.html 这个道题有几点要注意的: 数组存放的类型:float或double 打印的格式:(如果只是 ...