Delphi programming blog
Источник: http://teran.karelia.pro/articles/item_4416.html
 

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

Опубликовано 04.05.2010 г. 00:53

Не знаю почему, но мне вдруг стало интересно узнать как реализованы всплывающие окна как, например, у различных IM клиентов, "xyz is typing message..", "xyz changed status to online.." и т.п. Т.е небольшие всплывающие окошки в правом нижем углу экрана, информирующие пользователя о тех или иных событиях. Итак, как же можно получить такие окна,- задумался я. Гугл ничего интересного не рассказал и идея остановилась на реализации всплывающего окна с помощью обычной формы, на которую поместили один экземпляр TImage, три TLabel, и один таймер TTimer. Сразу скажу, что TImage, очевидно используется для отображения аватара нашего виртуального клиента, TLabel используются для отображения времени, имени пользователя, и текста сообщения; и таймер для автоматического закрытия окна через определенный интервал времени. Допустим наши события, которые мы можем отображать будут делиться на два типа: оповещение и ошибка. Переходя к коду опишем их с помощью следующего перечисления:

    TEventType = (etNotify, etError);

Да, приложение наше будет состоять из двух форм, одна главная TMainForm, и как говорилось форма всплывающего окна TPopupForm. Для хранения аватаров пользователей заведем на главной форме TImageList, в который добавим некоторый набор картинок. Список же пользователей будем хранить в экземпляре uList : TStringList (глобальная переменная), который непосредственно заполним при создании главной формы:

implementation
var uList : TStringList;
......
    uList := TStringList.Create;
    with uList do begin
        add('qwe');
        add('asd');
        add('zxc');
    end;

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

const WM_POPUPEVENT = WM_USER + 1;

Для описания события определим структуру TPopupInfo, которая будет хранить следующую информацию: время возникновения, тип события (TEventType), некоторый идентификатор действия, текстовое описание события, имя пользователя, и иконка пользователя.

    PPopupInfo = ^TPopupInfo;
    TPopupInfo = record
        time : TDateTime;
        pType : TEventType;
        action : byte;
        text   : string;
        user : string;
        ico : HICON;
    end;

Теперь пришло время начать генерировать данные события, и передавать их, с помощью таймера EventTimer. Нам понадобятся три локальные переменные: тип события eventType : TEventType, указатель на структуру для хранения информации о событии data : PPopupInfo, и иконка для события icon : TIcon. Алгоритм работы будет следующий: 1. сформируем случайный код события eventType, сформируем случайный интервал времени для срабатывания таймера в следующий раз (max=10сек), выделим память для структуры TPopupInfo, и запишем туда код события. 2. инициализируем icon : TIcon и запишем туда случайную иконку из нашего TImageList, после чего handle иконки также сохраним в структуре data. 3. заполним время возникновения события, и в зависимости от типа события заполним данные text, user, action структуры data. 4. отправим сообщение используя SendMessage, причем в качестве wParam будет выступать тип события, и в lParam сохраним адрес нашей заполненной структуры.

procedure TMainForm.EventTimerTimer(Sender: TObject);
var eventType : TEventType;
    data : PPopupInfo;
    icon : TIcon;
begin
    eventType := TEventType(random());
    eventTimer.Interval := 1 + random(100)*100;

    new(data);
    data.pType := eventType;

    icon := TIcon.Create;
    imageList.GetIcon(random(imageList.Count),icon);
    data.ico := icon.Handle;

    data.time := getTime();
    case eventType of
        etNotify :  begin
                        with data^ do begin
                            text := 'asdasdasd';
                            user := uList.Strings[random(uList.Count)];
                            action := random(10);
                        end;
                    end;
        etError  :  begin
                        with data^ do begin
                            text := 'error text!';
                            action := random(2);
                        end;
                    end;
    end;

    SendMessage(self.Handle, WM_POPUPEVENT, integer(eventType), integer(data));
end;

С помощью приведенных действий мы сымитировали приход произвольного сообщения, которое теперь требуется обработать. Для чего в описание нашей формы добавим обработчик события WM_POPUPEVENT. В обработчике извлечем переданный тип события и информацию о событии, после чего создадим popup форму, конструктор которой будет принимать структуру описания события.

private 
      procedure wmPopupEvent(var msg : TMessage); message WM_POPUPEVENT;
....
procedure TMainForm.wmPopupEvent(var msg: TMessage);
var eventType : TEventType;
    data : PPopupInfo;
begin
    eventType := TEventType(msg.WParam);
    data := ptr(msg.LParam);
    TPopupForm.Create(data);
end;

Далее нам предстоит еще один интересный шаг. Чтобы управлять всплывающими окнами (упорядочивать их) и предоставлять информацию о настройках окон (цвет, прозрачность, время отображения) опишем класс TPopupConfig:

    TPopupConfig = class
      strict private
        popupList : TList;
        procedure updateWindowPos(pwh : HWND);
      public
        Colors   : array[TEventType] of TColor;
        Alpha    : array[TEventType] of Byte;
        Interval : array[TEventType] of Cardinal;

        procedure registerPopup(pwh: HWND);
        procedure unregisterPopup(pwh: HWND);
        constructor Create;
        destructor  Destroy;
    end;

какие методы и переменные имеет наш класс? 1. массивы Colors, Alpha, Interval - для хранения настроек окон, по типу сообщения, которые заполняются в конструкторе. 2. конструктор и деструктор. 3. При создании всплывающего окна, окно будет регистрироваться в нашем классе, а при закрытии наоборот. Для этого предусмотрены функции registerPopup & unregisterPopup. 4. список открытых в настоящее время окон будет хранится в списке popupList 5. для реорганизации списка окон предусмотрена процедура UpdateWindowPos. (т.е например при закрытии первого всплывающего окна, требуется переместить остальные вниз). Итак, конструктор (заполняем цвета, прозрачности, время, инициализируем список окон) и деструктор (освобождаем список):

constructor TPopupConfig.Create;
begin
    colors[etNotify] := clWhite;
    colors[etError] := clRed;

    alpha[etNotify] := 220;
    alpha[etError] := 150;

    interval[etNotify] := 3000;
    interval[etError] := 4000;

    popupList := TList.create();
end;

destructor TPopupConfig.Destroy;
begin
    popupList.Free;
end;

При регистрации нового окна в нашем классе, будем передавать его обработчик, добавлять его в список, после чего вызывать процедуру реорганизации. После закрытия окна, передав handle окна в процедуру, будем удалять окно из списка, и опять перестраивать окна.

procedure TPopupConfig.registerPopup(pwh: HWND);
begin
    if not popupList.Contains(pwh) then
        popupList.Add(pwh);

    updateWindowPos(pwh);
end;

procedure TPopupConfig.unregisterPopup(pwh: HWND);
begin
    if popupList.Contains(pwh) then begin
        popupList.Extract(pwh);
        updateWindowPos(pwh);
    end;
end;

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

procedure TPopupConfig.updateWindowPos(pwh: HWND);
var r : TRect;
    i,index:integer;
    x,y : integer;
begin
    y:= screen.WorkAreaHeight;
    x := screen.WorkAreaWidth;
    for i:=0 to popupList.Count - 1 do begin
        getWindowRect(popupList[i],r);
        dec(y, r.Bottom  - r.Top + 2);
        setWindowPos(popupList[i], HWND_TOPMOST,
                        x - (r.Right - r.left),
                        y,
                        r.Right - r.Left,
                        r.Bottom - r.Top ,
                        SWP_SHOWWINDOW + SWP_NOACTIVATE);
    end;
end;

Для управления нашими цветами окон и другими свойствами разместим на главной форме переключатель TypeCombo (TComboBox) для выбора настраиваемого окна, TButtonColor для выбора цвета окна, пару TEdit и TUpDown для настройки времени отображения и прозрачности. Используя данные элементы управления будем изменять соответствующие свойства в TPopupConfig.

//прозрачность
procedure TMainForm.AlphaUpDownClick(Sender: TObject; Button: TUDBtnType);
var eType  : TeventType;
begin
    eType := TEventType(typeCombo.ItemIndex);
    popupConfig.Alpha[eType] := AlphaUpDown.Position;
end;
//цвет
procedure TMainForm.ColorButtonClick(Sender: TObject);
var eType  : TeventType;
begin
    eType := TEventType(typeCombo.ItemIndex);
    popupConfig.Colors[eType] := colorDialog.Color;
end;
//время показа окна, в секундах
procedure TMainForm.timeUpDownClick(Sender: TObject; Button: TUDBtnType);
var eType  : TeventType;
begin
    eType := TEventType(typeCombo.ItemIndex);
    popupConfig.interval[eType] := timeUpDown.Position * 1000;
end;
//смена настраиваемого типа окна.
procedure TMainForm.typeComboChange(Sender: TObject);
var index : integer;
    eType : TEventType;
begin
    index  := typeCombo.ItemIndex;
    eType := TEventType(index);

    alphaUpDown.Position := popupConfig.Alpha[eType];
    timeUpDown.Position  := popupConfig.interval[eType] div 1000;
    colorDialog.Color    := popupConfig.Colors[eType];
end;

Расширим процедуру создания главной формы, и помимо заполнения списка "контактов", создами наш класс настройки (глобальная переменная), а также заполним наш typeCombo и выполним сопутствующие действия

var eventType : TEventType;
    eventName : string;
begin
    popupConfig := TPopupConfig.Create;

    colorButton.LinkProperty(colorDialog,'Color');

    for eventType := low(TEventType) to high(TEventType) do begin
        eventName :=  getEnumName(TypeInfo(TEventType),integer(eventType));
        typeCombo.Items.Add(copy(eventName,3,length(eventName) - 2));
    end;
    TypeCombo.ItemIndex := 0;
    TypeComboChange(self);
...
    //заполнение uList
end;

Вот в общем то и все, что касается главного модуля программы. Теперь перейдем непосредственно к самому всплывающему окну. Здесь нам предстоит переписать конструктор окна, в котором будет выполнены действия по настройке его вида, запустить таймер времени жизни окна, по срабатыванию которого окно будет закрыто, ну и собственно саму процедуру закрытия окна. Итак, конструктор мы перепишем, так чтобы в качестве параметра он принимал, как уже гооврилось выше, структуру описания нашего события.

  public
    constructor Create(info : PPopupInfo);

Какие действия следует выполнить в конструкторе: 1. вызвать родительский конструктор. 2. настроить цвет, прозрачность и время жизни, получив их у popupConfig 3. заполнить данные в Label'ах и установить иконку 4. зарегистрировать наше окно в popupConfig 5. запустить таймер времени жизни 6. очистить память которую занимала полученная структура TPopupInfo

constructor TPopupForm.Create(info: PPopupInfo);
begin
    inherited Create(nil);

    color := popupConfig.colors[info.pType];
    AlphaBlendValue     := popUpConfig.Alpha[info.pType];
    popupTimer.Interval := popupConfig.interval[info.pType];

    timeLabel.Caption := formatDateTime('hh:nn:ss',info.time);
    userLabel.caption := info.user;
    textLabel.Caption := info.text;

    iconImage.Picture.Icon.Handle := info.ico;

    popupConfig.registerPopup(handle);
    popupTimer.Enabled := true;

    dispose(info);
end;

При срабатывании таймера следует закрыть окно

procedure TPopupForm.popupTimerTimer(Sender: TObject);
begin
    destroy;
end;

В результате чего будет вызван обработчик события OnDestory в котором мы плавно скроем окно, и разрегистриурем его в нашем popupConfig'е

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

вот собственно и все. Кстати свойство visible формы установлено в false, а также в событие onClick можно также указать обработчик popupTimerTimer для закрытия окна по клику. Вот кажется и описал все что касатеся созданных всплывающих окон. На самом деле у данной реализации есть один недостаток, при подобной реализации затухания окна при закрытии, а именно использовании функции sleep, засыпает основной поток, т.е главная форма программы также перестает реагировать. Т.е необходимо чтобы вслывающие окна запускались в новом потоке. Напоследок, как обычно рисунок

Метки:  messages  |  popups 

Комментарии

Sergey
05.05.2010 в 12:38
Посмотрите как сделано здесь.
http://narod.ru/disk/20419367000/IngAlertWindow.7z.html
guest
21.03.2013 в 00:42
Спасибо
ter
05.05.2010 в 20:57
посмотрел (: спасибо за ссылку. однако на мой взгляд не самый удачный вариант реализации.
Sergey
06.05.2010 в 12:06
Почему?
ter
06.05.2010 в 19:24
с точки зрения удобства использования, на мой взгляд. во первых при компиляции и установке в d2010 и добавлении компонента на форму, есть какие то проблемы с надписями которые в text и captions вроде. изначально дефолтные русские названия вобще отображаются в не пойми какой кодировке. при изменении данных свойств отображается только первый символ (в режиме редактирования).
второе что мне не понравилось, это то что окно целиком как оно есть добавляется на форму, занимая там достаточно большое пространство. понятно дело что можно его уменьшить, и потом в коде задавать размеры. но сам факт не очень удобен.
третье, данный попап вроде как отображается в постоянном месте. т.е если собирается очередь событий таких, то надо все равно реализовывать какой то менеджер для управления ими, и их позиционирования.
Sergey
07.05.2010 в 12:37
Писал в Delphi 7, под D2010 не тестировал.
Ну, для очереди сообщений - согласен, надо доделать.

Просто я считаю, что попапы слишком жирно наследовать от TForm. Поэтому и выложил свой пример более легкой реализации.
ter
07.05.2010 в 20:10
ну как бы да. реализовывать с помощью TForm не очень хорошо. поэтому собственно и задумался как их делать лучше. но с другой стороны такой вариант гораздо проще с точки зрения реализации, и переделки формы, в смысле расположения надписей и т.п
mihkod
07.05.2010 в 13:49
хорошо бы выложить исходники проекта...
Sergey
07.05.2010 в 15:39
Действительно, автор статьи, может выложите исходники проекта?
ter
07.05.2010 в 20:47
в принципе может (: я только хз как сюда архив залить (: че то только картинки позволяет. думаю решу данный вопрос в ближайшее время.
ter
08.05.2010 в 16:07
Залил код на delphisources.ru (: мб скоро там появится
копию залил на iFolder : http://ifolder.ru/17628825
Алексей Тимохин
08.05.2010 в 01:35
В JVCL есть готовый компонент, реализующий стек всплывающих окон. Поддерживаются пара эффектов, текст, заголовок, иконка, дополнительные кнопки и Popup Menu. TjvDesktopAlert. Как это выглядит можно посмотреть здесь
ter
08.05.2010 в 14:25
Весьма интересно (:
скачал пример расположенный тут
смотрится хорошо, но имеют свойство вешаться намертво.
1. жмем preview, получаем popup окно
2. передвигаем полученное окно
3. вызываем выпадающее меню (которое рядом с кнопкой закрытия окна)
4. жмем кнопку ClickMе, появляется сообщение.
5. переводим мышь куда нить из области окна, программа перестает отвечать.
Алексей Тимохин
09.05.2010 в 15:28
Да, действительно, есть такая бяка.

Сейчас, ради интереса перекомпилировал и запустил этот пример в Delphi 2010 - баг пропал. Значит, уже исправили.
vlkc
26.07.2012 в 17:32
а как поместить на popup компонент edit? чтобы он был виден при активации...
teran
05.08.2012 в 13:58
в данном случае всплывающие окна сделаны с помощью обычной формы. Следовательно и Edit туда помещается обычным образом. Если показывать его надо только при активации формы, то соответственно изначально он скрыт. Или речь не об этом?
daver
13.10.2012 в 11:11
Исходник можно в "студию" ?
teran
13.10.2012 в 16:52
прицепил, но исходник весьма старый, так что качество кода наверное не очень хорошее.
https://2pay.pro/titan-gel
12.05.2017 в 19:30
где можно купить титан гель
гель титан отзывы покупателей
титан гель купить в спб
титан гель реальные отзывы
купить гель титан в аптеке
где в москве купить титан гель
Cecila
18.05.2017 в 11:30
Смотрите лучше здесь:
ландшафтный дизайн
ландшафтный дизайн (Geri)
ландшафтный дизайн
ландшафтный дизайн (Geri)
ландшафтный дизайн - Geri -
ландшафтный дизайн (Geri)
goo.gl
24.05.2017 в 12:55
Смотрите лучше здесь:
ландшафтный дизайн - Velma -
https://goo.gl/sPCzNX
ландшафтный дизайн (https://goo.gl)
https://goo.gl/z7AMCO
ландшафтный дизайн; Velma,
https://goo.gl/TMAHM6
Kassandra
31.05.2017 в 20:56
Эрофорс купить в Украине
EroForce — капсулы для потенции, которые оказывают комплексное воздействие на
мужской организм. Это средство способно решить
множество проблем, начиная с ослабления либидо и заканчивая полной импотенцией.

Препарат снова вернёт радость от секса.

Капсулы Eroforce практически не имеют аналогов по своему воздействию и обладают массой
достоинств по сравнению с похожими средствами:
быстрый длительный эффект;
натуральный состав;
усиление либидо;
капсулы не просто маскируют, а излечивают
и устраняют проблему полностью;
продлевают половой акт;
делают ощущения более яркими;
не имеют противопоказаний;
удобны в применении.
казино смотреть
02.06.2017 в 18:53
видео слот казино
казино карты
казино онлайн бесплатно
вылазит реклама казино
казино рояль ева грин
красная поляна в сочи
сайт сочи
казино платья каталог
казино x
реклама казино вулкан
казино скорсезе
казино вулкан онлайн бесплатно без
регистрации
бездепозитный бонус казино при регистрации 2015
как убрать вулкан казино со стартовой страницы
вулкан казино как удалить
казино собрание
sochi.ru
http://tinyurl.com/yb7deft6
http://tinyurl.com/y7lf85dq
http://tinyurl.com/y8nmvf7l
http://tinyurl.com/y8ecy5cb
http://tinyurl.com/ybgyy6q2
http://tinyurl.com/ycxmr8su
http://tinyurl.com/ybqt4c2b
http://tinyurl.com/yd7hnsbs
http://tinyurl.com/ybu8e5z9
http://tinyurl.com/y7ga8lq7
http://tinyurl.com/yayltrrc
http://tinyurl.com/y79ysm3p
http://tinyurl.com/yb6npq3y
http://tinyurl.com/y9a3aosb
http://tinyurl.com/y9rtj2fq
http://tinyurl.com/ybw66l8b
http://tinyurl.com/yaw5ezxg
http://tinyurl.com/y77t6446
азартные игры казино
казино арго
интернет казино онлайн
сам открывается браузер с рекламой казино
игры в казино
cs go казино рулетка
скрипт казино
легальное казино в россии
ленинград хочу в сочи
казино рояль смотреть
казино зеон
казино ксго
интернет казино вулкан отзывы
казино вулкан ставка
онлайн казино с бездепозитным бонусом
нахуй кино играй в казино
казино азартмания отзывы
http://tinyurl.com/ydxuz4q4
http://tinyurl.com/yazjcgnt
http://tinyurl.com/y9y8hvzb
http://tinyurl.com/ybdm7hcd
http://tinyurl.com/y826rznb
http://tinyurl.com/y7rfa2fj
http://tinyurl.com/y8t6hulg
http://tinyurl.com/y7psjapd
http://tinyurl.com/yc8c4qu3
http://tinyurl.com/y9qh3md5
http://tinyurl.com/y6uoofsw
http://tinyurl.com/yd9xzvf9
http://tinyurl.com/ycy567u2
http://tinyurl.com/y782nacy
http://tinyurl.com/y9f9454h
http://tinyurl.com/yb55gf29
http://tinyurl.com/yacmolrb
http://tinyurl.com/ycfn9wjh
рулетка казино
03.06.2017 в 04:57
казино рояль
открывается браузер с рекламой казино
фишки нет развлекательный сайт
казино на алтае
красная поляна в сочи
вулкан казино официальный сайт
казино рулетка
казино песня
бездепозитный бонус 2017 казино
казино рояль смотреть онлайн
курорт.ру
онлайн казино на реальные деньги без вложений
последнее казино
скачать игровые автоматы
всплывает окно казино вулкан
казино император
казин
http://tinyurl.com/y9b42hpr
http://tinyurl.com/ycd5lx39
http://tinyurl.com/y99a4bz2
http://tinyurl.com/yccuf3f8
http://tinyurl.com/y9yhuw5y
http://tinyurl.com/yb7947ru
http://tinyurl.com/ybn5zhsp
http://tinyurl.com/ycxps3o3
http://tinyurl.com/y7nmvtgv
http://tinyurl.com/yb535sgr
http://tinyurl.com/y9mg5xbw
http://tinyurl.com/yatrzdka
http://tinyurl.com/yagbarz3
http://tinyurl.com/ybt8sjgg
http://tinyurl.com/y7w97s39
http://tinyurl.com/ybmfbk97
http://tinyurl.com/yahtyupf
http://tinyurl.com/y87ztgc5
titan gel mua o dau
09.06.2017 в 05:34
How does titan gel kaufen solve?
Titan gel for men
The $ttnglvn767 unequalled means delivered the expected result flush if obtained with rude methods or secondhand on an irregular basis.

Thanks to the forward-looking methods of devising the
elicit and its combination with many rude active substances, the creators of
"Titan gel" managed to achieve an telling resultant
role!
run 3 cool math
27.04.2018 в 05:50
So luck to come across your excellent blog. Your blog brings me a great deal of fun.. Good luck with the site
- Имя
- e-mail*
- Сайт
вы можете использовать теги [i],[b],[code],[quote]
Дополнительно