Jpeg save to base64 в TThread

Question

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

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

Сделав несколько попыток, я обнаружил, что зависает ПК через процедуру JpegImg.SaveToStream(Input); И если я не конвертирую растровое изображение в 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;