在线程中拷贝图象的问题(76分)

  • 主题发起人 主题发起人 tswhq
  • 开始时间 开始时间
T

tswhq

Unregistered / Unconfirmed
GUEST, unregistred user!
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
Panel1: TPanel;
PaintBox1: TPaintBox;
Timer1: TTimer;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure Timer1Timer(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
MyCanvas :TCanvas;
Bmp :TBitmap;
X,Y,S :Integer;
implementation
uses SendImage;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
Send :TSendImage;
begin
Bmp.Canvas.CopyRect(Rect(0,0,Panel1.Width,Panel1.Height),MyCanvas,Rect(0,0,Bmp.Width,Bmp.Height));
Timer1.Enabled:=True;
Send:=TSendImage.Create(False);
Send.
FreeOnTerminate:=True;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
MyCanvas:=TCanvas.Create;
Bmp:=TBitmap.Create;
Bmp.Width:=Panel1.Width;
Bmp.Height:=Panel1.Height;
MyCanvas.Handle:=GetDC(Panel1.Handle);
x:=100;y:=10;s:=25;
end;

procedure TForm1.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
MyCanvas.Free;
Bmp.Free;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
Y:=Y+S;
If y>Panel1.Height then
y:=10;
MyCanvas.Draw(0,0,Bmp);
MyCanVas.Brush.Color:=clBlue;
MyCanvas.Pen.Color:=clWhite;
MyCanvas.Rectangle(x,y,x+s,y+s);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Timer1.Enabled:=False;
end;

end.
*************************************
*************************************
unit SendImage;
interface
uses
Classes,Graphics,SysUtils;
type
TSendImage = class(TThread)
private
{ Private declarations }
protected
procedure Execute;
override;
Public
constructor Create(Suspended:Boolean);
end;

implementation
uses Main;
constructor TSendImage.Create(Suspended: Boolean);
begin
inherited Create(Suspended);;
end;

procedure TSendImage.Execute;
var
B :TBitMap;
begin
B:=TBitmap.Create;
B.Width:=Form1.PaintBox1.Width;
B.Height:=Form1.PaintBox1.Height;
Try
While Form1.Timer1.Enableddo
begin
Form1.Canvas.Lock;
B.Canvas.CopyRect(Rect(0,0,Form1.Panel1.Width,Form1.Panel1.Height),MyCanvas,Rect(0,0,Form1.PaintBox1.Width,Form1.PaintBox1.Height));
//Form1.PaintBox1.Canvas.CopyRect(Rect(0,0,Form1.Panel1.Width,Form1.Panel1.Height),MyCanvas,Rect(0,0,Form1.PaintBox1.Width,Form1.PaintBox1.Height));换成此句无问题
Form1.PaintBox1.Canvas.Draw(0,0,b);
Form1.Canvas.Unlock;
Sleep(500);
end;
finally
B.Free;
Form1.Caption:='Thread Exit';
end;
end;

end.

想做图象的实时更新,没想到运行一段时间后图象就不更新了
 
VCL是非线程安全的,访问/操作VCL要写在一个过程中,用Synchronize()来同步调用,
楼主的写法不错才怪呢.
 
接受答案了.
 

Similar threads

后退
顶部