unit IkonaZasobnika;

interface

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

type
  TIkonaZasobnikaCzynnosci=(izDodaj=NIM_ADD,izZmien=NIM_MODIFY,izUsun=NIM_DELETE);

  //TIkonaZasobnika = class(TComponent)
  TIkonaZasobnika = class(TWinControl)
  private
    FIkona :TIcon;
    FWidoczna :Boolean;
    FPodpowiedz :String;
    FOkno :TForm;
    procedure UstalWlasnosciIkony(czynnosc :TIkonaZasobnikaCzynnosci);
    procedure ZmianaIkony(Sender :TObject); //typ TNotifyIcon dla Icon.OnChange
  protected
  public
    constructor Create(AOwner :TComponent); override;
    destructor Destroy; override;

    procedure SetIcon(AIcon :TIcon);
    procedure SetVisible(AVisible :Boolean);
    procedure SetHint(AHint :String);
  published
    property Icon :TIcon read FIkona write SetIcon;
    property Visible :Boolean read FWidoczna write SetVisible default True;
    property Hint :String read FPodpowiedz write SetHint;

  //Menu kontekstowe
  private
    FMenuKontekstowe :TPopupMenu;
  published
    property PopupMenu :TPopupMenu read FMenuKontekstowe write FMenuKontekstowe default nil;
  protected
    procedure WndProc(var Message: TMessage); override;

  //Zdarzenia
  private
    IloscKlikniec :Byte;
    Timer :TTimer;
    FOnClick,FOnDblClick :TNotifyEvent;
    procedure TimerTimer(Sender :TObject); //typ TNotifyIcon dla Timer.OnTimer
  published
    property OnClick :TNotifyEvent read FOnClick write FOnClick default nil;
    property OnDblClick :TNotifyEvent read FOnDblClick write FOnDblClick default nil;
  end;


procedure Register;

const WM_IKONAZASOBNIKA=WM_USER+1;

var IloscIkon :Cardinal =1;

implementation

constructor TIkonaZasobnika.Create(AOwner :TComponent);
var obraz: TImage;
begin
inherited Create(AOwner);

//licznik ikon (dzieki temu na formie moze byc wiecej niz jedna)
Inc(IloscIkon);

//wlasnosci
FOkno:=TForm(AOwner);
FIkona:=TIcon.Create;
FIkona.Assign(Application.Icon);
FWidoczna:=True;
FPodpowiedz:='';

UstalWlasnosciIkony(izDodaj);

//podpiecie metody zdarzeniowej
FIkona.OnChange:=ZmianaIkony;

//zdarzenia
Timer:=TTimer.Create(Self);
Timer.Enabled:=False;
Timer.Interval:=GetDoubleClickTime;
Timer.OnTimer:=TimerTimer;
IloscKlikniec:=0;

//widok projektowania
if (csDesigning in Owner.ComponentState) then
  begin
  Width:=32;
  Height:=32;
  obraz:=TImage.Create(Self);
  obraz.Parent:=Self;
  obraz.Align:=alClient;
  obraz.Stretch:=True;
  obraz.Picture.Icon.Assign(FIkona);
  end;
end;

destructor TIkonaZasobnika.Destroy;
begin
if Assigned(Parent) then UstalWlasnosciIkony(izUsun);
FIkona.Free;
Timer.Free;
inherited;
end;

procedure TIkonaZasobnika.SetIcon(AIcon :TIcon);
begin
FIkona.Assign(AIcon);
UstalWlasnosciIkony(izZmien);
end;

procedure TIkonaZasobnika.SetVisible(AVisible :Boolean);
begin
if AVisible and (not FWidoczna) then UstalWlasnosciIkony(izDodaj);
if (not AVisible) and (FWidoczna) then UstalWlasnosciIkony(izUsun);
FWidoczna:=AVisible;
end;

procedure TIkonaZasobnika.SetHint(AHint :String);
begin
FPodpowiedz:=AHint;
UstalWlasnosciIkony(izZmien);
end;

procedure TIkonaZasobnika.ZmianaIkony(Sender :TObject);
begin
UstalWlasnosciIkony(izZmien);
end;

procedure TIkonaZasobnika.UstalWlasnosciIkony(czynnosc :TIkonaZasobnikaCzynnosci);
var informacjeOIkonie :TNotifyIconData;
begin
informacjeOIkonie.cbSize:=SizeOf(informacjeOIkonie);
//informacjeOIkonie.Wnd:=FOkno.Handle; //gdy 0, tj. brak uchwytu do okna, dzieki temu nie ma problemow przy automatycznym usuwaniu obiektu z pamieci, ale nietrwale;
StrLCopy(informacjeOIkonie.szTip,PChar(FPodpowiedz),SizeOf(informacjeOIkonie.szTip));
informacjeOIkonie.hIcon:=FIkona.Handle;
informacjeOIkonie.uID:=IloscIkon; //??????????
//informacjeOIkonie.uFlags:=NIF_ICON or NIF_TIP;

//ustalenie identyfikatora wysylanego do okna, a dotyczacego zasobnika
ParentWindow:=FOkno.Handle;
informacjeOIkonie.Wnd:=Handle;
informacjeOIkonie.uFlags:=NIF_ICON or NIF_TIP or NIF_MESSAGE;
informacjeOIkonie.uCallbackMessage:=WM_IKONAZASOBNIKA;

Shell_NotifyIcon(Cardinal(czynnosc),@informacjeOIkonie);
end;

procedure TIkonaZasobnika.WndProc(var Message: TMessage);
begin
  if (Message.Msg=WM_IKONAZASOBNIKA) then
    case Message.lParam of
      WM_RBUTTONDOWN:
        if Assigned(PopupMenu) then PopupMenu.Popup(Mouse.CursorPos.X,Mouse.CursorPos.Y);

      WM_LBUTTONDOWN:
        begin
        Inc(IloscKlikniec);
        Timer.Enabled:=True;
        end;

      WM_LBUTTONDBLCLK:
        begin
        Timer.Enabled:=False;
        if Assigned(FOnDblClick) then OnDblClick(Self);
        end;
    end;

  inherited;
end;

procedure TIkonaZasobnika.TimerTimer(Sender :TObject);
begin
Timer.Enabled:=False;
if (IloscKlikniec=1) and Assigned(FOnClick) then OnClick(Self);
IloscKlikniec:=0;
end;

procedure Register;
begin
  RegisterComponents('JM', [TIkonaZasobnika]);
end;

end.
