Вероятно программа виснет из-за того, что в процедуре 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.