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;

I a guess, but this might be helpful: http://qc.embarcadero.com/wc/qcmain.aspx?d=55871. Bitmap is not thread safe. you need to lock/unlock its canvas. — kobik, Nov 23 '14 at 12:53
@kobik It doesn't sound as though he's accessing the same bitmap object from multiple threads. Or is there some crazy implementation screw up with VCL bitmap? — David Heffernan, Nov 23 '14 at 16:51
@DavidHeffernan TJPEGImage is messed up, there is issue with its Bitmap.Canvas DC that is sometimes cleared due to the GDI Object Caching mechanism in graphics.pas — Dalija Prasnikar, Nov 23 '14 at 20:10
@David, The issue is accessing a Bitmap DC from a different thread than the main UI. the main UI WndProc will destroy the DC unless its locked. — kobik, Nov 23 '14 at 20:45
@kobik That is utterly bizarre. I cannot imagine what was going through their minds. Sometimes I wonder if the devs at Embarcadero even know that threads exist. I've never got over the fact that `Set8087CW` is not threadsafe, is still not threadsafe. — David Heffernan, Nov 23 '14 at 20:48
@David, this issue was discussed a few times on SO. I still believe that properly locking the bitmap used in threads can be done, with thread safety - because it was designed this way. but I had so many un-expected issues with TBitmap used in threads I prefer not to take risks and switched to GDI+. here is some more info about this issue: http://stackoverflow.com/a/26038262/937125 — kobik, Nov 23 '14 at 21:00
@kobik locking is what you want to avoid for reasons of perf. Emba clearly got this all wrong. — David Heffernan, Nov 23 '14 at 21:25

Dalija Prasnikar · Accepted Answer · 2014-11-23T21:10:19.583

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;

@DavidHeffernan I used to patch TJPEGImage myself, but I only need to draw JPEG in threads and that part was not problematic to patch (unless, of course, Embarcadero forgot to include all source files needed for recompiling, something that is regularly happening). — Dalija Prasnikar, Nov 23 '14 at 20:17
Safest way is to use GDI+ / `CreateCompatibleDC` and `CreateBitmap` as described [here](http://stackoverflow.com/a/14804378/937125), I'm also not sure about synchronizing the `JpegImg.Assign` part. but locking/unlocking `DestBitmap.Canvas.Handle` in `ScreenShot` is essential. +1 — kobik, Nov 23 '14 at 21:01
@kobik Thanks, I have updated the code. Both JpegImg.Assign and JpegImg.SaveToStream have to access internal Bitmap that is not safe to use without locking its canvas. It is possible that Assign might work without synchronizing, but I will leave testing that part to OP — Dalija Prasnikar, Nov 23 '14 at 21:16
only I wanted to write that nothing works, but has read a comment about "lock" and "unlock" and realized that i missed this point in the procedure "screenshot" in your code) Now I understand where was the problem) Everything works fine) Thank you) — Illia Moroz, Nov 23 '14 at 22:25

Jpeg save to base64 in TThread

1 Answers1