delphibitmapbase64tthread

Jpeg save to base64 in TThread


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;

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;