在表格上移动光标

在表格上移动光标

这是运行一个线程的一小段代码(准备粘贴并运行)。
该线程获取光盘上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!

10-05 22:15