Нити замораживают основной вид - PullRequest
Новая
       66

Нити замораживают основной вид

1 голос
/ 17 февраля 2020

Я хочу запустить несколько потоков. Каждый поток должен конвертировать JPEG в растровое изображение. Конверсия работает, но все мое приложение всегда использует 12% -13% процессора. У меня 8-ядерный процессор, поэтому кажется, что все приложение использует только одно ядро. Кроме того, во время работы потоков основная форма блокируется и не отвечает. 

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Jpeg, Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    Str: TMemoryStream;
    procedure OnTerminate(Sender: TObject);
  end;

  TMakeThumbThread= class(TThread)
  private
    FStream: TStream;
  public
    FBmp: TBitmap;    
    constructor Create(Str: TStream);
    procedure Execute; override;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

constructor TMakeThumbThread.Create(Str: TStream);
begin
  inherited Create(True);
  FStream := Str;
  FreeOnTerminate := True;
end;

procedure TMakeThumbThread.Execute;
var Jpg: TJpegImage;
begin
  FBmp := TBitmap.Create;
  FBmp.PixelFormat := pf32bit;
  FBmp.Width := 300;
  FBmp.Height := 200;

  Jpg := TJpegImage.Create;
  FStream.Position := 0;
  Jpg.LoadFromStream(FStream);
  FBmp.Canvas.Draw(0,0, Jpg);
  Jpg.Free;

  DoTerminate;
  FBmp.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
var F: TFileStream;
    i: Integer;
    MT: TMakeThumbThread;
begin
  Str := TMemoryStream.Create;
  F := TFileStream.Create('test.jpg', fmOpenRead or fmShareDenyWrite);
  Str.CopyFrom(F, F.Size);
  F.Free;

  for i:=0 to 500 do begin
    MT := TMakeThumbThread.Create(Str);
    MT.OnTerminate := OnTerminate;
    MT.Execute;
  end;
end;

procedure TForm1.OnTerminate(Sender: TObject);
var Bmp: TBitmap;
begin
  Bmp := TMakeThumbThread(Sender).FBmp;
  Form1.Canvas.Draw(1,1, Bmp );
end;

end.

1 Ответ

12 голосов
/ 17 февраля 2020

Вы вручную вызываете метод Execute() потока в контексте основного потока. НЕ ДЕЛАЙТЕ ЭТОГО! Вот почему ваш пользовательский интерфейс зависает. Вы создаете свои потоки в приостановленном состоянии и никогда не возобновляете их.

Вам необходимо изменить эту строку: 

MT.Execute;

На это: 

MT.Resume;

Или это: 

MT.Start;

В зависимости от того, какую версию Delphi вы используете.

Также есть несколько других проблем с вашим кодом.

  • Класс VCL TBitmap не является полностью поточно-ориентированным. Вы ДОЛЖНЫ Lock() TBitmap.Canvas при работе с TBitmap в рабочем потоке, чтобы основной поток не мог неожиданно оторвать ресурсы GDI от TBitmap.

  • Вы совместно используете один TMemoryStream с несколькими потоками, чтобы они все загружали одно и то же изображение JPG одновременно. Это не сработает, если вы не закроете доступ к TMemoryStream объектом синхронизации, таким как TCriticalSection или TMutex. Или другой вариант - использовать TCustomMemoryStream для создания нескольких потоков, которые совместно используют один блок памяти. В противном случае было бы лучше просто передать имя файла JPG каждому потоку и позволить Execute() вызывать TJpegImage.LoadFromFile() вместо TJpegImage.LoadFromStream().

  • Вы звоните FBmp.Free() в конец Execute(), но затем вы получаете доступ к FBmp в обработчике событий OnTerminate. Вам нужно отложить вызов до FBmp.Free() до тех пор, пока не выйдет обработчик события OnTerminate, например, в деструкторе потока.

  • Вы рисуете растровые изображения непосредственно на TForm.Canvas извне события OnPaint формы. Таким образом, как только ваша форма будет перерисована по любой причине, ваши нарисованные изображения будут потеряны. Если вы хотите, чтобы изображения были постоянными в течение всего срока действия формы, вам нужно сохранить их и нарисовать их при каждом событии OnPaint. Или вы можете просто назначить их TImage компонентам и позволить им обрабатывать чертеж за вас.

...