关于在线程中操作Image的问题，200分急求解

[minjunw]

我做了一个屏幕显示程序，使用线程在窗体的Image输出内容，但在输出的过程中，往往输出二三十屏后，Image就不显示了，调试可知Image的属性都正常，程序也未报任何错误。不知道是什么原因。

希望有这方面经验的高手能帮个忙！在线等待

[Coder1035]

这种问题通常是出在线程上

[minjunw]

我感觉可能是因为线程和主进程对TImage操作时发生了冲突而造成的，我将所有对Image的操作改到主进程后，虽然程序能正常运行，但因为有多个线程进行这种操作，全部改过来后，对系统的影响比较大，其中一个线程还对串口进行操作，所以虽然能正常运行，但系统经常会没有响应，尤其是对串口进行通讯的时候（串口通讯的数据量很大）

[blueflag]

帮顶~~~

[sxyjwfeng]

想法子添加个输出状态，看看到底是什么原因，一般都是自己程序的原因

[tonycjl]

是否可以用多个CANVAS去不停替换,CREATE,fREE,CREATE,FREE.

[lbywyj]

你把代码贴出来看看！

[minjunw]

上千行的程序没法贴出来的

[minjunw]

而且不一定在程序的什么地方运行时，就不显示了

[GARNETT2183]

使用线程进行这样的操作出现这样的问题不奇怪，一般是线程操作没有把握好，才会造成这样子的。。。

[DBgrid]

1、输出Image的时候用线程同步函数
2、采用互斥量，保证操作的时候进入到了临界区。

[minjunw]

有没有更好的办法能解决这个问题呢？
自己顶一下

[ahjoe]

建议不要在线程里操作VCL控件

[withcsharp]

unit Unit1;

interface

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

type
TtestThread = class(TThread)
private

Fbuff: TBitmap;
Fbuff2: TBitmap;

Fimage: TImage;
Fcount: integer;
procedure updateimage;

public
constructor CreateThread(image: TImage);
procedure Execute; override;
destructor Destroy; override;
end;
TForm1 = class(TForm)
Image1: TImage;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
testThread: TtestThread;
public

end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
bmp: TBitmap;
begin

DoubleBuffered := true;

bmp := TBitmap.Create;
bmp.Width := ClientWidth;
bmp.Height := ClientHeight;


Image1.Left := 0;
Image1.Top := 0;
Image1.AutoSize := true;
Image1.Picture.Assign(bmp);

FreeAndNil(bmp);
testThread := TtestThread.CreateThread(Image1);
end;

{ TtestThread }

constructor TtestThread.CreateThread(image: TImage);
begin
Fcount := 0;
Fimage := image;
Fbuff := TBitmap.Create;
Fbuff2 := TBitmap.Create;

Fbuff.Width := image.Picture.Bitmap.Width;
Fbuff.Height := image.Picture.Bitmap.Height;

Fbuff2.Width := image.Picture.Bitmap.Width;
Fbuff2.Height := image.Picture.Bitmap.Height;

inherited Create(TRUE);
Self.Priority := tpLower;
end;

destructor TtestThread.Destroy;
begin
FreeAndNil(Fbuff);
FreeAndNil(Fbuff2);
inherited;
end;

procedure TtestThread.Execute;
begin
while not Terminated do
begin
Sleep(1);
Inc(Fcount);
Synchronize(updateimage);

end;
Terminate;
end;

procedure TtestThread.updateimage;
begin

Fbuff2.Canvas.Draw(0, 0, Fbuff);
Fbuff.Canvas.Draw(0, 20, Fbuff2);
Fbuff.Canvas.TextOut(5, 3, '第' + IntToStr(Fcount) + '次');


BitBlt(Fimage.Canvas.Handle, 0, 0, Fbuff.Width, Fbuff.Height, Fbuff.Canvas.Handle, 0, 0, SRCCOPY);
Fimage.Canvas.TextOut(100, 3, '第' + IntToStr(Fcount) + '次');

Fimage.Parent.Update;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
if not testThread.Terminated then
testThread.Terminate;
testThread.Free;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
testThread.Resume;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if not testThread.Terminated then
testThread.Terminate;
end;

end.

[withcsharp]

我测试了 10000 次刷新

object Form1: TForm1
Left = 192
Top = 107
Width = 696
Height = 480
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnActivate = FormActivate
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object Image1: TImage
Left = 176
Top = 96
Width = 105
Height = 105
end
end

[fayeflash]

帮你顶上去!

[FakeZhengzhiguo]

建议你的程序里要加入日志和调试功能,程序执行到哪一步了,察看日志就明确了；
这是个很基本也很好实现的程序调试技巧。