Delphi 7, дескриптор недействителен при перемещении курсора на форму :) - PullRequest
Новая
       9

Delphi 7, дескриптор недействителен при перемещении курсора на форму :)

2 голосов
/ 18 мая 2011

Вот небольшой фрагмент кода (готовый для вставки и запуска), который запускает один поток. Этот поток получает список файлов 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.

Ответы [ 2 ]

4 голосов
/ 19 мая 2011

Парень из группы 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!
0 голосов
/ 18 мая 2011

не уверен на 100%, пожалуйста, проголосуйте за меня, если я бредилdo (поскольку вы уже заблокировали холст ранее), и это приводит к возвращению ошибки.

Измените код рисования следующим образом: 

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;
...