临界代码:如何让一段代码只让一个消息处理?(200分)

  • 主题发起人 tigerfox
  • 开始时间
T

tigerfox

Unregistered / Unconfirmed
GUEST, unregistred user!
有一段代码: 是向ListBox一行行append地添加数据。
通过调试发现,总是出现“List Index out of Bounds”错误,访问越界。
下面为这段代码:
procedure TMainFrm.AddDebugInfo( strInfo : string ) ;
var
i,len,start: integer;
strTemp : string;
bMultiRow : boolean;
begin
bMultiRow := true;
start := 0;
len := length(strInfo);
for i:=0 to lendo
begin
if ( strInfo = #10 ) then
begin
strTemp := copy(strInfo,start,i-start) ;
if ( not bMultiRow ) then
strTemp := ' ' + strTemp;
ListBox_Debug.Items.Append(strTemp);
start := i+1;
bMultiRow := false;
end
end ;
if bMultiRow then
ListBox_Debug.Items.Append(strInfo);
end;
调用的地方很多,也可能是同时的, 类似为
AddDebugInfo('LoginSuccessed -- '+#10+'param:'+param);
// param : string;
如果有两个以上的同时调用就会出现上述错误。
有没有,一个代码一段时间只处理一次调用,其它的调用等上一次处理完成再调用。就是实现一个排队功能。
 
没人知道吗?
 
use TRTLCriticalSection
 
用EnterCriticalSection, 會等待,直到得到臨界量,
在你的AddDebugInfo中加入
EnterCriticalSection(ReadWriteCS);
try
...
finally
LeaveCriticalSection(ReadWriteCS);

...

var
ReadWriteCS: TRTLCriticalSection;
begin
InitializeCriticalSection(ReadWriteCS);

begin
DeleteCriticalSection(ReadWriteCS);

 
加一个全局变量来实现:
var
bbusing: boolean;

procedure TMainFrm.create;
begin
bbusing:=false;
end;

procedure TMainFrm.AddDebugInfo( strInfo : string ) ;
var
i,len,start: integer;
strTemp : string;
bMultiRow : boolean;
begin
if bbusing then
exit else
bbusing:=true;
{ 你的代码...
}
bbusing:=false;
end;

 
to : Aiirii
我试了一下,好像不行呀
to laoyou
这样会丢失数据
 
你說的不行?是什麼意思??你將主要代碼貼出來, 還有, 其中的
ReadWriteCS: TRTLCriticalSection;
要聲明成全局變量, 一開始就要初始化, 才能用!
 
冲突点有两个:
1.同时两个线程append同一个listbox.
2.主线程正在显示ListBox中内容(屏幕重画),同时有个线程在Append数据。
用Criticalsection只能解决第一种冲突。因为主线程画屏幕时可没有调用你的CriticalSection。
要同步的方式要么用TThread.Synchronize来同步append的过程,要么给主线程发消息,通知主线程来append数据,总之你必须用单线程的方式来对listbox进行append
 
多谢大家。
to Another_eYes
其实没那么麻烦,对于任意一个append,listbox本身都是同步的(这点可用spy++验证,listbox在append时的sendmessage处理的),我需要的是一些连继的append,此操作不能被其它消息打断。

此问题我已自己解决。非listbox问题,
 
我以前也遇到这个问题,是通讯中利用memo显示通讯内容,不知道tigerfox是怎么解决的,可否贴出来看看!
 
同步到主线程synchronize;
 

Similar threads

S
回复
0
查看
958
SUNSTONE的Delphi笔记
S
S
回复
0
查看
779
SUNSTONE的Delphi笔记
S
S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
顶部