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

Вниз

буду нагл до невозможности   Найти похожие ветки 

 
kukuikar   (2002-10-17 21:04) [0]

На примере:
unit Unit1;

interface

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

type
TTrayForm = class(TForm) // Главная форма приложения
TrayPopupMenu: TPopupMenu;
MenuItemShow: TMenuItem; // "Показать"
MenuItemExit: TMenuItem; // "Выход"
procedure FormCreate(Sender: TObject); // OnCreate
procedure MenuItemShowClick(Sender: TObject); // OnClick
procedure MenuItemExitClick(Sender: TObject); // OnClick
private
FIconData: TNotifyIconData;
procedure WMUser(var Message: TMessage); message WM_USER;
procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
end;

var
TrayForm: TTrayForm;

implementation

{$R *.DFM}

procedure TTrayForm.FormCreate(Sender: TObject);
begin
with Application, FIconData do
begin
ShowMainForm := False;
SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_TOOLWINDOW);
cbSize := SizeOf(FIconData);
Wnd := Self.Handle;
uID := 100;
uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
uCallbackMessage := WM_USER;
hIcon := Icon.Handle;
StrPCopy(szTip, Title)
end;
Shell_NotifyIcon(NIM_ADD, @FIconData)
end;

procedure TTrayForm.MenuItemShowClick(Sender: TObject);
begin
Show;
MenuItemShow.Enabled := False
end;

procedure TTrayForm.MenuItemExitClick(Sender: TObject);
begin
Shell_NotifyIcon(NIM_DELETE, @FIconData);
Close
end;

procedure TTrayForm.WMSysCommand(var Message: TWMSysCommand);
begin
if Message.CmdType and $FFF0 = SC_MINIMIZE then
begin
Hide;
MenuItemShow.Enabled := True
end
else inherited
end;

procedure TTrayForm.WMUser(var Message: TMessage);
var
P: TPoint;
begin
if Message.LParam = WM_RBUTTONDOWN then
begin
GetCursorPos(P);
SetForegroundWindow(Handle);
TrayPopupMenu.Popup(P.X, P.Y);
PostMessage(Handle, WM_NULL, 0, 0)
end
end;

end.

КАК и какую здесь надо добавить процедуру, чтобы иконка реагировала на двойной клик...


 
TTCustomDelphiMaster   (2002-10-17 21:48) [1]

procedure TTrayForm.WMUser(var Message: TMessage);
var
P: TPoint;
begin
if Message.LParam = WM_LBUTTONDBLCLK then
begin
...
end;

if Message.LParam = WM_RBUTTONDOWN then
begin
GetCursorPos(P);
SetForegroundWindow(Handle);
TrayPopupMenu.Popup(P.X, P.Y);
PostMessage(Handle, WM_NULL, 0, 0)
end
end;


 
Юрий Зотов   (2002-10-17 22:38) [2]

Ба, что-то знакомое...
:о)
Значит, не зря. Ето радовает...

Дополнение к ответу TTCustomDelphiMaster.

В обработчике WM_USER параметр LParam содержит реальное сообщение мыши. Если нужно, то можно сделать этот обработчик более общим.

procedure TTrayForm.WMUser(var Message: TMessage);
var
...
begin
case Message.LParam of
WM_LBUTTONDOWN:
begin
...
end;
WM_LBUTTONUP:
begin
...
end;
WM_LBUTTONDBLCLK:
begin
...
end;
WM_RBUTTONDOWN:
begin
...
end;
WM_RBUTTONUP:
begin
...
end;
WM_RBUTTONDBLCLK:
begin
...
end;
WM_MBUTTONDOWN:
begin
...
end;
WM_MBUTTONUP:
begin
...
end;
WM_MBUTTONDBLCLK:
begin
...
end;
WM_MOUSEMOVE: // А вот так можно "оживить" иконку
begin
...
end;
WM_MOUSEWHEEL:
begin
...
end
end
end;

Если при этом требуется еще и проверить состояние клавиатуры, можно использовать GetKeyState или GetKeyboardState.


 
kukuikar   (2002-10-17 23:08) [3]

Да уж, Юрий...
Ваших Рук Дело, Хорошее дело.
Мне помогло...
Большое спасибо...
Черт побери, все таки ...
сколько я еще не знаю...
Вы молодцы...
СПАСИБО ВСЕМ,,,,,



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

Форум: "Основная";
Текущий архив: 2002.10.28;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.56 MB
Время: 0.032 c
3-92368
_pavel_
2002-10-07 18:13
2002.10.28
VCL компоненты на MySQL


1-92595
Slexx
2002-10-17 08:20
2002.10.28
интерфейс


1-92495
KonuhovSergey
2002-10-18 14:07
2002.10.28
Помогите с експортом в Excel


14-92721
NewI
2002-10-08 11:37
2002.10.28
Кто-нибудь знает есть ли Service Pack для Delphi_6


3-92372
Oleg_er
2002-10-08 06:41
2002.10.28
TQuery & SELECT fld, (SELECT fld1 FROM ...) as..., FROM...





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский