德尔福 7，在窗体:)上移动光标时，句柄无效

Question

这是运行一个线程的一小段代码（准备粘贴和运行）。此线程获取光盘上的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.

Answer 1

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!

Answer 2

不是

100%确定，如果我有妄想症，请投票给我。

TThreadSafeJpegImage.Draw 锁定画布。
在窗体上移动鼠标时，会强制重绘，而窗体无法执行此操作（因为您之前已锁定画布），这会导致返回错误。

更改绘制代码，如下所示：

procedure TThreadSafeJpegImage.Draw(ACanvas: TCanvas; const Rect: TRect);
var
  OKToDraw: boolean;
begin 
  OKToDraw:= Bitmap.Canvas.TryLock;
  if OKTODraw then try
    inherited Draw(ACanvas, Rect);
  finally
    Bitmap.Canvas.Unlock;
  end; {if try}
end;