![]() |
|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
![]() |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
||||
|
||||
![]() Программависнетчтоделать?
Код:
unit Unit1; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Unit2; type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); procedure FormResize(Sender: TObject); procedure FormPaint(Sender: TObject); end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject); begin Thread1 := TThread1.Create end; procedure TForm1.FormResize(Sender: TObject); begin Thread1.Suspended := False // запускаем поток end; procedure TForm1.FormPaint(Sender: TObject); begin Form1.Canvas.Draw(0, 0, Bitmap1) // получаем изображение из Bitmap1 end; end. Код:
unit Unit2; interface uses System.Classes, Vcl.Graphics; type TThread1 = class(TThread) protected procedure Execute; override; end; var Thread1: TThread1; Bitmap1: TBitmap; implementation uses Unit1; procedure TThread1.Execute; begin Bitmap1.Canvas.Lock; // блокируем холст (для избежания ошибки) repeat Bitmap1.SetSize(Form1.ClientWidth, Form1.ClientHeight); // определяем размер изображения Form1.FormPaint(Nil); // запускаем событие Thread1.Suspended := True // приостанавливаем поток until False end; initialization Bitmap1 := TBitmap.Create finalization Bitmap1.Canvas.Unlock; Bitmap1.Free end. Последний раз редактировалось SpectraL, 03.05.2015 в 19:41. |
#2
|
||||
|
||||
![]() Убратьпотокнах
Я не понял Вашего вопроса, но всё же Вам на него отвечу! |
#3
|
||||
|
||||
![]() Тамрисуетсяграфик.
Последний раз редактировалось SpectraL, 03.05.2015 в 13:57. |
#4
|
||||
|
||||
![]() Цитата:
|
Этот пользователь сказал Спасибо Admin за это полезное сообщение: | ||
M.A.D.M.A.N. (05.05.2015)
|
#5
|
||||
|
||||
![]() <<<DELETED>>>
Я не понял Вашего вопроса, но всё же Вам на него отвечу! Последний раз редактировалось Alegun, 07.05.2015 в 04:33. |
#6
|
||||
|
||||
![]() Вероятно программа виснет из-за того, что в процедуре FormPaint периодически используется Bitmap1, в котором происходят какие-то изменения. Найдено 3 варианта решения данной проблемы:
вариант 1 - вероятно неправильный и менее надёжный: Код:
unit Unit1; ... procedure TForm1.FormResize(Sender: TObject); begin Thread1.Suspended := False; // запускаем поток Sleep(10) // приостанавливаем программу end; ... Код:
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; ... Код:
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. Последний раз редактировалось SpectraL, 10.05.2015 в 10:51. |