Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "WinAPI";
Текущий архив: 2004.12.12;
Скачать: [xml.tar.bz2];

Вниз

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

 
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 вся ветка

Форум: "WinAPI";
Текущий архив: 2004.12.12;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.5 MB
Время: 0.04 c
3-1100599067
Algiz
2004-11-16 12:57
2004.12.12
Базы данных


14-1100843955
Сайбель Алексей
2004-11-19 08:59
2004.12.12
BDE


14-1101231153
Kurtevich
2004-11-23 20:32
2004.12.12
Жалобы на Дельфи :(


1-1101499464
GanibalLector
2004-11-26 23:04
2004.12.12
IncludeTrailingBackslash


1-1101208136
ИМХО
2004-11-23 14:08
2004.12.12
Canvas does not allow drawing





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский