Показать сообщение отдельно
  #6  
Старый 05.05.2015, 11:34
Аватар для SpectraL
SpectraL SpectraL вне форума
Начинающий
 
Регистрация: 19.05.2011
Адрес: Санкт-Петербург
Сообщения: 112
Версия Delphi: 10.1 Berlin
Репутация: 10
Лампочка

Вероятно программа виснет из-за того, что в процедуре FormPaint периодически используется Bitmap1, в котором происходят какие-то изменения. Найдено 3 варианта решения данной проблемы:
вариант 1 - вероятно неправильный и менее надёжный:
Код:
unit Unit1;
...
procedure TForm1.FormResize(Sender: TObject);
begin
  Thread1.Suspended := False; // запускаем поток
  Sleep(10) // приостанавливаем программу
end;
...
вариант 2 - вероятно правильный:
Код:
unit Unit1;
...
procedure TForm1.FormPaint(Sender: TObject);
begin
  if PaintAllow or Thread1.Suspended then Form1.Canvas.Draw(0, 0, Bitmap1) // если рисование разрешено, то получаем изображение из Bitmap1
end;
...
Код:
unit Unit2;
...
var
    Thread1: TThread1;
    Bitmap1: TBitmap;
    PaintAllow: Boolean;

implementation
  uses
    Unit1;

procedure TThread1.Execute;
begin
  Bitmap1.Canvas.Lock; // блокируем холст (для избежания ошибки)
  repeat
    Bitmap1.SetSize(Form1.ClientWidth, Form1.ClientHeight); // определяем размер изображения
    Bitmap1.Canvas.Rectangle(5, 5, 55, 55); // нарисуем что-нибудь для исключения ошибки или можно разблокировать холст во время синхронизации

    //Bitmap1.Canvas.Unlock;
    Synchronize(procedure
    begin
      PaintAllow := True; // разрешаем рисование
      Form1.FormPaint(Nil); // запускаем событие
      PaintAllow := False // запрещаем рисование
    end);
    //Bitmap1.Canvas.Lock;

    Thread1.Suspended := True // приостанавливаем поток
  until False
end;
...
вариант 3 - правильный и надёжный:
Код:
unit Unit1;
...
procedure TForm1.FormPaint(Sender: TObject);
begin
  Form1.Canvas.Draw(0, 0, EndBitmap1) // получаем изображение из EndBitmap1
end;
...
Код:
unit Unit2;

interface
  uses
    System.Classes, Vcl.Graphics;

  type
    TThread1 = class(TThread)
    protected
      procedure Execute; override;
    end;

  var
    Thread1: TThread1;
    Bitmap1, EndBitmap1: TBitmap;

implementation
  uses
    Unit1;

procedure TThread1.Execute;
begin
  Bitmap1.Canvas.Lock; // блокируем холст (для избежания ошибки)
  repeat
    Bitmap1.SetSize(Form1.ClientWidth, Form1.ClientHeight); // определяем размер изображения
    Bitmap1.Canvas.Rectangle(5, 5, 55, 55); // нарисуем что-нибудь для исключения ошибки или можно разблокировать холст во время синхронизации

    //Bitmap1.Canvas.Unlock;
    Synchronize(procedure
    begin
      EndBitmap1.SetSize(Bitmap1.Width, Bitmap1.Height);
      EndBitmap1.Canvas.Draw(0, 0, Bitmap1);
      Form1.FormPaint(Nil) // запускаем событие
    end);
    //Bitmap1.Canvas.Lock;

    Thread1.Suspended := True // приостанавливаем поток
  until False
end;

initialization
  Bitmap1 := TBitmap.Create;
  EndBitmap1 := TBitmap.Create

finalization
  Bitmap1.Canvas.Unlock;
  Bitmap1.Free;
  EndBitmap1.Free

end.
Ответить с цитированием