做了一个用线程代替时钟实现动画的程序,
发现保存在内存中的图片经过多次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.
发现保存在内存中的图片经过多次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.
解决方案 »
- 关于主机网络连接的判断程序
- Client端的interface not supported错误!
- delphi5和delphi7可否同时装在xp下,有什么要注意的么?
- 主从表结构中,主表和从表通过一id号关联,如果主表改变了原来已有记录的id号,那么从表的id号如何才能合理地更新为新的id号?
- ★★不让标题栏显示在任务栏都有什么方法?
- 如果我给TreeNode.Data指定了一个类的实例,还用在释放时freemem或dispose吗?
- 如何将多个图片压缩成为mepg格式的影像文件?1000分!一定给!
- 怎样用ado连接远程的sql server,怎样配置?(马上结账!)
- CSDN论坛助手是怎么实现的?
- 急!求带CHECKBOX的TREEVIEW控件!
- 怎么样叫学好了delphi?
- 在哪能找到delphi的最新下载软件
并且对不能被外部访问的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;
为什么会变空白了?