Текущий архив: 2004.12.12;
Скачать: CL | DM;

Вниз

Создание прозрачного плавающего окна   Найти похожие ветки 

← →
Shura   (2004-10-27 09:15) [0]

Привет !
Суть вопроса такая - создаю форму с AlphaBlend=True, ставлю ее StayOnTop, но когда минимизируется в трей основная форма, то с экрана исчезает и плавающее окно, как сделать, чтобы оно не исчезало ?
Спасибо.

---

← →
Дмитрий Ботвин   (2004-10-27 10:13) [1]

А код приведи, тогда и посмотрим вместе....

---

← →
Shura   (2004-10-27 10:16) [2]

Код для минимизации в Tray:
ShowWindow(Application.Handle,SW_HIDE);
       Shell_NotifyIcon(NIM_ADD, @lpData);

---

← →
Дмитрий Ботвин   (2004-10-27 10:31) [3]

Кстати AlphaBlend=True в Win9x не работает...

Вот тебе пример сворачивания в Tray и при этом форма не пропадает

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Classes,
 Controls, Forms, Dialogs, Menus;

type
 TForm1 = class(TForm)
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
 private
   procedure OnMinimize(Sender: TObject);
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

uses ShellApi;

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
const
   SS = "Icon Demo"+#0;
var nim: TNotifyIconData;
begin
 nim.cbSize:=sizeof(nim);
 nim.Wnd:=Handle;
 nim.uID:=0;
 nim.uFlags:=NIF_ICON or NIF_MESSAGE or NIF_TIP;
 nim.uCallbackMessage:=WM_MYNOTIFY;
 nim.hIcon:=Application.Icon.Handle;
 Move(SS[1],nim.szTip[0],Length(SS));
 Shell_NotifyIcon(NIM_ADD,@nim);
 Application.OnMinimize:=Self.OnMinimize;
end;

procedure TForm1.OnMinimize(Sender: TObject);
begin
 Application.Restore;
 //Чтобы пропала Visible:=false;
 Visible:=true;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var nim: TNotifyIconData;
begin
 nim.cbSize:=sizeof(nim);
 nim.Wnd:=Handle;
 nim.uID:=0;
 nim.uFlags:=0;
 nim.uCallbackMessage:=0;
 nim.hIcon:=0;
 Shell_NotifyIcon(NIM_DELETE,@nim);
end;

end.

---

← →
Дмитрий Ботвин   (2004-10-27 10:32) [4]

А в твоём коде SW_HIDE попробуй заменить на SW_NORMAL

---

← →
Shura   (2004-10-27 11:06) [5]

Немного не то. Я наверное плохо объяснил, чего хочу. Есть две формы, создаются вместе
begin
 Application.Initialize;
 Application.CreateForm(TForm1, Form1);
 Application.CreateForm(TForm2, Form2);
 Application.Run;
end.
На первой производим основные действия, вторая полупрозрачная плавающая. При минимизации в трей первой формы вторая должна находится на экране, пример - Reget и его плавающее окно.

---

← →
Дмитрий Ботвин   (2004-10-27 11:37) [6]

Попробуй так:

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants,
 Classes, Graphics, Controls, Forms;

type
 TForm1 = class(TForm)
 procedure WMQueryClose(var Msg: TWMClose);
 message WM_CLOSE;
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

// ее реализация
procedure TForm1.WMQueryClose(var Msg: TWMClose);
begin
 Msg.Result := 0;
end;

end.

Тогда форма хрен закроется :-)))

---

← →
Shura ©   (2004-10-27 11:56) [7]

Так в том то и дело, что вторая форма не закрывается, а сворачивается вместе с первой. Я в этот обработчик не попадаю. Как эти формы связаны ?

---

← →
Дмитрий Ботвин   (2004-10-27 12:12) [8]

Ты его в TForm2 пропиши. Это я его проверял на TForm1.

---

← →
panov ©   (2004-10-27 12:24) [9]

>Shura ©
Наверное ты как-то не так сворачиваешь приложение.
Вот пример(только что проверен), выполняющий то, что тебе нужно:

unit ufIconTray;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Menus,
 ShellApi;

var
 WM_MyNotifyIcon: Cardinal;

type

 TfIconTray = class(TForm)

   //PopUp-меню, всплывающее при клике на иконку
   pmIconTray: TPopupMenu;

   //Пункты меню
   pmIconTrayRestore: TMenuItem;       //Восстановление приложения
   pmIconTrayExit: TMenuItem;          //Завершение программы
   pmIconTrayNoAction: TMenuItem;      //Фиктивный пункт меню

   procedure FormCreate(Sender: TObject);
   procedure IconTray(aAction: Cardinal);    //Процедура для манипуляций с иконкоё в SysTray
   procedure pmIconTrayRestoreClick(Sender: TObject);
   procedure pmIconTrayExitClick(Sender: TObject);
   procedure MyWndProc(var Message: TMessage);
   procedure FormShow(Sender: TObject); //процедура, перекрывающая
                                               //стандартную оконную процедуру
 end;

var
 fIconTray: TfIconTray;

implementation

uses uForm2;

{$R *.dfm}

procedure TfIconTray.FormCreate(Sender: TObject);
var
 UniqueStr: String;
begin
 Application.Title := Self.Caption;
 UniqueStr := Application.Title+IntToStr(Application.Handle);
//Получаем уникальный номер Windows-сообщения.
 WM_MyNotifyIcon := RegisterWindowMessage(PChar(UniqueStr));
//Заменяем обработчик стандартный обработчик сообщений на наш
 WindowProc := MyWndProc;
end;

procedure TfIconTray.MyWndProc(var Message: TMessage);
var
 P: TPoint;
begin
 //Обработка сообщения от иконки в SysTray
 if Message.Msg = WM_MyNotifyIcon then
 begin
   case Message.LParam of

     WM_LBUTTONDBLCLK :
       begin
         //Восстанавливаем приложение
         ShowWindow(Application.Handle,SW_RESTORE);
         //Восстанавливаем основную форму
         ShowWindow(Application.MainForm.Handle,SW_RESTORE);
         //Приложение - на передний план
         SetForegroundWindow(Application.MainForm.Handle);
         //Удаляем иконку
         IconTray(NIM_DELETE);
       end;
     //Клик на правой кнопке мыши
     WM_RBUTTONUP:
     begin
       //Считываем позицию курсора на экране
       GetCursorPos(P);
       //Показываем меню в позиции курсора
       pmIconTray.Popup(P.X, P.Y);
     end;
   end;
   //Заканчиваем обработку
   Message.Result := 0;
   Exit;
 end;
 //Обработка нажатия на кнопку свернуть в заголовке окна
 if (Message.Msg=WM_SYSCOMMAND) and
    (Message.wParam = SC_MINIMIZE) then
 begin
   //Добавляем иконку
   IconTray(NIM_ADD);
   //Скрываем основную форму
   ShowWindow(Application.MainForm.Handle,SW_HIDE);
   //Скрываем приложение
   ShowWindow(Application.Handle,SW_HIDE);
   //Заканчиваем обработку
   Message.Result := 0;
   Exit;
 end;
 //Не наше сообщение - вызываем стандартную процедуру окна
 WndProc(Message);
end;

//Процедура для манипуляций с иконкой
procedure TfIconTray.IconTray(aAction: Cardinal);
var
 nid: TNotifyIconData;
begin
//Заполнение структуры
 nid.cbSize := SizeOf(TNotifyIconData);    //Размер структуры
 nid.Wnd := Self.Handle;                   //Окно назначения
 nid.uID := 0;                             //Назначаем идентификатор иконке
 nid.uCallBackMessage := WM_MyNotifyIcon;  //Процедура для обработки сообщений
 nid.hIcon := Application.Icon.Handle;     //Это основная иконка приложения
 StrPCopy(nid.szTip,Application.Title);    //Всплывающая подсказка (Hint)
//Признаки:
//  NIF_ICON    - используется поле nid.hIcon
//  NIF_MESSAGE - используется сообщение с номером nid.uCallBackMessage для обработки
//  NIF_TIP     - для иконки назначен Hint - всплывающая подсказка.
 nid.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
 case aAction of
   NIM_ADD:  Shell_NotifyIcon(NIM_ADD, @nid);        //Добавление иконки
   NIM_DELETE:  Shell_NotifyIcon(NIM_DELETE, @nid);  //Удаление иконки
   NIM_MODIFY:  Shell_NotifyIcon(NIM_MODIFY, @nid);  //Модификация иконки
 end;
end;

//Обработка при выборе пункта меню "Восстановить"
procedure TfIconTray.pmIconTrayRestoreClick(Sender: TObject);
begin
//Посылаем нашему окну сообщение WM_LBUTTONDBLCLK
 PostMessage(Application.MainForm.Handle,WM_MyNotifyIcon,0,WM_LBUTTONDBLCLK);
end;

//Обработка при выборе пункта меню "Выход из программы"
procedure TfIconTray.pmIconTrayExitClick(Sender: TObject);
begin
//Посылаем нашему окну сообщение WM_LBUTTONDBLCLK
 PostMessage(Application.MainForm.Handle,WM_MyNotifyIcon,0,WM_LBUTTONDBLCLK);
//Закрываем приложение
 Application.MainForm.CLose;
end;

procedure TfIconTray.FormShow(Sender: TObject);
begin
 if not Boolean(Tag) then
 begin
   Form2.Show;
   Tag := 1;
 end;
end;

end.



---

← →
panov ©   (2004-10-27 12:29) [10]

Да, в коде есть недочет, далее исправлен:

procedure TfIconTray.MyWndProc(var Message: TMessage);
var
 P: TPoint;
begin
 //Обработка сообщения от иконки в SysTray
 if Message.Msg = WM_MyNotifyIcon then
 begin
   case Message.LParam of

     WM_LBUTTONDBLCLK :
       begin
         //Восстанавливаем приложение
         ShowWindow(Application.Handle,SW_RESTORE);
         //Восстанавливаем основную форму
         ShowWindow(Application.MainForm.Handle,SW_RESTORE);
         //Приложение - на передний план
         SetForegroundWindow(Application.MainForm.Handle);
         //Удаляем иконку
         IconTray(NIM_DELETE);
       end;
     //Клик на правой кнопке мыши
     WM_RBUTTONUP:
     begin
       //Считываем позицию курсора на экране
       GetCursorPos(P);
       //Показываем меню в позиции курсора
       SetForegroundWindow(Application.MainForm.Handle);
       pmIconTray.Popup(P.X, P.Y);
     end;
   end;
   //Заканчиваем обработку
   Message.Result := 0;
   Exit;
 end;
 //Обработка нажатия на кнопку свернуть в заголовке окна
 if (Message.Msg=WM_SYSCOMMAND) and
    (Message.wParam = SC_MINIMIZE) then
 begin
   //Добавляем иконку
   IconTray(NIM_ADD);
   //Скрываем основную форму
   ShowWindow(Application.MainForm.Handle,SW_HIDE);
   //Скрываем приложение
   ShowWindow(Application.Handle,SW_HIDE);
   //Заканчиваем обработку
   Message.Result := 0;
   Exit;
 end;
 //Не наше сообщение - вызываем стандартную процедуру окна
 WndProc(Message);
end;


---

← →
Shura ©   (2004-10-27 12:57) [11]

>Дмитрий Ботвин
Я его туда и прописал.
>panov
Я делаю почти также, только не через перехват сообщений, а через ApplicationEvents.OnMinimize, и еще у меня нет MainForm - SDI. Создание всех форм происходит после Initialize.

---

← →
Shura ©   (2004-10-27 13:03) [12]

Уупс ! По поводу "у меня нет MainForm" виноват, ошибся :-) С остальным надо поразбираться.

---

← →
Shura ©   (2004-10-27 13:56) [13]

Этот код сработал, но только если нажать на "минус" на форме, а если на панели задач, то эффекта нет.

---

Страницы: 1 вся ветка

Текущий архив: 2004.12.12;
Скачать: CL | DM;

Наверх

Память: 0.51 MB
Время: 0.03 c