RnQ/for.RnQ/RnQTrayLib.pas

{
  This file is part of R&Q.
  Under same license
}
unit RnQTrayLib;
{$I RnQConfig.inc}

interface

uses
  Windows, Messages, Classes, RDGlobal, Graphics, ShellApi;

{$I NoRTTI.inc}

const
  WM_TRAY = WM_USER + 1;
  cTRAY_uID = 100;
  flags_type = NIF_MESSAGE or NIF_ICON or NIF_TIP;
  flags_info = NIF_INFO;

type
  TTrayEvent = (TE_CLICK, TE_2CLICK, TE_RCLICK);

  TNotifyIconDataW_V2 = record
    cbSize: DWORD;
    Wnd: HWND;
    uID: UINT;
    uFlags: UINT;
    uCallbackMessage: UINT;
    hIcon: HICON;
    szTip: array [0 .. 127] of WideChar;
    dwState: DWORD;
    dwStateMask: DWORD;
    szInfo: array [0 .. 255] of WideChar;
    case Integer of
      0: (uTimeout: UINT);
      1: (uVersion: UINT;
        szInfoTitle: array [0..63] of WideChar;
        dwInfoFlags: DWORD);
  end;

  TNotifyIconDataW_V4 = record
    cbSize: DWORD;
    Wnd: HWND;
    uID: UINT;
    uFlags: UINT;
    uCallbackMessage: UINT;
    hIcon: HICON;
    szTip: array [0 .. 127] of WideChar;
    dwState: DWORD;
    dwStateMask: DWORD;
    szInfo: array [0 .. 255] of WideChar;
    case Integer of
      0: (uTimeout: UINT);
      1: (uVersion: UINT;
        szInfoTitle: array [0..63] of WideChar;
        dwInfoFlags: DWORD;
        guidItem: TGUID;        // Requires Windows Vista or later
        hBalloonIcon: HICON);   // Requires Windows Vista or later
  end;

  PNotifyIconDataW_V2 = ^TNotifyIconDataW_V2;
  PNotifyIconDataW_V4 = ^TNotifyIconDataW_V4;

const
  NOTIFYIconDataW_V2_SIZE = SizeOf(TNotifyIconDataW_V2);
  NOTIFYIconDataW_V4_SIZE = SizeOf(TNotifyIconDataW_V4);

type
{$IFDEF USE_BALOONS}
  TBalloonIconType = (bitNone, // íåò èêîíêè
    bitInfo, // èíôîðìàöèîííàÿ èêîíêà (ñèíÿÿ)
    bitWarning, // èêîíêà âîñêëèöàíèÿ (æ¸ëòàÿ)
    bitError, // èêîíêà îøèáêè (êðàñíàÿ)
    bitUser, // êàñòîìíàÿ èêîíêà, XP SP2+
    bitNoSound, // áåç çâóêà, XP+
    bitLargeIcon, // áîëüøàÿ èêîíêà, Vista+
    bitRespectQuietTime, // 7+
    bitMask); // Reserved, XP+
{$ENDIF USE_BALOONS}

  TTrayIcon = class
  private
    data, dataB: Pointer;
    shown, fHidden, AllocatedHWND: boolean;
    Ico: TIcon;
    procedure WndProc(var Message: TMessage);
    procedure Notify(ev: TTrayEvent);
  public
    OnEvent: procedure(Sender: TObject; ev: TTrayEvent) of object;
    constructor Create(handle: HWND);
    destructor Destroy; override;
    procedure Minimize;
    procedure Update;
    procedure Hide;
    procedure Show;
    procedure SetIcon(icon: TIcon); overload;
    procedure SetIcon(const iName: TPicName); overload;
    procedure SetTip(const s: string);
    procedure UpdateHandle(hndl: HWND);
    property Hidden: Boolean read fHidden;
  end;

type
  TGetPicTipFunc = Procedure(var vPic: TPicName; var vTip: String); // of object;

  TStatusIcon = class
  private
    FOnGetPicTip: TGetPicTipFunc;
  public
    TrayIcon: TTrayIcon;
    IcoName: TPicName;
    lastTip: string;
    constructor Create(handle: HWND);
    destructor Destroy; override;
    procedure Update;
    procedure Empty;
    procedure ReDraw;
    procedure HandleChanged(hndl: THandle);
{$IFDEF USE_BALOONS}
    procedure ShowBalloon(const bldelay: Integer; const BalloonText, BalloonTitle: String;
      const BalloonIconType: TBalloonIconType{; IconName: TPicName = ''});
    procedure HideBalloon;
{$ENDIF USE_BALOONS}
    property OnGetPicTip: TGetPicTipFunc read FOnGetPicTip write FOnGetPicTip;
    // function AcceptBalloons: Boolean;
    // procedure BalloonHint (Title, Value: string; BalloonType: TBalloonType; Delay: Integer);
  end;

var
  ShowBalloonTime: Int64;
  EnabledBaloons: Boolean;
  TrayIconDataVersion: Integer = 2;
  trayIconGuid: TGUID;

implementation

uses
  Forms, SysUtils, Types,
  RDUtils, RnQStrings, RnQLangs, RQUtil, RQThemes, RnQGlobal;

constructor TStatusIcon.Create(handle: HWND);
begin
  if CheckWin32Version(6, 1) then
    TrayIconDataVersion := 4;
  TrayIcon := TTrayIcon.Create(handle);
  IcoName := '';
  lastTip := '';
{$IFDEF USE_BALOONS}
  if GetShellVersion >= $00050000 then
  begin
    EnabledBaloons := true;
    // htimer := tmCreateIntervalTimerEx(handler, 2000, tmPeriod,
    // false, tnWinMsg, WM_TIMERNOTIFY, 2);
  end else
    EnabledBaloons := false;
{$ENDIF USE_BALOONS}
end;

destructor TStatusIcon.Destroy;
begin
  TrayIcon.Hide;
  FreeAndNil(TrayIcon);
  inherited;
end;

procedure TStatusIcon.Update;
var
  IcoPicName: TPicName;
  s: string;
begin
  if Self = nil then
    Exit;
  if Assigned(FOnGetPicTip) then
    FOnGetPicTip(IcoPicName, s)
  else
  begin
    // IcoPicName := PIC_CLIENT_LOGO;
    IcoPicName := 'tray';
    s := Application.Title;
  end;

  if IcoPicName <> IcoName then
  begin
    IcoName := IcoPicName;
    TrayIcon.SetIcon(IcoName);
  end;
  if s <> lastTip then
  begin
    lastTip := s;
    TrayIcon.SetTip(s);
  end;
end;

procedure TStatusIcon.empty;
begin
  IcoName := PIC_EMPTY;
  TrayIcon.SetIcon(IcoName);
end;

procedure TStatusIcon.HandleChanged(hndl: THandle);
begin
  if Assigned(TrayIcon) then
    TrayIcon.UpdateHandle(hndl)
end;

procedure TStatusIcon.ShowBalloon(const bldelay: Integer; const BalloonText, BalloonTitle: String;
  const BalloonIconType: TBalloonIconType{; IconName: TPicName = ''});
const
  aBalloonIconTypes: array [TBalloonIconType] of Byte = (NIIF_NONE, NIIF_INFO, NIIF_WARNING, NIIF_ERROR, NIIF_USER, NIIF_NOSOUND, NIIF_LARGE_ICON, NIIF_RESPECT_QUIET_TIME, NIIF_ICON_MASK);
var
  t: String;
//  ico: TIcon;
begin
  if (not EnabledBaloons) or (not ShowBalloons) then
    Exit;
  if BalloonText = '' then
    t := '_'
  else
    t := BalloonText;

  ShowBalloonTime := bldelay;

  if TrayIconDataVersion = 4 then
  with PNotifyIconDataW_V4(TrayIcon.dataB)^ do
  begin
    Wnd := PNotifyIconDataW_V4(TrayIcon.data).Wnd;
    guidItem := PNotifyIconDataW_V4(TrayIcon.data).guidItem;

    // Requires 32x32 icons
{
    if not (iconName = '') then
    begin
      Ico := TIcon.Create;
      if theme.pic2ico(RQteDefault, IconName, Ico) then
      begin
        hBalloonIcon := Ico.Handle;
        if CheckWin32Version(6, 0) then
          dwInfoFlags := aBalloonIconTypes[bitUser];
      end;
    end;
}
    if ShowBalloonTime = 0 then
      uTimeout := 10000
    else
      uTimeout := ShowBalloonTime;
    StrLCopy(PWideChar(@szInfo[0]), PChar(BalloonText), 255);
    StrLCopy(PWideChar(@szInfoTitle[0]), PChar(BalloonTitle), 63);
    dwInfoFlags := aBalloonIconTypes[BalloonIconType];
    Shell_NotifyIcon(NIM_MODIFY, TrayIcon.dataB);
  end
    else
  with PNotifyIconDataW_V2(Trayicon.dataB)^ do
  begin
    Wnd := PNotifyIconDataW_V2(TrayIcon.data).Wnd;
    uID := PNotifyIconDataW_V2(TrayIcon.data).uID;
    if ShowBalloonTime = 0 then
      uTimeout := 10000
    else
      uTimeout := ShowBalloonTime;
    StrLCopy(PWideChar(@szInfo[0]), PChar(BalloonText), 255);
    StrLCopy(PWideChar(@szInfoTitle[0]), PChar(BalloonTitle), 63);
    dwInfoFlags := aBalloonIconTypes[BalloonIconType];
    Shell_NotifyIcon(NIM_MODIFY, TrayIcon.dataB);
  end;
end;

procedure TStatusIcon.HideBalloon;
begin
  ShowBalloonTime := 0;
  if (not EnabledBaloons) or (not ShowBalloons) then
    Exit;

  if TrayIconDataVersion = 4 then
  with PNotifyIconDataW_V4(TrayIcon.dataB)^ do
  begin
    StrPCopy(PWideChar(@szInfo[0]), '');
    StrPCopy(PWideChar(@szInfoTitle[0]), '');
    Shell_NotifyIcon(NIM_MODIFY, TrayIcon.dataB);
  end
    else
  with PNotifyIconDataW_V2(TrayIcon.dataB)^ do
  begin
    StrPCopy(PWideChar(@szInfo[0]), '');
    StrPCopy(PWideChar(@szInfoTitle[0]), '');
    Shell_NotifyIcon(NIM_MODIFY, TrayIcon.dataB);
  end;
end;

constructor TTrayIcon.Create(handle: HWND);
var
  w: HWND;
begin
  data := nil;
  dataB := nil;
  if IsEqualGUID(trayIconGuid, GUID_NULL) then
    CreateGUID(trayIconGuid);

  w := AllocateHWnd(WndProc);
  AllocatedHWND := not (w = 0);
  if not AllocatedHWND then
    w := handle;

  if TrayIconDataVersion = 4 then
  begin
    data := PNotifyIconDataW_V4(AllocMem(NOTIFYIconDataW_V4_SIZE));
    with PNotifyIconDataW_V4(data)^ do
    begin
      cbSize := NOTIFYIconDataW_V4_SIZE;
      uCallbackMessage := WM_TRAY;
      Wnd := w;
      guidItem := trayIconGuid;
      hIcon := 0;
      hBalloonIcon := 0;
      uFlags := flags_type or NIF_GUID;
    end;

    dataB := PNotifyIconDataW_V4(AllocMem(NOTIFYIconDataW_V4_SIZE));
    with PNotifyIconDataW_V4(dataB)^ do
    begin
      cbSize := NOTIFYIconDataW_V4_SIZE;
      uFlags := flags_info or NIF_GUID;
    end;
  end
    else
  begin
    data := PNotifyIconDataW_V2(AllocMem(NOTIFYIconDataW_V2_SIZE));
    with PNotifyIconDataW_V2(data)^ do
    begin
      cbSize := NOTIFYIconDataW_V2_SIZE;
      uCallbackMessage := WM_TRAY;
      Wnd := w;
      uID := cTRAY_uID;
      hIcon := 0;
      uFlags := flags_type;
    end;

    dataB := PNotifyIconDataW_V2(AllocMem(NOTIFYIconDataW_V2_SIZE));
    with PNotifyIconDataW_V2(dataB)^ do
    begin
      cbSize := NOTIFYIconDataW_V2_SIZE;
      uFlags := flags_info;
    end;
  end;

  SetIcon(Application.Icon);
  SetTip(Application.Title);
end;

destructor TTrayIcon.Destroy;
begin
  FreeAndNil(Ico);
  if TrayIconDataVersion = 4 then
  begin
    DeallocateHWnd(PNotifyIconDataW_V4(data).Wnd);
    FreeMem(PNotifyIconDataW_V4(data));
    FreeMem(PNotifyIconDataW_V4(dataB));
  end
    else
  begin
    DeallocateHWnd(PNotifyIconDataW_V2(data).Wnd);
    FreeMem(PNotifyIconDataW_V2(data));
    FreeMem(PNotifyIconDataW_V2(dataB));
  end;
  data := nil;
  dataB := nil;
  inherited;
end;

procedure TTrayIcon.UpdateHandle(hndl: HWND);
begin
  if allocatedHwnd then
    Exit;

  if not shown then
  begin
    if TrayIconDataVersion = 4 then
      PNotifyIconDataW_V4(data).Wnd := hndl
    else
      PNotifyIconDataW_V2(data).Wnd := hndl;
    Exit;
  end;

  Hide;
  if TrayIconDataVersion = 4 then
    PNotifyIconDataW_V4(data).Wnd := hndl
  else
    PNotifyIconDataW_V2(data).Wnd := hndl;

  Shell_NotifyIcon(NIM_ADD, data);
end;

procedure TTrayIcon.Update;
begin
  if Shown and not Hidden then
    if not Shell_NotifyIcon(NIM_MODIFY, data) then
      Shell_NotifyIcon(NIM_ADD, data);
end;

procedure TTrayIcon.SetIcon(icon: TIcon);
begin
  if icon = nil then
    Exit;
  if Ico = nil then
    Ico := TIcon.Create;
  Ico.Assign(icon);
  // if data.hIcon <> 0 then
  if TrayIconDataVersion = 4 then
    PNotifyIconDataW_V4(data).hIcon := Ico.Handle
  else
    PNotifyIconDataW_V2(data).hIcon := Ico.Handle;
  Update;
end;

procedure TTrayIcon.SetIcon(const iName: TPicName);
begin
  if Ico = nil then
    Ico := TIcon.Create;
  if theme.pic2ico(RQteTrayNotify, iName, Ico) then
  // ico := theme.GetIco(iName);
  // if ico <> nil then
  begin
    if TrayIconDataVersion = 4 then
      PNotifyIconDataW_V4(data).hIcon := Ico.Handle
    else
      PNotifyIconDataW_V2(data).hIcon := Ico.Handle;
  end
    else
  begin
    Ico.Handle := Application.Icon.Handle;
    if TrayIconDataVersion = 4 then
      PNotifyIconDataW_V4(data).hIcon := 0
    else
      PNotifyIconDataW_V2(data).hIcon := 0;
  end;
  Update;
end;

procedure TTrayIcon.SetTip(const s: string);
begin
  if TrayIconDataVersion = 4 then
    StrLCopy(PNotifyIconDataW_V4(data).szTip, PChar(s), 127)
  else
    StrLCopy(PNotifyIconDataW_V2(data).szTip, PChar(s), 127);
  Update;
end;

procedure TTrayIcon.Minimize;
begin
  Show;
  // Application.ShowMainForm := False;
  // Toolwindows dont have a TaskIcon. (Remove if TaskIcon is to be show when form is visible)
  // SetWindowLongPtr(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
end;

procedure TTrayIcon.Show;
begin
  shown := True;
  fHidden := False;
  if not Shell_NotifyIcon(NIM_ADD, data) and (TrayIconDataVersion = 4) then
  begin
    CreateGUID(trayIconGuid);
    PNotifyIconDataW_V4(data).guidItem := trayIconGuid;
    Shell_NotifyIcon(NIM_ADD, data);
    MsgDlg('Stored tray icon ID could not be used, new one was created instead', True, mtWarning);
  end;
end;

procedure TTrayIcon.Hide;
begin
  fHidden := true;
  Shell_NotifyIcon(NIM_DELETE, data)
end;

procedure TTrayIcon.WndProc(var Message: TMessage);
begin
  case Message.msg of
  WM_TRAY:
    case Message.lParam of
      WM_RBUTTONUP: Notify(TE_RCLICK);
      WM_LBUTTONUP: Notify(TE_CLICK);
      WM_LBUTTONDBLCLK: Notify(TE_2CLICK);
    end;
  WM_QUERYENDSESSION:
    Message.Result := 1;
  WM_ENDSESSION:
    if TWmEndSession(Message).endSession then
      Hide();
  NIN_BALLOONHIDE,
  NIN_BALLOONTIMEOUT:
    begin
    end;
  end;
  Message.Result := 1;
end;

procedure TTrayIcon.Notify(ev: TTrayEvent);
begin
  if Assigned(OnEvent) then
    OnEvent(Self, ev)
end;

procedure TStatusIcon.ReDraw;
begin
  TrayIcon.SetIcon(IcoName);
end;

end.