在子线程中调用主界面的多个Tpaintbox画图，paintbox显示的图像会出现停顿的现象，请高手们帮帮忙！ ( 积分: 300 )

  • 主题发起人 jiangxzjh
  • 开始时间
J

jiangxzjh

Unregistered / Unconfirmed
GUEST, unregistred user!
我想实现主界面上多个paintbox同时显示图片特效（就像马赛克、百叶窗之类的效果）。
我使用子线程在paintbox上作图，线程开始后，如果不在界面上进行任何操作，则显示正
常，但是只要在界面上随便动一下（就算移动一下鼠标都不行），paintbox上的图像就会停顿，不知道为什么。现在把源代码附上，请高手们帮我看看。300分酬谢！！！很急的！！！

//主界面单元
unit Unit1;

interface

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

type
TForm1 = class(TForm)
PaintBox1: TPaintBox;
PaintBox2: TPaintBox;
Button15: TButton;
procedure Button15Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }


public
{ Public declarations }
procedure showpic1(PlayMode:integer;src: TBitmap; dst: TCanvas;RCode:Integer);
end;

var
Form1: TForm1;

MCIStop:Integer=0;
MessFlag:Integer=0;
PicNum:Integer=1;
ForBmp:Integer=1;
RanCode:Integer=80;
CartCode:Integer=0;
FormH:integer=81;
gonplay: boolean;


implementation

{$R *.dfm}

procedure TForm1.Button15Click(Sender: TObject);
var
thd: tthdDraw;
begin
gonplay := true;
thd := tthdDraw.Create(PaintBox1);
thd := tthdDraw.Create(PaintBox2);
gonplay := false;
//thd := tthdDraw.Create(Image2);
//thd := tthdDraw.Create(Image1);
end;

procedure TForm1.showpic1(PlayMode: integer; src: TBitmap; dst: TCanvas;
RCode: Integer);
var
newbmp:TBitmap;
x,y,i,j,k,x1,x2,y1,y2,ynum,xnum,ScrH,ScrW:integer;
begin
ScrH:=src.Height;
ScrW:=src.Width;

case PlayMode of
0:begin //从左向右移动(设x初值为Screen.Width)
x:=ScrW;
while x>0 do
begin
x:=x-10;
dst.CopyRect(Rect(x,FormH+0,x+10,FormH+ScrH),src.Canvas,Rect(x,0,x+10,ScrH));
Sleep(RCode);
end;
end;
1:begin //从右向左拉(设x初值为0)
x:=0;
while x<ScrW do
begin
x:=x+10;
dst.CopyRect(Rect(x,FormH+0,x-10,FormH+ScrH),src.Canvas,Rect(x,0,x-10,ScrH));
Sleep(RCode);
end;
end;
2:begin //从下向上拉(设y初值为ScrH)
y:=ScrH;
while y>0 do
begin
y:=y-10;
dst.CopyRect(Rect(0,FormH+y,ScrW,FormH+y+10),src.Canvas,Rect(0,y,ScrW,y+10));
Sleep(RCode);
end;
end;
3:begin //从上向下拉(设y初值为0)
y:=0;
while y<ScrH do
begin
y:=y+10;
dst.CopyRect(Rect(0,FormH+y,ScrW,FormH+y-10),src.Canvas,Rect(0,y,ScrW,y-10));
Sleep(RCode);
end;
end;
4:begin //从中间往两边拉
x:=ScrW div 2;
x1:=x;
x2:=x;
while x1>0 do
begin
x1:=x1-10;
x2:=x2+10;
dst.CopyRect(Rect(x1,FormH+0,x1+10,FormH+ScrH),src.Canvas,Rect(x1,0,x1+10,ScrH));
dst.CopyRect(Rect(x2,FormH+0,x2-10,FormH+ScrH),src.Canvas,Rect(x2,0,x2-10,ScrH));
Sleep(RCode);
end;
end;
5:begin //两边从往中间拉
x:=ScrW;
x1:=0;
while x>(x div 2)do
begin
x:=x-10;
x1:=x1+10;
dst.CopyRect(Rect(x,FormH+0,x+10,FormH+ScrH),src.Canvas,Rect(x,0,x+10,ScrH));
dst.CopyRect(Rect(x1,FormH+0,x1-10,FormH+ScrH),src.Canvas,Rect(x1,0,x1-10,ScrH));
Sleep(RCode);
end;
end;
6:begin //从两边间隔拉
x:=ScrW;
x1:=0;
while x>0do
begin
x:=x-10;
x1:=x1+10;
ynum:=ScrH div 20;
for j:=0 to ynum do
begin
dst.CopyRect(Rect(x,FormH+j*20,x+10,FormH+j*20+10),src.Canvas,Rect(x,j*20,x+10,j*20+10));
dst.CopyRect(Rect(x1,FormH+j*20+10,x1-10,FormH+j*20+20),src.Canvas,Rect(x1,j*20+10,x1-10,j*20+20));
end;
Sleep(RCode);
end;
end;
7:begin //从上下间隔拉
y:=ScrH;
y1:=0;
while y>0do
begin
y:=y-10;
y1:=y1+10;
xnum:=ScrW div 20;
for j:=0 to xnum do
begin
dst.CopyRect(Rect(j*20,FormH+y,j*20+10,FormH+y+10),src.Canvas,Rect(j*20,y,j*20+10,y+10));
dst.CopyRect(Rect(j*20+10,FormH+y1,j*20+20,FormH+y1-10),src.Canvas,Rect(j*20+10,y1,j*20+20,y1-10));
end;
Sleep(RCode);
end;
end;
8:begin //从中间往四边拉
x:=ScrW div 2;
y:=ScrH div 2;
y1:=y; y2:=y-2; x1:=x; x2:=x;
while (x1>0) or (y1>0) do
begin
x1:=x1-2; x2:=x2+2;
y1:=y1-2; y2:=y2+2;
dst.CopyRect(Rect(x1,FormH+0,x1+2,FormH+ScrH),src.Canvas,Rect(x1,0,x1+2,ScrH));
dst.CopyRect(Rect(0,FormH+y1,ScrW,FormH+y1+2),src.Canvas,Rect(0,y1,ScrW,y1+2));
dst.CopyRect(Rect(x2,FormH+0,x2-2,FormH+ScrH),src.Canvas,Rect(x2,0,x2-2,ScrH));
dst.CopyRect(Rect(0,FormH+y2,ScrW,FormH+y2+2),src.Canvas,Rect(0,y2,ScrW,y2+2));
Sleep(RCode);
end;
end;
9:begin //从四边往中间拉
x:=ScrW;
y:=ScrH;
x1:=0;y1:=0;
while (x>(x div 2)) or (y>(y div 2))do
begin
x:=x-2; x1:=x1+2;
y:=y-2; y1:=y1+2;
dst.CopyRect(Rect(x,FormH+0,x+2,FormH+ScrH),src.Canvas,Rect(x,0,x+2,ScrH));
dst.CopyRect(Rect(0,FormH+y,ScrW,FormH+y+2),src.Canvas,Rect(0,y,ScrW,y+2));
dst.CopyRect(Rect(x1,FormH+0,x1-2,FormH+ScrH),src.Canvas,Rect(x1,0,x1-2,ScrH));
dst.CopyRect(Rect(0,FormH+y1,ScrW,FormH+y1-2),src.Canvas,Rect(0,y1,ScrW,y1-2));
Sleep(RCode);
end;
end;
10:begin //马赛克
for i:=0 to ScrW*ScrH div 10 do
begin
j := Random(ScrW div 4)*4;
k := Random(ScrH div 4)*4;
dst.CopyRect(Rect(j,FormH+k,j+4,FormH+k+4),src.Canvas,Rect(j,k,j+4,k+4));
end;
dst.CopyRect(Rect(0,FormH+0,ScrW,FormH+ScrH),src.Canvas,Rect(0,0,ScrW,ScrH));
end;
11:begin //左右两次刷新
x:=0;
while x<(ScrW+6) do
begin
x:=x+6;
dst.CopyRect(Rect(x-3,FormH+0,x-6,FormH+ScrH),src.Canvas,Rect(x-3,0,x-6,ScrH));
Sleep(10);
end;
while (x+6)>0 do
begin
x:=x-6;
dst.CopyRect(Rect(x+3,FormH+0,x+6,FormH+ScrH),src.Canvas,Rect(x+3,0,x+6,ScrH));
Sleep(10);
end;
end;
12:begin //左右两次刷新
x:=ScrW;
while (x+6)>0 do
begin
x:=x-6;
dst.CopyRect(Rect(x+3,FormH+0,x+6,FormH+ScrH),src.Canvas,Rect(x+3,0,x+6,ScrH));
Sleep(10);
end;
while x<(ScrW+6) do
begin
x:=x+6;
dst.CopyRect(Rect(x-3,FormH+0,x-6,FormH+ScrH),src.Canvas,Rect(x-3,0,x-6,ScrH));
Sleep(10);
end;
end;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
self.DoubleBuffered := true;
end;

end.


//线程单元
unit Unit2;

interface

uses
Classes,extctrls, graphics, sysutils;

type
tthdDraw = class(TThread)
private
{ Private declarations }
fpaint: Tpaintbox;
protected
procedure Execute; override;
public
constructor Create(apaint: Tpaintbox);
end;

implementation

{ Important: Methods and properties of objects in visual components can only be
used in a method called using Synchronize, for example,

Synchronize(UpdateCaption);

and UpdateCaption could look like,

procedure tthdDraw.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end; }

{ tthdDraw }

uses
unit1;

constructor tthdDraw.Create(apaint: Tpaintbox);
begin
inherited Create(false);
fpaint := apaint;
end;

procedure tthdDraw.Execute;
var
bmp: tbitmap;
begin
{ Place thread code here }
bmp := tbitmap.Create;
bmp.LoadFromFile('1.bmp');
while not Terminated do
begin
fpaint.Canvas.Lock;
form1.showpic1(7,bmp,fpaint.Canvas,100);
fpaint.Canvas.Unlock;
sleep(1000);
fpaint.Canvas.Brush.Color := clblack;
//form1.DoubleBuffered := true;
fpaint.Canvas.FillRect(Rect(0,0,fpaint.Width,fpaint.Height));
end;
bmp.Free;
end;

end.
 
我想实现主界面上多个paintbox同时显示图片特效（就像马赛克、百叶窗之类的效果）。
我使用子线程在paintbox上作图，线程开始后，如果不在界面上进行任何操作，则显示正
常，但是只要在界面上随便动一下（就算移动一下鼠标都不行），paintbox上的图像就会停顿，不知道为什么。现在把源代码附上，请高手们帮我看看。300分酬谢！！！很急的！！！

//主界面单元
unit Unit1;

interface

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

type
TForm1 = class(TForm)
PaintBox1: TPaintBox;
PaintBox2: TPaintBox;
Button15: TButton;
procedure Button15Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }


public
{ Public declarations }
procedure showpic1(PlayMode:integer;src: TBitmap; dst: TCanvas;RCode:Integer);
end;

var
Form1: TForm1;

MCIStop:Integer=0;
MessFlag:Integer=0;
PicNum:Integer=1;
ForBmp:Integer=1;
RanCode:Integer=80;
CartCode:Integer=0;
FormH:integer=81;
gonplay: boolean;


implementation

{$R *.dfm}

procedure TForm1.Button15Click(Sender: TObject);
var
thd: tthdDraw;
begin
gonplay := true;
thd := tthdDraw.Create(PaintBox1);
thd := tthdDraw.Create(PaintBox2);
gonplay := false;
//thd := tthdDraw.Create(Image2);
//thd := tthdDraw.Create(Image1);
end;

procedure TForm1.showpic1(PlayMode: integer; src: TBitmap; dst: TCanvas;
RCode: Integer);
var
newbmp:TBitmap;
x,y,i,j,k,x1,x2,y1,y2,ynum,xnum,ScrH,ScrW:integer;
begin
ScrH:=src.Height;
ScrW:=src.Width;

case PlayMode of
0:begin //从左向右移动(设x初值为Screen.Width)
x:=ScrW;
while x>0 do
begin
x:=x-10;
dst.CopyRect(Rect(x,FormH+0,x+10,FormH+ScrH),src.Canvas,Rect(x,0,x+10,ScrH));
Sleep(RCode);
end;
end;
1:begin //从右向左拉(设x初值为0)
x:=0;
while x<ScrW do
begin
x:=x+10;
dst.CopyRect(Rect(x,FormH+0,x-10,FormH+ScrH),src.Canvas,Rect(x,0,x-10,ScrH));
Sleep(RCode);
end;
end;
2:begin //从下向上拉(设y初值为ScrH)
y:=ScrH;
while y>0 do
begin
y:=y-10;
dst.CopyRect(Rect(0,FormH+y,ScrW,FormH+y+10),src.Canvas,Rect(0,y,ScrW,y+10));
Sleep(RCode);
end;
end;
3:begin //从上向下拉(设y初值为0)
y:=0;
while y<ScrH do
begin
y:=y+10;
dst.CopyRect(Rect(0,FormH+y,ScrW,FormH+y-10),src.Canvas,Rect(0,y,ScrW,y-10));
Sleep(RCode);
end;
end;
4:begin //从中间往两边拉
x:=ScrW div 2;
x1:=x;
x2:=x;
while x1>0 do
begin
x1:=x1-10;
x2:=x2+10;
dst.CopyRect(Rect(x1,FormH+0,x1+10,FormH+ScrH),src.Canvas,Rect(x1,0,x1+10,ScrH));
dst.CopyRect(Rect(x2,FormH+0,x2-10,FormH+ScrH),src.Canvas,Rect(x2,0,x2-10,ScrH));
Sleep(RCode);
end;
end;
5:begin //两边从往中间拉
x:=ScrW;
x1:=0;
while x>(x div 2)do
begin
x:=x-10;
x1:=x1+10;
dst.CopyRect(Rect(x,FormH+0,x+10,FormH+ScrH),src.Canvas,Rect(x,0,x+10,ScrH));
dst.CopyRect(Rect(x1,FormH+0,x1-10,FormH+ScrH),src.Canvas,Rect(x1,0,x1-10,ScrH));
Sleep(RCode);
end;
end;
6:begin //从两边间隔拉
x:=ScrW;
x1:=0;
while x>0do
begin
x:=x-10;
x1:=x1+10;
ynum:=ScrH div 20;
for j:=0 to ynum do
begin
dst.CopyRect(Rect(x,FormH+j*20,x+10,FormH+j*20+10),src.Canvas,Rect(x,j*20,x+10,j*20+10));
dst.CopyRect(Rect(x1,FormH+j*20+10,x1-10,FormH+j*20+20),src.Canvas,Rect(x1,j*20+10,x1-10,j*20+20));
end;
Sleep(RCode);
end;
end;
7:begin //从上下间隔拉
y:=ScrH;
y1:=0;
while y>0do
begin
y:=y-10;
y1:=y1+10;
xnum:=ScrW div 20;
for j:=0 to xnum do
begin
dst.CopyRect(Rect(j*20,FormH+y,j*20+10,FormH+y+10),src.Canvas,Rect(j*20,y,j*20+10,y+10));
dst.CopyRect(Rect(j*20+10,FormH+y1,j*20+20,FormH+y1-10),src.Canvas,Rect(j*20+10,y1,j*20+20,y1-10));
end;
Sleep(RCode);
end;
end;
8:begin //从中间往四边拉
x:=ScrW div 2;
y:=ScrH div 2;
y1:=y; y2:=y-2; x1:=x; x2:=x;
while (x1>0) or (y1>0) do
begin
x1:=x1-2; x2:=x2+2;
y1:=y1-2; y2:=y2+2;
dst.CopyRect(Rect(x1,FormH+0,x1+2,FormH+ScrH),src.Canvas,Rect(x1,0,x1+2,ScrH));
dst.CopyRect(Rect(0,FormH+y1,ScrW,FormH+y1+2),src.Canvas,Rect(0,y1,ScrW,y1+2));
dst.CopyRect(Rect(x2,FormH+0,x2-2,FormH+ScrH),src.Canvas,Rect(x2,0,x2-2,ScrH));
dst.CopyRect(Rect(0,FormH+y2,ScrW,FormH+y2+2),src.Canvas,Rect(0,y2,ScrW,y2+2));
Sleep(RCode);
end;
end;
9:begin //从四边往中间拉
x:=ScrW;
y:=ScrH;
x1:=0;y1:=0;
while (x>(x div 2)) or (y>(y div 2))do
begin
x:=x-2; x1:=x1+2;
y:=y-2; y1:=y1+2;
dst.CopyRect(Rect(x,FormH+0,x+2,FormH+ScrH),src.Canvas,Rect(x,0,x+2,ScrH));
dst.CopyRect(Rect(0,FormH+y,ScrW,FormH+y+2),src.Canvas,Rect(0,y,ScrW,y+2));
dst.CopyRect(Rect(x1,FormH+0,x1-2,FormH+ScrH),src.Canvas,Rect(x1,0,x1-2,ScrH));
dst.CopyRect(Rect(0,FormH+y1,ScrW,FormH+y1-2),src.Canvas,Rect(0,y1,ScrW,y1-2));
Sleep(RCode);
end;
end;
10:begin //马赛克
for i:=0 to ScrW*ScrH div 10 do
begin
j := Random(ScrW div 4)*4;
k := Random(ScrH div 4)*4;
dst.CopyRect(Rect(j,FormH+k,j+4,FormH+k+4),src.Canvas,Rect(j,k,j+4,k+4));
end;
dst.CopyRect(Rect(0,FormH+0,ScrW,FormH+ScrH),src.Canvas,Rect(0,0,ScrW,ScrH));
end;
11:begin //左右两次刷新
x:=0;
while x<(ScrW+6) do
begin
x:=x+6;
dst.CopyRect(Rect(x-3,FormH+0,x-6,FormH+ScrH),src.Canvas,Rect(x-3,0,x-6,ScrH));
Sleep(10);
end;
while (x+6)>0 do
begin
x:=x-6;
dst.CopyRect(Rect(x+3,FormH+0,x+6,FormH+ScrH),src.Canvas,Rect(x+3,0,x+6,ScrH));
Sleep(10);
end;
end;
12:begin //左右两次刷新
x:=ScrW;
while (x+6)>0 do
begin
x:=x-6;
dst.CopyRect(Rect(x+3,FormH+0,x+6,FormH+ScrH),src.Canvas,Rect(x+3,0,x+6,ScrH));
Sleep(10);
end;
while x<(ScrW+6) do
begin
x:=x+6;
dst.CopyRect(Rect(x-3,FormH+0,x-6,FormH+ScrH),src.Canvas,Rect(x-3,0,x-6,ScrH));
Sleep(10);
end;
end;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
self.DoubleBuffered := true;
end;

end.


//线程单元
unit Unit2;

interface

uses
Classes,extctrls, graphics, sysutils;

type
tthdDraw = class(TThread)
private
{ Private declarations }
fpaint: Tpaintbox;
protected
procedure Execute; override;
public
constructor Create(apaint: Tpaintbox);
end;

implementation

{ Important: Methods and properties of objects in visual components can only be
used in a method called using Synchronize, for example,

Synchronize(UpdateCaption);

and UpdateCaption could look like,

procedure tthdDraw.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end; }

{ tthdDraw }

uses
unit1;

constructor tthdDraw.Create(apaint: Tpaintbox);
begin
inherited Create(false);
fpaint := apaint;
end;

procedure tthdDraw.Execute;
var
bmp: tbitmap;
begin
{ Place thread code here }
bmp := tbitmap.Create;
bmp.LoadFromFile('1.bmp');
while not Terminated do
begin
fpaint.Canvas.Lock;
form1.showpic1(7,bmp,fpaint.Canvas,100);
fpaint.Canvas.Unlock;
sleep(1000);
fpaint.Canvas.Brush.Color := clblack;
//form1.DoubleBuffered := true;
fpaint.Canvas.FillRect(Rect(0,0,fpaint.Width,fpaint.Height));
end;
bmp.Free;
end;

end.
 
难道没有高手出马吗？都等了两天了
 
这年头高手们都不来大富翁了么？唉。。。。。。。。。
 
VCL不是线程安全的，多线程操作需要同步呀，这段这么重要的注释和多线程程序必须遵循的基本原则你都没看看呀
{ Important: Methods and properties of objects in visual components can only be
used in a method called using Synchronize, for example,

Synchronize(UpdateCaption);

and UpdateCaption could look like,

procedure tthdDraw.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end; }
 
谢谢你的回复，其实这个我考虑过的，只是如果我用Synchronize的话，那么paintbox不能同时改变图像了。在正式的程序中，可能会生成好几十个paintbox同时改变图像，那样的话程序就基本上动不了了。你还有别的好方法吗？
 
那这样试试。不过多个线程直接操作VCL，我觉得还是不太安全的

procedure TForm1.showpic1(PlayMode: integer; src: TBitmap; dst: TCanvas;
RCode: Integer);
var
newbmp:TBitmap;
x,y,i,j,k,x1,x2,y1,y2,ynum,xnum,ScrH,ScrW:integer;
begin
ScrH:=src.Height;
ScrW:=src.Width;

case PlayMode of
0:begin //从左向右移动(设x初值为Screen.Width)
x:=ScrW;
while x>0 do
begin
x:=x-10;
[red]dst.Lock[/red];
dst.CopyRect(Rect(x,FormH+0,x+10,FormH+ScrH),src.Canvas,Rect(x,0,x+10,ScrH));
[red]dst.Unlock[/red];
Sleep(RCode);
end;
end;
1:...
end;
end;
procedure tthdDraw.Execute;
var
bmp: tbitmap;
begin
{ Place thread code here }
bmp := tbitmap.Create;
bmp.LoadFromFile('1.bmp');
while not Terminated do
begin
//fpaint.Canvas.Lock;
form1.showpic1(7,bmp,fpaint.Canvas,100);
//fpaint.Canvas.Unlock;
sleep(1000);
[red]fpaint.Canvas.Lock;[/red]
fpaint.Canvas.Brush.Color := clblack;
//form1.DoubleBuffered := true;
fpaint.Canvas.FillRect(Rect(0,0,fpaint.Width,fpaint.Height));
[red]fpaint.Canvas.Unlock;[/red]
end;
bmp.Free;
end;
 
我试过了，还是不行。造成这种现象的原因是什么你知道吗？要是知道原因就好办了。我查了好多资料，到现在连原因都还不明白。
 
delphi 的demo
里 有一个 线城 访问 PaintBox 的 你怎么 不看
 
您必须登录或注册才可回复。

Similar threads

I
图形显示技巧
回复
0
查看
570
import
I
I
实用的Delphi屏幕拷贝程序
回复
0
查看
563
import
I
I
用delphi编程实现XP界面效果
回复
0
查看
571
import
I
I
浅析桌面精灵的实现
回复
0
查看
686
import
I
I
一个函数集
回复
0
查看
638
import
I
顶部