jvtrayicon.pas

East make Tray Icon in delphi

destructor TJvTrayIcon.Destroy;
begin
  StopTimer(DblClickTimer); { Vlad S}
  StopTimer(CloseBalloonTimer);

  SetActive(False);

  if not (csDestroying in Application.ComponentState) then
    SetTask(False);

  FIcon.Free;
  FCurrentIcon.Free;
  DeallocateHWndEx(FHandle);

  inherited Destroy;
end;

function TJvTrayIcon.AcceptBalloons: Boolean;
begin
  // Balloons are only accepted with shell32.dll 5.0+
  Result := GetShellVersion >= Shell32VersionIE5;
end;

function TJvTrayIcon.ApplicationHook(var Msg: TMessage): Boolean;
begin
  if (Msg.Msg = WM_SYSCOMMAND) and (Msg.WParam = SC_MINIMIZE) and
    (tvAutoHide in Visibility) and Active then
    HideApplication;
  Result := False;
end;

procedure TJvTrayIcon.BalloonHint(Title, Value: string;
  BalloonType: TBalloonType; ADelay: Cardinal; CancelPrevious: Boolean);
//http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/Shell/reference/functions/shell_notifyicon.asp
const
  cInfoFlagValues: array [TBalloonType] of DWORD =
    (NIIF_NONE, NIIF_ERROR, NIIF_INFO, NIIF_WARNING);
begin
  if AcceptBalloons then
  begin
    FTime := Now;
    FTimeDelay := ADelay div 1000;

    // if we must cancel an existing balloon
    if CancelPrevious then
      HideBalloon;

    with FIconData do
      StrPLCopy(szInfoTitle, Title, SizeOf(szInfoTitle) - 1);
    with FIconData do
      StrPLCopy(szInfo, Value, SizeOf(szInfo) - 1);

    FIconData.uTimeOut := ADelay;
    FIconData.dwInfoFlags := cInfoFlagValues[BalloonType];

    NotifyIcon(NIF_INFO, NIM_MODIFY);

    if (Title = '') and (Value = '') then
    begin
      Dec(FBalloonCount);
      if FBalloonCount < 0 then
        FBalloonCount := 0;
    end
    else
      Inc(FBalloonCount);

    // if the delay is less than the system's minimum and the balloon
    // was really shown (title and value are not both empty)
    // (rb) XP: if Value = '' then balloon is not shown
    if (ADelay < GetSystemMinimumBalloonDelay) and ((Title <> '') or (Value <> '')) then
      // then we enable the ballon closer timer which will cancel
      // the balloon when the delay is elapsed
      SetTimer(FHandle, CloseBalloonTimer, ADelay, nil);

    if Assigned(FOnBalloonShow) then
      FOnBalloonShow(Self);
  end;
end;

procedure TJvTrayIcon.DoAnimation;
begin
  if (tisTrayIconVisible in FState) and (FIcons <> nil) and (FIcons.Count > 0) then
  begin
    if IconIndex < 0 then
      IconIndex := 0
    else
      IconIndex := (IconIndex + 1) mod FIcons.Count;
    if Assigned(FOnAnimate) then
      FOnAnimate(Self, IconIndex);
  end;
end;

procedure TJvTrayIcon.DoClick(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  if Assigned(FOnClick) then
    FOnClick(Self, Button, Shift, X, Y);
  if Button = mbLeft then
  begin
    if FDropDownMenu <> nil then
    begin
      SetForegroundWindow(FHandle);
      FDropDownMenu.Popup(X, Y);
      PostMessage(FHandle, WM_NULL, 0, 0);
    end;
    if ApplicationVisible then
    begin
      if tvMinimizeClick in Visibility then
        { (rb) Call Application.Minimize instead of HideApplication
               if tvAutoHide not in Visibility ? }
        HideApplication;
    end
    else
    if tvRestoreClick in Visibility then
      ShowApplication;
  end;
end;

procedure TJvTrayIcon.DoCloseBalloon;
begin
  // we stop the timer and hide the balloon
  StopTimer(CloseBalloonTimer);
  HideBalloon;
end;

procedure TJvTrayIcon.DoContextPopup(X, Y: Integer);
var
  Handled: Boolean;
begin
  Handled := False;
  if Assigned(FOnContextPopup) then
    FOnContextPopup(Self, Point(X, Y), Handled);
  if not Handled and Assigned(FPopupMenu) then
  begin
    SetForegroundWindow(FHandle);
    FPopupMenu.Popup(X, Y);
    PostMessage(FHandle, WM_NULL, 0, 0);
  end;
end;

procedure TJvTrayIcon.DoDoubleClick(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  I: Integer;
begin
  if tisWaitingForDoubleClick in FState then
  begin
    Exclude(FState, tisWaitingForDoubleClick); { Vlad S}
    StopTimer(DblClickTimer); { Vlad S}
  end;

  if Assigned(FOnDblClick) then
    FOnDblClick(Self, Button, Shift, X, Y)
  else
  if Button = mbLeft then
  begin
    if FPopupMenu <> nil then
      for I := 0 to FPopupMenu.Items.Count - 1 do
        if FPopupMenu.Items[I].Default then
        begin
          FPopupMenu.Items[I].Click;
          Break;
        end;
    if ApplicationVisible then
    begin
      if tvMinimizeDbClick in Visibility then
        { (rb) Call Application.Minimize instead of HideApplication
               if tvAutoHide not in Visibility ? }
        HideApplication;
    end
    else
    if tvRestoreDbClick in Visibility then
      ShowApplication;
  end;
end;

procedure TJvTrayIcon.DoMouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  Include(FState, tisClicked);
  if Assigned(FOnMouseDown) then
    FOnMouseDown(Self, Button, Shift, X, Y);
end;

procedure TJvTrayIcon.DoMouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if tisHintChanged in FState then
  begin
    Exclude(FState, tisHintChanged);

    with FIconData do
      StrPLCopy(szTip, GetShortHint(FHint), cHintSize[GetShellVersion >= Shell32VersionIE5]);

    if tisTrayIconVisible in FState then
      NotifyIcon(NIF_TIP, NIM_MODIFY);
  end;
  if Assigned(FOnMouseMove) then
    FOnMouseMove(Self, Shift, X, Y);
end;

procedure TJvTrayIcon.DoMouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);

  function HasSingleClickFunctionality: Boolean;
  begin
    Result :=
        Assigned(FOnClick) or
        ((Button = mbLeft) and (Assigned(FDropDownMenu) or
          ([tvRestoreClick, tvMinimizeClick] * Visibility <> [])));
  end;

begin
  if tisClicked in FState then
  begin
    Exclude(FState, tisClicked);
    if HasSingleClickFunctionality then
    begin
      // Delay DoClick
      FClickedButton := Button;
      FClickedShift := Shift;
      FClickedX := X;
      FClickedY := Y;

      if not (tisWaitingForDoubleClick in FState) then
      begin
        Include(FState, tisWaitingForDoubleClick);
        SetTimer(FHandle, DblClickTimer, GetDoubleClickTime, nil);
      end;
    end;
    //else
    //  DoClick(Button, Shift, X, Y);
  end;

  if Assigned(FOnMouseUp) then
    FOnMouseUp(Self, Button, Shift, X, Y);
  if (Button = mbRight) and (GetShellVersion < Shell32VersionIE5) then
    DoContextPopup(X, Y);
end;

procedure TJvTrayIcon.DoTimerDblClick;
begin
  StopTimer(DblClickTimer);

  if tisWaitingForDoubleClick in FState then
  begin
    Exclude(FState, tisWaitingForDoubleClick);
    // Double-clicking a mouse button actually generates four messages:
    // WM_XBUTTONDOWN, WM_XBUTTONUP, WM_XBUTTONDBLCLK, and WM_XBUTTONUP again
    DoClick(FClickedButton, FClickedShift, FClickedX, FClickedY);
  end;
end;

procedure TJvTrayIcon.EndAnimation;
begin
  // reentrance check
  if tisAnimating in FState then
  begin
    Exclude(FState, tisAnimating);
    StopTimer(AnimationTimer);
  end;
end;

function TJvTrayIcon.GetApplicationVisible: Boolean;
begin
  Result := not (tisAppHiddenButNotMinimized in FState) and not IsApplicationMinimized;
end;

function TJvTrayIcon.GetSystemMinimumBalloonDelay: Cardinal;
begin
  // from Microsoft's documentation, a balloon is shown for at
  // least 10 seconds, but it is a system settings which must
  // be somewhere in the registry. The only question is : Where ?
  Result := 10000;
end;

procedure TJvTrayIcon.HideApplication;
begin
  if ApplicationVisible then
  begin
    // Minimize the application..
    if Snap then
    begin
      if Assigned(Application.MainForm) then
        Application.MainForm.Visible := False;
      Application.ShowMainForm := False;
    end;
    Application.Minimize;
  end;

  // ..and hide the taskbar button of the application
  ShowWindow(Application.Handle, SW_HIDE);
  Exclude(FVisibility, tvVisibleTaskBar);

  if tvAutoHideIcon in Visibility then
    ShowTrayIcon;
end;

procedure TJvTrayIcon.HideBalloon;
var
  I: Integer;
begin
  // We call BalloonHint with title and info set to
  // empty strings which surprisingly will cancel any existing
  // balloon for the icon. This is clearly not documented by
  // Microsoft and may not work in later releases of Windows
  // Under Windows XP, you only need to do this once. But under
  // Windows 2000, it seems one must do this one time more than
  // there were calls to BalloonHint with real messages

  // (rb) A bit confusing because calling BalloonHint changes FBalloonCount
  for I := 0 to FBalloonCount do
    BalloonHint('', '');
end;

procedure TJvTrayIcon.HideTrayIcon;
begin
  // reentrance check
  if tisTrayIconVisible in FState then
  begin
    Exclude(FState, tisTrayIconVisible);
    EndAnimation;
    NotifyIcon(0, NIM_DELETE);
  end;
end;

procedure TJvTrayIcon.Hook;
begin
  // reentrance check; also no hooking while designing
  if (tisHooked in FState) or (csDesigning in ComponentState) then
    Exit;
  Include(FState, tisHooked);
  Application.HookMainWindow(ApplicationHook);
end;

procedure TJvTrayIcon.IconChanged(Sender: TObject);
begin
  IconPropertyChanged;
end;

//HEG: New

procedure TJvTrayIcon.IconPropertyChanged;
var
  Ico: TIcon;
begin
  if not (csLoading in ComponentState) then
  begin
    if (FIcons <> nil) and (FIconIndex >= 0) and (FIconIndex < FIcons.Count) then
    begin
      Ico := TIcon.Create;
      try
        FIcons.GetIcon(FIconIndex, Ico);
        SetCurrentIcon(Ico);
      finally
        Ico.Free;
      end;
    end
    else
    if Assigned(Icon) and (not Icon.Empty) then
      SetCurrentIcon(Icon)
    else
      SetCurrentIcon(Application.Icon);
  end;
end;

procedure TJvTrayIcon.InitIconData;
begin
  // http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/Shell/Structures/NOTIFYICONDATA.asp
  with FIconData do
  begin
    if GetShellVersion >= Shell32VersionIE5 then
    begin
      cbSize := SizeOf(FIconData);
      FIconData.uTimeOut := NOTIFYICON_VERSION;
    end
    else
      cbSize := SizeOf(TNotifyIconData);
    Wnd := FHandle;
    uID := 1; // We have only 1 icon per FHandle, so no need to uniquely identify
    uCallbackMessage := WM_CALLBACKMESSAGE;
    if not CurrentIcon.Empty then
      hIcon := CurrentIcon.Handle
    else
      CurrentIcon := Application.Icon;
    StrPLCopy(szTip, GetShortHint(FHint), cHintSize[GetShellVersion >= Shell32VersionIE5]);
    uFlags := 0;
  end;
end;

procedure TJvTrayIcon.Loaded;
begin
  inherited Loaded;

  IconPropertyChanged;

  if FStreamedActive then
  begin
    SetActive(True);

    if not (csDesigning in ComponentState) then
    begin
      if not (tvVisibleTaskBar in Visibility) then
      begin
        // Start hidden
        Application.ShowMainForm := False;
        // Note that the application is not really minimized
        // (ie IsIconic(Application.Handle) = False), just hidden.
        // Calling Application.Minimize or something would show the
        // application's button on the taskbar for a short time.
        // So we use the tisHiddenNotMinized flag as work-around, to indicate that
        // the application is minimized.
        ShowWindow(Application.Handle, SW_HIDE);
        Include(FState, tisAppHiddenButNotMinimized);
      end;

      if not (tvVisibleTaskList in Visibility) then
        SetTask(False);
    end;
  end;
end;