关于线程中图片内容丢失的问题 ???(200分)

tonmy · 2003-05-12

做了一个用线程代替时钟实现动画的程序，
发现保存在内存中的图片经过多次Draw到Canvas后
图片内容变成空白的了（只对大图片，小图片几乎不出现）

有没人遇到过类似的问题？怎解决？

以下是程序:

线程单元:
unit Unit2;

interface
uses
Classes,windows;

type

TThreadedTimer = class;

{ 线程时钟专用之时钟线程 }
TTimerThread = class(TThread)
OwnerTimer: TThreadedTimer;
procedure Execute; override;
procedure DoTimer;
end;

{
TThreadedTimer ：线程时钟
缺省定时1秒种，创建后即运行，线程挂起,优先级普通
}
TThreadedTimer = class(TComponent)
private
FEnabled : Boolean;
FInterval : Word;
FOnTimer : TNotifyEvent;
FTimerThread : TTimerThread;
FThreadPriority : TThreadPriority;
protected
procedure UpdateTimer;
procedure SetEnabled(Value: Boolean);
procedure SetInterval(Value: Word);
procedure SetOnTimer(Value: TNotifyEvent);
procedure SetThreadPriority(Value: TThreadPriority);
procedure Timer; dynamic;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Enabled: Boolean read FEnabled write SetEnabled;
property Interval: Word read FInterval write SetInterval;
property OnTimer: TNotifyEvent read FOnTimer write SetOnTimer;
property ThreadPriority: TThreadPriority read FThreadPriority write SetThreadPriority;
end;

implementation

{-----------------以下为线程时钟说明----------------------}
{初始化,缺省定时1秒种，创建后即运行，线程挂起,优先级普通}
constructor TThreadedTimer.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FEnabled := True;
FInterval := 1000;
FThreadPriority := tpNormal;
FTimerThread := TTimerThread.Create(False);
FTimerThread.OwnerTimer := Self;
FTimerThread.Suspend;
end;

{线程执行，进入休眠直至被特定内部时钟唤醒，对I/O回调无反应}
procedure TTimerThread.Execute;
begin
Priority := OwnerTimer.FThreadPriority;
repeat
//Sleep(OwnerTimer.FInterval);
SleepEx(OwnerTimer.FInterval, False);
//Synchronize(DoTimer);
DoTimer;
until Terminated;
end;

{同步线程时钟的Ontimer事件}
procedure TTimerThread.DoTimer;
begin
OwnerTimer.Timer;
end;

{控制线程是否挂起}
procedure TThreadedTimer.UpdateTimer;
begin
if not FTimerThread.Suspended then FTimerThread.Suspend;
if (FInterval <> 0) and FEnabled
and Assigned(FOnTimer) then
FTimerThread.Resume;
end;

{确定是否工作}
procedure TThreadedTimer.SetEnabled(Value: Boolean);
begin
if Value <> FEnabled then
begin
FEnabled := Value;
UpdateTimer;
end;
end;

{对定时时间赋值}
procedure TThreadedTimer.SetInterval(Value: Word);
begin
if Value <> FInterval then
begin
FInterval := Value;
UpdateTimer;
end;
end;

{对OnTimer事件赋值}
procedure TThreadedTimer.SetOnTimer(Value: TNotifyEvent);
begin
FOnTimer := Value;
UpdateTimer;
end;

{设置线程优先级}
procedure TThreadedTimer.SetThreadPriority(Value: TThreadPriority);
begin
if Value <> FThreadPriority then
begin
FThreadPriority := Value;
UpdateTimer;
end;
end;

{定时激发用户的外部过程}
procedure TThreadedTimer.Timer;
begin
if Assigned(FOnTimer) then
FOnTimer(Self);
end;

{资源释放}
destructor TThreadedTimer.Destroy;
begin
FEnabled := False;
UpdateTimer;
FTimerThread.Free;
inherited Destroy;
end;

end.

主控单元：
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,unit2, StdCtrls, jpeg, ExtCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
PaintBox1: TPaintBox;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
procedure OnTimer1(Sender:TObject);
procedure OnTimer2(sender:tobject);
end;

var
Form1: TForm1;

implementation
var
T1:TThreadedTimer;
T2:TThreadedTimer;
k1:integer=0;
k2:integer=0;
i1:integer=0;
i2:integer=0;
B:Tbitmap;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
T1.Enabled := not T1.Enabled;
T2.Enabled := not T2.Enabled;
K1:=0;
K2:=0;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
B:=TBitmap.Create;
B.LoadFromFile('C:/Documents and Settings/Administrator/My Documents/My Pictures/样品.BMP');
T1:=TThreadedTimer.Create(nil);
T1.OnTimer := OnTimer1;
T1.Interval := 100;
T1.ThreadPriority := tpHighest;

T2:=TThreadedTimer.Create(nil);
T2.OnTimer := OnTimer2;
T2.Interval := 100;
T2.ThreadPriority := tpHighest;
end;

procedure TForm1.OnTimer1(Sender: TObject);
var
B1:TBitmap;
begin
// with paintbox1 do
begin
if Canvas.LockCount > 1 then exit;
try
Canvas.Lock;
canvas.TextOut(0,0,inttostr(gettickCount-i1));
i1:=gettickcount;
// B.LoadFromFile('C:/Documents and Settings/Administrator/My Documents/My Pictures/样品.BMP');

//经过一段时间后下面语句不再画出的图形,为什么？
Canvas.Draw(k1,0,B);//StretchDraw(Rect(K1,0,400+K1,300),B);//

B1:=TBitmap.Create ;
B1.Width := B.Width ;
B1.Height := B.Height;
B1.Canvas.Draw(0,0,B);

//经过一段时间后下面画出的图是空白的，说明B图是空的，为什么？
Canvas.StretchDraw(Rect(K1,100,200+K1,200),B1);//Draw(k1,0,B1);//
B1.Free;
inc(k1,2);
if K1>width -200 then k1:=0;
finally
Canvas.Unlock;
end;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
i:integer;
begin
//测试线程独立性
for i:= 0 to 1000 do
Sleep(4);
end;

procedure TForm1.OnTimer2(sender: tobject);
var
B2:Tbitmap;
begin
with paintbox1 do
begin
if Canvas.LockCount > 1 then exit;
Canvas.Lock;
canvas.TextOut(0,0,inttostr(gettickCount-i2));
i2:=gettickcount;
B2:=TBitmap.Create;
B2.LoadFromFile('C:/Documents and Settings/Administrator/My Documents/My Pictures/样品.BMP');
//采用每次都从文件读取图片不出现丢失。
Canvas.Draw(k2,0,B2);//StretchDraw(Rect(K2,0,400+K2,300),B);//
B2.Free;
inc(k2,2);
if k2>width -200 then k2:=0;
Canvas.Unlock;
end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
T1.Enabled :=False;
T2.Enabled :=False;
end;

end.

lookee · 2003-05-12

将线程时钟excute函数中的
//Synchronize(DoTimer);
DoTimer;
改成
Synchronize(DoTimer);
//DoTimer;
试试

tonmy · 2003-05-12

不成
这样的话和用时钟控制没什么两样的了，起不到线程效果，
当起动其它占用较长时间的工作时，动画就停止了！(可以用Sleep测试是否是独立的线程)

其实我要做的是类似IE右上角那个图标类似的效果

lookee · 2003-05-12

B1的Canvas 是不是也应该Lock亚

thx1180 · 2003-05-13

改了一下，你自己试试看看：

线程单元:
unit Unit2;

interface
uses
Classes,windows;

type

TThreadedTimer = class;

{ 线程时钟专用之时钟线程 }
TTimerThread = class(TThread)
OwnerTimer: TThreadedTimer;
protected
procedure Execute; override;
procedure DoTimer;
end;

{
TThreadedTimer ：线程时钟
缺省定时1秒种，创建后即运行，线程挂起,优先级普通
}
TThreadedTimer = class(TComponent)
private
FEnabled : Boolean;
FInterval : Word;
FOnTimer : TNotifyEvent;
FTimerThread : TTimerThread;
FThreadPriority : TThreadPriority;
protected
procedure UpdateTimer;
procedure SetEnabled(Value: Boolean);
procedure SetInterval(Value: Word);
procedure SetOnTimer(Value: TNotifyEvent);
procedure SetThreadPriority(Value: TThreadPriority);
procedure Timer; dynamic;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Enabled: Boolean read FEnabled write SetEnabled;
property Interval: Word read FInterval write SetInterval;
property OnTimer: TNotifyEvent read FOnTimer write SetOnTimer;
property ThreadPriority: TThreadPriority read FThreadPriority write SetThreadPriority;
end;

implementation

{-----------------以下为线程时钟说明----------------------}
{初始化,缺省定时1秒种，创建后即运行，线程挂起,优先级普通}
constructor TThreadedTimer.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FEnabled := True;
FInterval := 1000;
FThreadPriority := tpNormal;
FTimerThread := TTimerThread.Create(True);
FTimerThread.OwnerTimer := Self;
FTimerThread.Resume;
end;

{线程执行，进入休眠直至被特定内部时钟唤醒，对I/O回调无反应}
procedure TTimerThread.Execute;
begin
Priority := OwnerTimer.FThreadPriority;
repeat
Sleep(OwnerTimer.FInterval);
//SleepEx(OwnerTimer.FInterval, False);
Synchronize(DoTimer);
//DoTimer;
until Terminated;
end;

{同步线程时钟的Ontimer事件}
procedure TTimerThread.DoTimer;
begin
OwnerTimer.Timer;
end;

{控制线程是否挂起}
procedure TThreadedTimer.UpdateTimer;
begin
if not FTimerThread.Suspended then
FTimerThread.Suspend;
if (FInterval <> 0) and FEnabled and Assigned(FOnTimer) then
FTimerThread.Resume;
end;

{确定是否工作}
procedure TThreadedTimer.SetEnabled(Value: Boolean);
begin
if Value <> FEnabled then
begin
FEnabled := Value;
UpdateTimer;
end;
end;

{对定时时间赋值}
procedure TThreadedTimer.SetInterval(Value: Word);
begin
if Value <> FInterval then
begin
FInterval := Value;
UpdateTimer;
end;
end;

{对OnTimer事件赋值}
procedure TThreadedTimer.SetOnTimer(Value: TNotifyEvent);
begin
FOnTimer := Value;
UpdateTimer;
end;

{设置线程优先级}
procedure TThreadedTimer.SetThreadPriority(Value: TThreadPriority);
begin
if Value <> FThreadPriority then
begin
FThreadPriority := Value;
UpdateTimer;
end;
end;

{定时激发用户的外部过程}
procedure TThreadedTimer.Timer;
begin
if Assigned(FOnTimer) then
FOnTimer(Self);
end;

{资源释放}
destructor TThreadedTimer.Destroy;
begin
FEnabled := False;
UpdateTimer;
//中止线程;
FTimerThread.Terminate;
FTimerThread.Free;
inherited Destroy;
end;

end.

主控单元：
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
PaintBox1: TPaintBox;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure OnTimer1(Sender:TObject);
private
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

var
T1:TThreadedTimer;
k1:integer=0;
i1:integer=0;
B:Tbitmap;
TmpBmp: TBitmap;

procedure TForm1.Button1Click(Sender: TObject);
begin
T1.Enabled := not T1.Enabled;
K1:=0;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
B:=TBitmap.Create;
B.LoadFromFile('D:/Photo/JJFZ/851476b.bmp');
T1:=TThreadedTimer.Create(Self);
T1.Enabled :=False;
T1.OnTimer := OnTimer1;
T1.Interval := 10;
T1.ThreadPriority := tpHighest;
TmpBmp:=TBitmap.Create;
TmpBmp.Width := B.Width;
TmpBmp.Height := B.Height;
T1.Enabled :=True;
end;

procedure TForm1.OnTimer1(Sender: TObject);
begin
// with paintbox1 do
begin
if Canvas.LockCount > 1 then exit;
Canvas.Lock;
try
// canvas.TextOut(0,0,inttostr(gettickCount-i1));
// i1:=gettickcount;
TmpBmp.Canvas.Draw(0, 0, B);
TmpBmp.Canvas.StretchDraw(Rect(K1,100,200+K1,200), B);

Canvas.Draw(0, 0, TmpBmp);

inc(k1,1);
if K1 > width - 200 then k1 := 0;
finally
Canvas.Unlock;
end;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
i:integer;
begin
//测试线程独立性
for i:= 0 to 1000 do
Sleep(4);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
T1.Enabled :=False;
// T1.Free;
TmpBmp.Free;
end;

end.

tonmy · 2003-05-15

thx1180的方法还是不能解决，
首先线程时钟excute函数中的
//Synchronize(DoTimer);
DoTimer;
不能改成
Synchronize(DoTimer);
//DoTimer;
因为用Synchronize同步之后不就是独立的线程了，
可以单击Button2看看就知道了（界面不能动，动画也停止了）

我现在找到的方法是Draw之前每个图片都Lock，
完成之后再UnLock，基本上不出问题了。
我想知道图片内容丢失的原因，为什么Lock之后就没问题？

lookee · 2003-05-15

canvas这样的资源是临界资源，应该避免多线程访问
我发现你的ontimer中的
if Canvas.LockCount > 1 then exit;
意思大概是想把整个ontimer变成临界区
如果是那样的话，这句话应该是
if Canvas.LockCount > 0 then exit;
否则行同虚设，难免发生什么读后写，写后写什么的。。。

thx1180 · 2003-05-15

那你就不要在线程中直接操作VCL了，发个消息给主线程就行了。

tonmy · 2003-09-17

多人接受答案了。

关于线程中图片内容丢失的问题 ???(200分)

tonmy

Unregistered / Unconfirmed

lookee

Unregistered / Unconfirmed

tonmy

Unregistered / Unconfirmed

lookee

Unregistered / Unconfirmed

thx1180

Unregistered / Unconfirmed

tonmy

Unregistered / Unconfirmed

lookee

Unregistered / Unconfirmed

thx1180

Unregistered / Unconfirmed

tonmy

Unregistered / Unconfirmed

Similar threads