Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 03.05.2015, 13:02
Аватар для SpectraL
SpectraL SpectraL вне форума
Начинающий
 
Регистрация: 19.05.2011
Адрес: Санкт-Петербург
Сообщения: 112
Версия Delphi: 10.1 Berlin
Репутация: 10
Вопрос Перерисовка по изменению размера формы

Программависнетчтоделать?
Код:
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  
Старый 03.05.2015, 13:34
Аватар для Alegun
Alegun Alegun вне форума
LMD-DML
 
Регистрация: 12.07.2009
Адрес: Богородское
Сообщения: 3,025
Версия Delphi: D7E
Репутация: 1834
По умолчанию

Убратьпотокнах
Ответить с цитированием
  #3  
Старый 03.05.2015, 13:40
Аватар для SpectraL
SpectraL SpectraL вне форума
Начинающий
 
Регистрация: 19.05.2011
Адрес: Санкт-Петербург
Сообщения: 112
Версия Delphi: 10.1 Berlin
Репутация: 10
По умолчанию

Тамрисуетсяграфик.

Последний раз редактировалось SpectraL, 03.05.2015 в 13:57.
Ответить с цитированием
  #4  
Старый 03.05.2015, 19:17
Аватар для Admin
Admin Admin вне форума
Администратор
 
Регистрация: 03.10.2005
Адрес: Россия, Москва
Сообщения: 1,551
Версия Delphi: Delphi 7
Репутация: выкл
По умолчанию

Цитата:
Сообщение от SpectraL
Тамрисуетсяграфик.
При несоблюдении правил русского языка будут санкции
Ответить с цитированием
Этот пользователь сказал Спасибо Admin за это полезное сообщение:
M.A.D.M.A.N. (05.05.2015)
  #5  
Старый 03.05.2015, 22:42
Аватар для Alegun
Alegun Alegun вне форума
LMD-DML
 
Регистрация: 12.07.2009
Адрес: Богородское
Сообщения: 3,025
Версия Delphi: D7E
Репутация: 1834
По умолчанию

<<<DELETED>>>

Последний раз редактировалось Alegun, 07.05.2015 в 04:33.
Ответить с цитированием
  #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.

Последний раз редактировалось SpectraL, 10.05.2015 в 10:51.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 08:08.


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025