Jpeg save to base64 in TThread

base64, bitmap, delphi, tthread

Solution

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;

Problem

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

Original source

Related problems