这是运行一个线程的一小段代码(准备粘贴并运行)。
该线程获取光盘上jpg文件的列表,然后对其执行某些操作。
通常情况下可以。如果我开始在表格上移动光标,每次都会收到此错误:)
任何想法?
谢谢!
unit uTest;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, jpeg, gr32;
type
TThreadSafeJpegImage = class(TJPEGImage)
protected
procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
end;
TForm1 = class(TForm)
btn1: TButton;
procedure btn1Click(Sender: TObject);
private
public
end;
TWatek = class(TThread)
public
procedure Execute;override;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.btn1Click(Sender: TObject);
var
thr: TWatek;
begin
thr := TWatek.Create(true);
thr.FreeOnTerminate := true;
thr.Resume;
end;
{ TWatek }
procedure TWatek.Execute;
var
sciezka: string;
Rec : TSearchRec;
Path : string;
I: Integer;
function TestFile(path: string): WideString;
var
stream: TMemoryStream;
jpg: TThreadSafeJpegImage;
bmp32: TBitmap32;
strStr: TStringStream;
err: String;
begin
try
stream := TMemoryStream.Create;
jpg := TThreadSafeJpegImage.Create;
try
stream.LoadFromFile(path);
jpg.LoadFromStream(stream);
finally
FreeAndNil(stream);
end;
bmp32 := TBitmap32.Create;
try
bmp32.Assign(jpg);
strStr := TStringStream.Create('');
bmp32.SaveToStream(strStr);
strStr.Seek(0,soFromBeginning);
finally
FreeAndNil(jpg);
FreeAndNil(bmp32);
end;
result := strStr.DataString;
FreeAndNil(strStr);
except
on e: exception do
begin
err := e.Message;
showmessage (err);
end;
end;
end;
begin
sciezka := 'd:\pictures\';
for I := 1 to 100 do
begin
Path := IncludeTrailingPathDelimiter(sciezka) ;
if FindFirst (Path + '*.jpg', faAnyFile - faDirectory, Rec) = 0 then
begin
try
repeat
TestFile (Path + Rec.Name);
until FindNext(Rec) <> 0;
finally
FindClose(Rec) ;
end;
end;
end;
end;
{ TThreadSafeJpegImage }
procedure TThreadSafeJpegImage.Draw(ACanvas: TCanvas; const Rect: TRect);
begin
Bitmap.Canvas.Lock;
try
inherited Draw(ACanvas, Rect);
finally
Bitmap.Canvas.Unlock;
end;
end;
end.
最佳答案
Graphics32小组的一个人为我找到了解决方案。我们必须对gr32单元进行一些修复,如下所示:
1) In TBitmap32.AssignTo() replace
DrawTo(Bmp.Canvas.Handle, 0, 0);
with
Bmp.Canvas.Lock;
try
DrawTo(Bmp.Canvas.Handle, 0, 0);
finally
Bmp.Canvas.UnLock;
end;
2) In TBitmap32.Assign() replace
TGraphicAccess(Source).Draw(Canvas, MakeRect(0, 0, Width, Height));
with
Canvas.Lock;
try
TGraphicAccess(Source).Draw(Canvas, MakeRect(0, 0, Width, Height));
finally
Canvas.UnLock;
end;
Now it works!