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

Вниз

Использование класса   Найти похожие ветки 

← →
Urvin   (2003-09-18 19:20) [0]

Ну, есть код. Не подскажите как его использовать?
unit xTrayIcon;

interface

uses
Windows, Messages, SysUtils, Classes, ShellApi, Graphics, ExtCtrls, Menus;

type
TxTrayIcon = class(TComponent)
private
FLoaded: boolean;
FDefaultIcon:THandle;
FActive: boolean;
FNoShowClick:Boolean;
FHwnd: HWND;
FIcon:TIcon;
FTimer:TTimer;
FHint:String;
FPopupMenu:TPopupMenu;
FOnClick:TNotifyEvent;
FOnDblClick:TNotifyEvent;
FNIData:TNotifyIconData;
procedure SetActive(value:Boolean);
procedure SetIcon(value:TIcon);
procedure SetHint(value:string);
procedure SetPopupMenu(value:TPopupMenu);
procedure SendTrayMessage(Msg:Dword;Flags:UINT);
// Процедура обработки окна
procedure TrayWndProc(var Message:TMessage);
procedure OnButtonTimer(Sender:TObject);
function ActiveIconHandle:THandle;
protected
// Вызывается после загрузки компонента из потока
procedure Loaded;override;
procedure LoadDefaultIcon;virtual;
// Вызывается при удалении компонента Popup с формы
procedure Notification(AComponent:TComponent;Operation:TOperation);override;
public
constructor Create(AOwner:TComponent);override;
destructor Destroy;override;
published
property Active: boolean read FActive write SetActive;
// Вид иконки
property Icon:TIcon read FIcon write SetIcon;
// Текст всплывающей подсказки
property Hint:String read FHint write SetHint;
// Меню, всплывающее при нажатии правой кнопки мыши на иконке в Tray`e
property PopupMenu:TPopupMenu read FPopupMenu write SetPopupMenu;
// Возникает при клике на иконке в Tray`e
property OnClick:TNotifyEvent read FOnClick write FOnClick;
// Возникает при двойном клике на иконке в Tray`e
property OnDblClick:TNotifyEvent read FOnDblClick write FOnDblClick;
end;

procedure Register;

implementation

const
cm_xTrayIcon= WM_USER+$100;

procedure Register;
begin
RegisterComponents("XProject", [TxTrayIcon]);
end;

{ TxTrayIcon }

constructor TxTrayIcon.Create(AOwner: TComponent);
begin
inherited Create(Aowner);
FIcon:=TIcon.Create;
FTimer:= TTimer.Create(self);
with FTimer do
begin
Enabled:=false;
Interval:=GetDoubleClickTime;
OnTimer:=OnButtonTimer;
end;
LoadDefaultIcon;
// получаем Handle
FHwnd:=AllocateHwnd(TrayWndProc);
end;

destructor TxTrayIcon.Destroy;
begin
If FHwnd<>0 then DeAllocateHwnd(FHwnd);
if FActive then SetActive(false);
FIcon.free;
FTimer.free;
inherited destroy;
end;

procedure TxTrayIcon.LoadDefaultIcon;
begin
FDefaultIcon:=LoadIcon(0,IDI_WINLOGO);
end;

procedure TxTrayIcon.Loaded;
begin
inherited Loaded;
{ Сообщения индикаторной области:
NIM_ADD (0) - Добавить пиктограмму на панель задач
NIM_MODIFY (1) - Изменить свойства существующей пиктограммы
NIM_DELETE (2) - Удалить пиктограмму с панели задач
Флаги:
NIF_MESSAGE (0) - Используется Calback сервис (поле uCallbackMessage)
NIF_ICON (2) - Используется поле hIcon
NIF_TIP (4) - Используется поле szTip
}
FLoaded:=true;
If FActive then SendTrayMessage(NIM_ADD,NIF_MESSAGE or NIF_ICON or NIF_TIP);
end;

procedure TxTrayIcon.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent,Operation);
If (Operation=opRemove) and (AComponent=PopupMenu) then PopupMenu:=nil;
end;

procedure TxTrayIcon.OnButtonTimer(Sender: TObject);
begin
FTimer.enabled:=false;
if (not FNoShowClick) and Assigned(FOnClick) then FOnClick(self);
FNoShowClick:=False;
end;

procedure TxTrayIcon.SendTrayMessage(Msg: Dword; Flags: UINT);
begin
with FNIdata do
begin
cbSize:=sizeof(FNIdata);
StrPLCopy(szTip,Pchar(FHint),sizeof(szTip));
uFlags:=Flags;
uID:=UINT(self);
Wnd:=FHWND;
uCallbackMessage:=cm_xTrayIcon;
hIcon:=ActiveIconHandle
end;
Shell_NotifyIcon(Msg,@FNIdata);
end;

procedure TxTrayIcon.SetHint(value: string);
begin
If FHint<>value then
begin
FHint:=value;
If FActive and FLoaded then SendTrayMessage(NIM_MODIFY,NIF_TIP);
end;
end;

procedure TxTrayIcon.SetIcon(value: TIcon);
begin
FIcon.Assign(value);
If FActive and FLoaded then SendTrayMessage(NIM_MODIFY,NIF_ICON);
end;

procedure TxTrayIcon.SetPopupMenu(value: TPopupMenu);
begin
{ Метод FreeNotification говорит компоненту, что он должен
известить компонент, указанный в параметре о своем удалении
( путем вызова метода Notification).
}
FPopupMenu:=value;
If value<>nil then Value.FreeNotification(self);
end;

procedure TxTrayIcon.SetActive(value: Boolean);
begin

If FActive=value then exit;
FActive:=value;
if not FLoaded then exit;
If FActive then
SendTrayMessage(NIM_ADD,NIF_MESSAGE or NIF_ICON or NIF_TIP)
else
SendTrayMessage(NIM_DELETE,NIF_MESSAGE or NIF_ICON or NIF_TIP)
end;

procedure TxTrayIcon.TrayWndProc(var Message: TMessage);
var
CurPos:TPoint;
begin
with Message do
If (Msg<>cm_xTrayIcon) then
Result:=DefWindowProc(FHwnd,msg,wparam,lparam)
else
begin
If (Msg=cm_xTrayIcon) then // Сообщение от пиктограммы
begin
case lparam of
{ В Windows при выполнением пользователем двойного
щелчка генерируются два собатия: WM_LBUTTONDOWN и
WM_LBUTTONDBLCLK. Что бы отличить их запускаем таймер. }
WM_LBUTTONDOWN: FTimer.Enabled:= true;
WM_LBUTTONDBLCLK:
begin
FNoShowClick:=True;
If Assigned(FOnDBLClick) then FOnDBLClick(self);
end;
WM_RBUTTONDOWN: // Вызываем выпадающее меню
If Assigned(FPopupMenu) then
begin
SetForegroundWindow(FHWND);
GetCursorPos(CurPos);
FPopupMenu.Popup(CurPos.x,CurPos.y);
PostMessage(FHWND,WM_User,0,0);
end;
end; // case
end;
end; // with
end;

function TxTrayIcon.ActiveIconHandle:THandle;
begin
If Ficon.Handle<>0 then Result:=Ficon.handle
else Result:= FDefaultIcon
end;

end.

вопрос, конечно, странный, но как-нибудь можно решить?

---

← →
Юрий Федоров   (2003-09-18 19:31) [1]

Это компонент, его нужно инсталлировать, кинуть на форму, и использовать по прямому назначению

---

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

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

Наверх

Память: 0.46 MB
Время: 0.01 c