всплывающие окна (popups) #2

Возвращаясь к теме плавного закрытия окна (т.н. затухания) на примере варианта реализации всплывающих окон из прошлого примера, рассмотрим несколько способов реализовать эффект затухания. Итак суть проблемы такова, при появлении некоторого события в приложении, возникает всплывающее окно подсказка, реализованное в виде обычной формы TPopupForm = class (TForm). Возникающее событие может иметь несколько типов, например, ошибка или оповещение, и в зависимости от типа события, всплывающее окно может иметь собственные настройки отображения, к каковым относятся цвет, прозрачность, и время отображения. Для хранения настроек окон по типам события был предусмотрен класс TPopupConfig. При возникновении события создавалось окно, которое по истечении указанного в popupConfig времени закрывалось. Для более эффектного закрытия окна был реализован метод "затухания", вариации которого мы рассмотрим сейчас. При любой реализации метода затухания используется свойство AlphaBlendValue класса TForm. которое уменьшается до значения равного нулю, после чего форма закрывается. Вариант №1, изначально приведенный в прошлом примере, имел один существенный недостаток.

procedure TPopupForm.FormDestroy(Sender: TObject);
begin    
    while AlphaBlendValue > 0 do begin
        AlphaBlendValue := AlphaBlendValue - 1;
        sleep(3);
    end;
    
    popupConfig.unregisterPopup(handle);
end;

При срабатывании таймера закрытия (popupTimer) вызывался метод destroy формы, который в свою очередь вызывал событие onDestroy, в котором непосредственно реализовано затухание, приведенное выше. Поскольку форма всплывающего окна выполняется в главном потоке приложения, то использование функции sleep() приостанавливает также главный поток, что неприемлемо, поскольку также "замораживает" и главную форму приложения. рассмотрим вариант реализации №2. на форму всплывающего окна добавим таймер fadeTimer:TTimer, имеющий интервал 5ms, с изначальным значением enabled = false. При срабатывании таймера закрытия окна, таймер затухания приводится в активное состояние.

procedure TPopupForm.popupTimerTimer(Sender: TObject);
var id:cardinal;
begin
    popupTimer.Enabled := false;
    fadeTimer.Enabled := true;
end;

и каждое событие срабатывания таймера затухания, увеличивает прозрачность формы, и когда значение alpahBlendValue достигает нуля, форма закрывается.

procedure TPopupForm.fadeTimerTimer(Sender: TObject);
begin
    if AlphaBlendValue > 0 then
        AlphaBlendValue := AlphaBlendValue - 1
    else begin
        fadeTimer.Enabled := false;
        destroy;
    end;
end;

Где обработчик события OnDestroy в свою очередь вызывает только метод unregister объекта класса TPopupConfig. вариант реализации №3. на самом деле вариант реализации №1 имеет такой негативный фактор как влияние на главую форму, лишь когда он выполняется в главном потоке приложения. Если же мы перенесем код изменения прозрачности в другой поток, который будет засыпать сам по себе, то никаких негативных факторов не будет. Единственное разве что, при создании большой очереди всплывающих окон у нас будет возможно запущено несколько потоков. но это ведь не проблема. Итак, перенесем код затухания окна в поток, после того как окно становится полностью прозрачным, поток посылает сообщение форме, а том что она может быть закрыта. получив данное сообщение форма закрывается. Таким образом процедура срабатывания таймера закрытия окна будет выглядеть следующим образом:

procedure TPopupForm.popupTimerTimer(Sender: TObject);
var id:cardinal;
begin
    popupTimer.Enabled := false;
    threadHandle := beginThread(nil,0,fadeOut,self,0,id);
end;

где threadHandle - дескриптор запущенного потока, включенный в private секцию описания формы. для изменения прозрачности окна используется функция fadeOut(form:pointer):integer и с помощью функции beginThread запускается в отдельном потоке (указатель на вызываемую. функцию fadeOut и передаваемый в нее параметр self, указываются как параметры функции beginThread, т.е что требуется запустить в отдельном потоке, и какие данные туда передать). сам код функции fadeOut повторяет вариант реализации №1, расширенный отправкой сообщения форме, о ее закрытии.

          function fadeOut(form:pointer):integer;
          begin
              with TForm(form) do begin
                  while AlphaBlendValue > 0 do begin
                      AlphaBlendValue := AlphaBlendValue - 1;
                      sleep(5);
                  end;
                  sendMessage(handle,WM_CLOSEPOPUP,0,0);
              end;
          end;

для приема данного сообщения требуется реализовать метод его обработки. В данном случае описание класса формы и его реализации будет расширено следующим образом:

const WM_CLOSEPOPUP = WM_USER + 2;
  TPopupForm = class(TForm)
  .....
  private
    { Private declarations }
    threadHandle : Cardinal;
    procedure wmClosePopup(var msg:TMessage); message WM_CLOSEPOPUP;
  ....
  end;
  .... 
procedure TPopupForm.wmClosePopup(var msg: TMessage);
begin
    if threadHandle  0 then closeHandle(threadHandle);
    destroy;
end;

После чего окно будет закрыто. Для более интересной реализации самого окна можно придать ему форму с закругленными углами. для этого при создании всплывающего окна определим его форму:

constructor TPopupForm.Create(info: PPopupInfo);
var r :TRect;
    hr : HRgn;
begin
    ......
    r := GetClientRect();
    hr := CreateRoundRectRgn(r.Left,r.top,r.Right,r.Bottom,10,10);
    SetWindowRgn(handle,hr,true);
end;