Animate tray application windows as they open and close

unit UTrayZoom;

interface

uses
  Windows;

type
  TTrayZoom = class(TObject)
  private
    class function GetTrayRect: TRect;
    class procedure DoZoom(const Wnd: HWND; const Src, Dest: TRect);
  public
    class procedure ZoomToTray(const Wnd: HWND);
    class procedure ZoomFromTray(const Wnd: HWND);
  end;

implementation

class procedure TTrayZoom.DoZoom(const Wnd: HWND; const Src, Dest: TRect);
begin
  DrawAnimatedRects(Wnd, IDANI_CAPTION, Src, Dest);
end;

class function TTrayZoom.GetTrayRect: TRect;
var
  TaskbarWnd, TrayWnd: HWND;
begin
  TaskbarWnd := FindWindow('Shell_TrayWnd', nil);
  TrayWnd := FindWindowEx(TaskbarWnd, 0, 'TrayNotifyWnd', nil);
  GetWindowRect(TrayWnd, Result);
end;

class procedure TTrayZoom.ZoomFromTray(const Wnd: HWND);
var
  WndRect: TRect;
begin
  GetWindowRect(Wnd, WndRect);
  DoZoom(Wnd, GetTrayRect, WndRect);
end;

class procedure TTrayZoom.ZoomToTray(const Wnd: HWND);
var
  WndRect: TRect;
begin
  GetWindowRect(Wnd, WndRect);
  DoZoom(Wnd, WndRect, GetTrayRect);
end;

end.