Создаём всплывающие окна

[Amper]

Приветствую...

Думаю все пользовались QIP?... Видели всплывающие окна при новых сообщениях (так называемые popup-окна)... Пусть для этого есть компоненты, но своими силами лучше, поэтому сегодня мы сделаем подобные окна в наших программах...
Итак, запускаем Delphi...

Для начала, вставим на форму только одну кнопку, установим заголовок кнопки "Всплыть", а имя кнопки пусть будет "button_popup".
Ещё поставим на главную форму Timer со следующими свойствами:

Enabled = False
Interval = 1
Name = popup_timer

и ещё один со свойствами

Enabled = False
Interval = 1500
Name = undo_timer

Теперь вставим в проект ещё одну форму (File > New > Form), она и будет нашим всплывающим окном. Этой форме дадим имя "popup_form", а также зададим некоторые свойства:

Name = form_popup
BorderStyle = bsNone
BorderIcons = []
Color = clInfoBk
FormStyle = fsStayOnTop
Visible = False;

Ширину и высоту формы задайте по желанию...

Теперь поставим на эту форму компонент TImage, обзовём его "popup_bg", и установим свойство Align = alClient. А в свойстве Picture устанавливаем фоновую картинку для нашего всплывающего окна.

Дальше ставим на эту же форму (popup_form) компонент TLabel:

Name = popup_text
Align = alClient
Aligment = taCenter
Caption = ""
Transparent = True
WordWrap = True

Итак, интерфейсную часть закончили, теперь приступаем к коду.
В коде главной формы создаём процедуру:

procedure Popup(var Text: String);
var
  pzh: integer; // Высота панели задач
  pz: HWnd; // Хендл панели задач
  r:TRect; // Область панели задач
begin
  // Получаем идентификатор панели задач
  pz := FindWindow('Shell_TrayWnd','');
  // Получаем область панели задач
  GetWindowRect(pz,r);
  // Из области узнаём высоту панели задач
  pzh := r.Top - r.Bottom;
  // Устанавливаем начальный отступ слева для всплывающего окна
  Popup_Form.Left := Screen.Width - Popup_Form.Width - 2;
  // Устанавливаем начальный отступ сверху для всплывающего окна
  Popup_Form.Top := Screen.Height + pzh;
  // Устанавливаем текст всплывающего окна
  Popup_Form.Popup_Text.Caption := Text;
  // Показываем всплывающее окно
  Popup_Form.Visible := True;
  // Запускаем таймер всплывания
  Popup_Timer.Enabled := True;
end;

Теперь сделаем глобальную переменную st типа integer:

.....
  public
    st: integer;
.....

И создаём процедуру для для события таймера:

procedure Popup_TimerTimer(Sender: TObject);
  // Проверяем условие для контроля окончания всплывания
  if (st < Popup_Form.Height) then
  begin
    // Поднимаем окно вверх
    Popup_Form.Top := Popup_Form.Top - (Popup_Form.Height div 30);
    // Увеличиваем переменную для контроля всплывания
    st := st + (Popup_Form.Height div 30);
  end
  // Если всплывание закончилось
  else
  begin
    // Выключаем таймер вплывания
    Popup_Timer.Enabled := False;
    // Включаем таймер закрытия
    Undo_Timer.Enabled := True;
    // Обнуляем переменную контроля всплывания
    st := 0;
  end;
end;

Затем создадим процедуру таймера закрытия:

procedure Undo_TimerTimer(Sender: TObject);
begin
  // Выключаем таймер закрытия
  Undo_Timer.Enabled := False;
  // Скрываем окно
  Popup_Form.Hide;
end;

Кстати, при клике на окне, а точнее на надписи:

procedure Popup_TextClick(Sender: TObject);
begin
  // Скрываем окно
  Popup_Form.Hide;
end;

Ну и при нажатии на кнопку:

procedure Button_PopupClick(Sender: TObject);
begin
  // Показываем попап
  Popup('Привет, ' + #10 + #13 + 'я всплывающее окно...');
end;

Вот вобщем-то и всё.... можем тестить...
Файл проекта приложен к статье....

© Amper