做了一个用线程代替时钟实现动画的程序,
发现保存在内存中的图片经过多次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;interfaceuses
  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.

解决方案 »

  1.   

    你碰到了与我同样的问题。我也是用线程控制多个图形的显示并加入效果,在win98下没有问题,而win2000下图形突然显示会不完全,好象线程被打断一样。不过,像你可以将画图事件用一个控件事件来实现,而线程用来触发控件事件,即将其独立出来,应该没有问题。而我不幸,如果独立出来,多个画图事件会有先后,不能同时进行。
      

  2.   

    我已经找到解决办法了,就是画之前将每个涉及的Canvas都Lock,画完之后再UnLock。
    并且对不能被外部访问的Canvas的LockCount进行判断,>0就Exit过程,什么都不做.
    如上面的OnTimer1应该这样写:
    if B.Canvas.LockCount > 0 then exit;
      try
        Canvas.Lock;
        B.Canvas.Lock;
        {
         在这做画图操作
         }
      finally
        Canvas.Unlock;
        B.Canvas.Unlock;
      end;
      

  3.   

    可我还是不明白,为什么每个Canvas都要Lock才行,否则Canvas会变空白了
    为什么会变空白了?