JPEG сохранить в base64 в TThread

Question

У меня есть некоторые проблемы с Delphi.

Я написал две простые функции для создания скриншота, преобразования его в формат JPEG и декодирования в поток base64. И это хорошо работает, если я сделаю это в основной программе потока. Но если я создаю класс TThread и запускаю эту функцию при выполнении, Windows зависает, и я могу только перезагрузить свой компьютер.

Сделав несколько попыток, я обнаружил, что зависает ПК через процедуру JpegImg.SaveToStream(Input); И если я не конвертирую Bitmap в JPEG, он работает хорошо, и я получаю строку изображения.

Помогите, пожалуйста.

Вот код

procedure TEvReader.ScreenShot(DestBitmap : TBitmap) ;
var   DC : HDC;
begin   DC := GetDC (GetDesktopWindow) ;
  try
    DestBitmap.Width := GetDeviceCaps (DC, HORZRES) ;
    DestBitmap.Height := GetDeviceCaps (DC, VERTRES) ;
    BitBlt(DestBitmap.Canvas.Handle, 0, 0, DestBitmap.Width, DestBitmap.Height, DC, 0, 0, SRCCOPY) ;
  finally
    ReleaseDC (GetDesktopWindow, DC) ;
  end;
end;


function TEvReader.Base64FromBitmap(Bitmap: TBitmap): string;
var
  Input: TBytesStream;
  Output: TStringStream;
  JpegImg:TJPEGImage;
begin
  Input := TBytesStream.Create;
  try
    JpegImg:=TJPEGImage.Create;
    JpegImg.Assign(Bitmap);


    JpegImg.SaveToStream(Input); {here a problem.When i replace "JpegImg" to "Bitmap" all works good }
    Input.Position := 0;
    Output := TStringStream.Create('', TEncoding.ASCII);
    try
      Soap.EncdDecd.EncodeStream(Input, Output);
      Result := Output.DataString;
    finally
      Output.Free;
    end;
  finally
    Input.Free;
  end;
end;


procedure TOutThread.Execute;
var

bmp:TBitmap;
strrr:String;
begin

  bmp:=TBitmap.Create;
  mObj.ScreenShot(bmp);

  strrr := mObj.Base64FromBitmap(bmp);

  Form2.Memo4.Text := strrr;

end;

Answer 1

TJPEGImage не является потокобезопасным. Хотя проблема с поточно-ориентированным рисунком, упомянутая в http://qc.embarcadero.com/wc/qcmain.aspx?d=55871, несколько исправлена ​​в Delphi XE6 (предоставляя свойство Canvas, вы должны заблокировать себя), в вашем случае это будет наверное не сильно поможет.

Вы должны синхронизировать обработку TJPEGImage с основным потоком.

Также в вашем коде вы создали некоторые утечки памяти, так как вы никогда не выпускали объекты JpgImg и Bmp.

Попробуйте с помощью следующего кода:

procedure TEvReader.ScreenShot(DestBitmap: TBitmap);
var
  DC: HDC;
begin
  DC := GetDC(GetDesktopWindow);
  DestBitmap.Canvas.Lock;
  try
    DestBitmap.Width := GetDeviceCaps(DC, HORZRES);
    DestBitmap.Height := GetDeviceCaps(DC, VERTRES);
    BitBlt(DestBitmap.Canvas.Handle, 0, 0, DestBitmap.Width, DestBitmap.Height, DC, 0, 0, SRCCOPY);
  finally
    DestBitmap.Canvas.Unlock;
    ReleaseDC(GetDesktopWindow, DC);
  end;
end;

function TEvReader.Base64FromBitmap(Bitmap: TBitmap): string;
var
  Input: TBytesStream;
  Output: TStringStream;
  JpegImg: TJPEGImage;
begin
  Input := TBytesStream.Create;
  try
    JpegImg := TJPEGImage.Create;
    try
      TThread.Synchronize(nil,
        procedure
        begin
          JpegImg.Assign(Bitmap);
          JpegImg.SaveToStream(Input);
        end);
    finally
      JpegImg.Free;
    end;
    Input.Position := 0;
    Output := TStringStream.Create('', TEncoding.ASCII);
    try
      Soap.EncdDecd.EncodeStream(Input, Output);
      Result := Output.DataString;
    finally
      Output.Free;
    end;
  finally
    Input.Free;
  end;
end;

procedure TOutThread.Execute;
var
  mObj: TEvReader;
  bmp: TBitmap;
  strrr: string;
begin
  mObj := TEvReader.Create;
  bmp := TBitmap.Create;
  try
    mObj.ScreenShot(bmp);
    strrr := mObj.Base64FromBitmap(bmp);
  finally
    bmp.Free;
    mObj.Free;
  end;

  Synchronize(nil,
    procedure
    begin
      Form2.Memo4.Text := strrr;
    end);
end;