буду нагл до невозможности

← →
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]

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

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