Форум: "Основная";
Текущий архив: 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.45 MB
Время: 0.015 c