Jpeg save to base64 in TThread

Question

I have a some problem with Delphi.

I was write two simple functions for make the screenshot, convert it to jpeg and decode into base64 stream. And its works good if i make it on main stream program. But if i create a TThread class and start this function on Execute, windows freezes and i can only reboot my pc.

By making several attempts, I found that hangs PC through procedure JpegImg.SaveToStream(Input); And if i don't convert Bitmap to jpeg, its works good, and i get the image string.

Help please.

Here a code

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 is not thread safe. While issue with thread safe drawing mentioned in http://qc.embarcadero.com/wc/qcmain.aspx?d=55871 is somewhat fixed in Delphi XE6 (by exposing Canvas property you have to lock yourself), in your case it will probably not help much.

You have to synchronize TJPEGImage handling with main thread.

Also in your code you have created some memory leaks since you have never released JpgImg and Bmp objects.

Try with following code:

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;