控件中线程问题（急）,在线等待 (100分)

我写了一个控件，本来用TTimer,发现TTimer的效率很低，修改成线程以后，发现线程每关闭再打开一次，执行速度就增加，越来越快。谁可以帮我修改一下。
Thread 时代码如下（有问题，越来越快，是用Thread.terminate，无论加在哪里都提示线程错误！）：
unit ShowImg;

Interface

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

type
TShowType=(stTopDown,stDownTop,stLeftRight,stRightLeft, stTopMove,stDownMove,
stLeftMove,stRightMove,stDrcShow,stAlwayTop,stAlwayLeft,stVClose,stVOpen,
stHClose,stHOpen,stHWindow,stVWindow, stLine, stRow,stHCross,stVCross,
stRecClose,stCrossOpen,stMove);


type
TShowImg = class(TGraphicControl)
private
fInterval: Integer;
fShowImg:TBitmap; //图象
fBackImg: TBitmap;
fOffSrc: TBitMap;
fActive: Boolean;
fShowType: TShowType;
fBusy: Boolean;
fStep: Integer;
fThread:TThread;
fThreaded:Boolean;
// fThreadPro:TThreadPriority;
procedure SetShowImg(V: TBitMap);
procedure SetInterval(V: LongInt);
procedure SetActive(V: Boolean);
procedure SetShowTimer;
procedure ReSetShowTimer;
procedure SetShowType(V: TShowType);
procedure SetBackImg(V: TBitMap);
procedure PaintOffSrc;
procedure ThreadDone(Sender:TObject);
procedure ShowImg;
procedure SetThreaded(V:Boolean);
{ Private declarations }
protected
procedure Paint; override;
{ Protected declarations }
public
constructor Create(AOwner:TComponent);override;
destructor Destroy;override;
{ Public declarations }
published
property ShowBitMap: TBitmap Read fShowImg Write SetShowImg;
property BackBitMap: TBitmap read fBackImg Write SetBackImg;
property Interval: LongInt read fInterval Write SetInterval default 10;
// property ThreadPro: TThreadPriority read fThreadPro
property Active : Boolean read fActive Write SetActive default False;
property ShowType: TShowType read fShowType Write SetShowType default stDrcShow;
property Threaded: Boolean read fThreaded write SetThreaded default True;
{ Published declarations }
end;

type
TShowThread=class(TThread)
private
fBox:TShowImg;
public
constructor Create(Box: TShowImg);
procedure Execute; override;
end;
{
var
fThread:TThread;}

Procedure Register ;

implementation

constructor TShowThread.Create(Box: TShowImg);
begin
fBox:=Box;
OnTerminate:=fBox.ThreadDone;
//Priority:=tpNormal;
FreeOnTerminate:=True;
inherited Create(False);
end;

procedure TShowThread.Execute;
begin
repeat
//Priority:=tpNormal;
fbox.ShowImg;
if Terminated then begin
// fBox:=nil;
Exit;
end;
Until False;
end;

constructor TShowImg.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
Parent:=TWinControl(AOwner);
fShowImg:=TBitMap.Create;
fBackImg:=TBitMap.Create;
fOffSrc:=TBitMap.Create;
fShowType:=stDrcShow;
fThreaded:=True;
fBusy:=False;
fInterval:=10;
end;

destructor TShowImg.Destroy;
begin
fActive:=False;
if fBusy then fThread:=Nil;
fShowImg.Free;
fBackImg.Free;
fOffSrc.Free;
inherited Destroy;
end;

procedure TShowImg.SetThreaded(V:Boolean);
begin
fThreaded:=V;
end;

procedure TShowImg.ShowImg;
begin
Paint;
fStep:=fStep+1;
Sleep(Interval);
end;

procedure TShowImg.ThreadDone(Sender:TObject);
begin
fActive:=False;
fBusy:=False;
fThread:=Nil;
end;

procedure TShowImg.SetShowType(V: TShowType);
begin
if fShowType<>V then begin
fShowType:=V;
fActive:=False;
ReSetShowTimer;
end;
end;

procedure TShowImg.SetShowImg(V: TBitMap);
begin
if (Assigned(fShowimg)) then begin
fShowimg.Assign(V);
fActive:=False;
ReSetShowTimer;
end;
end;

procedure tShowImg.Paint;
begin
if fActive then begin
PaintOffSrc;
Canvas.Draw(0,0,fOffSrc);
end else Canvas.Draw(0,0,fBackImg);
end;

procedure TShowImg.SetBackImg(V: TBitMap);
begin
if (Assigned(fBackimg)) then begin
fBackimg.Assign(V);
end;
end;

procedure TShowImg.SetInterval(V: LongInt);
begin
fInterval:= V;
end;

procedure TShowImg.SetActive(V: Boolean);
begin
if Assigned(fShowImg) then if fShowImg.Empty then Exit;
fActive:=V;
if fActive then begin
if not fBusy then begin
SetShowTimer;
end;
end else ReSetShowTimer;
end;

procedure TShowImg.SetShowTimer;
var
StartTime: Cardinal;
begin
Canvas.Draw(0,0,fBackImg);
fOffSrc.Width:=Width;
fOffSrc.Height:=Height;
fStep:=0;
fBusy:=True;
if fThreaded then
fThread:=TShowThread.Create(Self)
else begin
repeat
StartTime := GetTickCount;
ShowImg;
repeat
Application.ProcessMessages;
until (((GetTickCount - StartTime) > fInterval) or (fActive=False));
Until (fActive=False);
end;
end;

procedure TShowImg.ReSetShowTimer;
begin
Canvas.Draw(0,0,fBackImg);
fOffSrc.Canvas.CopyRect(Rect(0,0,Width,Height),fBackImg.Canvas,Rect(0,0,Width,Height));
if fBusy then begin
fStep:=0;
fBusy:=False;
fThread:=Nil;
end;
end;

procedure TShowImg.PaintOffSrc;
var
r,t:TRect;
wv,hv,av:Integer;
i1,i2:Integer;
begin
Case fShowType of
stTopDown: //上翻入
begin
r.Left:=0;
r.Right:=fShowImg.Width;
r.Top:=0;
r.Bottom:=fStep;
fOffSrc.Canvas.CopyRect(r,fShowImg.Canvas,r);
if fStep>=fShowImg.Height then begin
fStep:=-1;
fOffSrc.Canvas.Draw(0,0,fBackImg);
end;
end;
end;
end;

procedure Register ;
begin
RegisterComponents('D6Tools', [TShowImg]) ;
end ;

end.

哈哈！
你在ReSetShowTimer中并没有关闭线程，这样你每SetShowTimer一次，就增加一个线程画，结果线程越来越多，画同一个东西，当然速度越来越快。
这样改：
procedure TShowImg.ReSetShowTimer;
begin
Canvas.Draw(0,0,fBackImg);
fOffSrc.Canvas.CopyRect(Rect(0,0,Width,Height),fBackImg.Canvas,Rect(0,0,Width,Height));
if fBusy then begin
fStep:=0;
fBusy:=False;
fthread.Terminate;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
fThread:=Nil;
end;
end;

加上terminate会出错。

fthread.Terminate;
fthread.waitfor;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
fThread:=Nil;

还是不正确，楼上的兄弟，把代码复制就可以用，帮我看看吧。提示 线程错误。一直不知道如何去修改。谢谢！

我帮你改了一下：
1、你的问题是线程的释放有问题，你看红色代码部分，有三处。
2、就算这样改，你的实现还是有问题，在线程中使用vcl主件的问题。
unit ShowImg;

Interface

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

type
TShowType=(stTopDown,stDownTop,stLeftRight,stRightLeft, stTopMove,stDownMove,
stLeftMove,stRightMove,stDrcShow,stAlwayTop,stAlwayLeft,stVClose,stVOpen,
stHClose,stHOpen,stHWindow,stVWindow, stLine, stRow,stHCross,stVCross,
stRecClose,stCrossOpen,stMove);


type
TShowImg = class(TGraphicControl)
private
fInterval: Integer;
fShowImg:TBitmap; //图象
fBackImg: TBitmap;
fOffSrc: TBitMap;
fActive: Boolean;
fShowType: TShowType;
fBusy: Boolean;
fStep: Integer;
fThread:TThread;
fThreaded:Boolean;
// fThreadPro:TThreadPriority;
procedure SetShowImg(V: TBitMap);
procedure SetInterval(V: LongInt);
procedure SetActive(V: Boolean);
procedure SetShowTimer;
procedure ReSetShowTimer;
procedure SetShowType(V: TShowType);
procedure SetBackImg(V: TBitMap);
procedure PaintOffSrc;
procedure ThreadDone(Sender:TObject);
procedure ShowImg;
procedure SetThreaded(V:Boolean);
{ Private declarations }
protected
procedure Paint; override;
{ Protected declarations }
public
constructor Create(AOwner:TComponent);override;
destructor Destroy;override;
{ Public declarations }
published
property ShowBitMap: TBitmap Read fShowImg Write SetShowImg;
property BackBitMap: TBitmap read fBackImg Write SetBackImg;
property Interval: LongInt read fInterval Write SetInterval default 10;
// property ThreadPro: TThreadPriority read fThreadPro
property Active : Boolean read fActive Write SetActive default False;
property ShowType: TShowType read fShowType Write SetShowType default stDrcShow;
property Threaded: Boolean read fThreaded write SetThreaded default True;
{ Published declarations }
end;

type
TShowThread=class(TThread)
private
fBox:TShowImg;
public
constructor Create(Box: TShowImg);
procedure Execute; override;
end;
{
var
fThread:TThread;}

Procedure Register ;

implementation

constructor TShowThread.Create(Box: TShowImg);
begin
fBox:=Box;
OnTerminate:=fBox.ThreadDone;
//Priority:=tpNormal;
[red] // FreeOnTerminate:=True;[/red]
inherited Create(False);
end;

procedure TShowThread.Execute;
begin
repeat
//Priority:=tpNormal;
fbox.ShowImg;
if Terminated then begin
// fBox:=nil;
Exit;
end;
Until False;
end;

constructor TShowImg.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
Parent:=TWinControl(AOwner);
fShowImg:=TBitMap.Create;
fBackImg:=TBitMap.Create;
fOffSrc:=TBitMap.Create;
fShowType:=stDrcShow;
fThreaded:=True;
fBusy:=False;
fInterval:=10;
end;

destructor TShowImg.Destroy;
begin
fActive:=False;
if fBusy then fThread:=Nil;
fShowImg.Free;
fBackImg.Free;
fOffSrc.Free;
inherited Destroy;
end;

procedure TShowImg.SetThreaded(V:Boolean);
begin
fThreaded:=V;
end;

procedure TShowImg.ShowImg;
begin
Paint;
fStep:=fStep+1;
Sleep(Interval);
end;

procedure TShowImg.ThreadDone(Sender:TObject);
begin
fActive:=False;
fBusy:=False;
[red] //fThread:=Nil;[/red]
end;

procedure TShowImg.SetShowType(V: TShowType);
begin
if fShowType<>V then begin
fShowType:=V;
fActive:=False;
ReSetShowTimer;
end;
end;

procedure TShowImg.SetShowImg(V: TBitMap);
begin
if (Assigned(fShowimg)) then begin
fShowimg.Assign(V);
fActive:=False;
ReSetShowTimer;
end;
end;

procedure tShowImg.Paint;
begin
if fActive then begin
PaintOffSrc;
Canvas.Draw(0,0,fOffSrc);
end else Canvas.Draw(0,0,fBackImg);
end;

procedure TShowImg.SetBackImg(V: TBitMap);
begin
if (Assigned(fBackimg)) then begin
fBackimg.Assign(V);
end;
end;

procedure TShowImg.SetInterval(V: LongInt);
begin
fInterval:= V;
end;

procedure TShowImg.SetActive(V: Boolean);
begin
if Assigned(fShowImg) then if fShowImg.Empty then Exit;
fActive:=V;
if fActive then begin
if not fBusy then begin
SetShowTimer;
end;
end else ReSetShowTimer;
end;

procedure TShowImg.SetShowTimer;
var
StartTime: Cardinal;
begin
Canvas.Draw(0,0,fBackImg);
fOffSrc.Width:=Width;
fOffSrc.Height:=Height;
fStep:=0;
fBusy:=True;
if fThreaded then
fThread:=TShowThread.Create(Self)
else begin
repeat
StartTime := GetTickCount;
ShowImg;
repeat
Application.ProcessMessages;
until (((GetTickCount - StartTime) > fInterval) or (fActive=False));
Until (fActive=False);
end;
end;

procedure TShowImg.ReSetShowTimer;
begin
Canvas.Draw(0,0,fBackImg);
fOffSrc.Canvas.CopyRect(Rect(0,0,Width,Height),fBackImg.Canvas,Rect(0,0,Width,Height));
if fBusy then begin
fStep:=0;
fBusy:=False;
[red] if Assigned(fThread) then
begin
fThread.Terminate;
fThread.WaitFor;
// fThread:=Nil;
FreeAndNil(fThread);
end;[/red] end;
end;

procedure TShowImg.PaintOffSrc;
var
r,t:TRect;
wv,hv,av:Integer;
i1,i2:Integer;
begin
Case fShowType of
stTopDown: //上翻入
begin
r.Left:=0;
r.Right:=fShowImg.Width;
r.Top:=0;
r.Bottom:=fStep;
fOffSrc.Canvas.CopyRect(r,fShowImg.Canvas,r);
if fStep>=fShowImg.Height then begin
fStep:=-1;
fOffSrc.Canvas.Draw(0,0,fBackImg);
end;
end;
end;
end;

procedure Register ;
begin
RegisterComponents('D6Tools', [TShowImg]) ;
end ;

end.

非常 感谢 ！调用VCL主件确实是问题。不过，这个可以暂时不用考虑。