jvtrayicon.pas

East make Tray Icon in delphi

procedure TJvTrayIcon.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    if AComponent = DropDownMenu then
      DropDownMenu := nil;
    if AComponent = PopupMenu then
      PopupMenu := nil;
    if AComponent = Icons then
      Icons := nil;
  end;
end;

function TJvTrayIcon.NotifyIcon(uFlags: UINT; dwMessage: DWORD): Boolean;
begin
  FIconData.uFlags := uFlags;
  Result := Shell_NotifyIcon(dwMessage, @FIconData);
end;

procedure TJvTrayIcon.SetActive(Value: Boolean);
begin
  if csLoading in ComponentState then
    FStreamedActive := Value
  else
  if FActive <> Value then
  begin
    FActive := Value;
    if FActive then
    begin
      InitIconData;
      if (csDesigning in ComponentState) and not (tvVisibleDesign in Visibility) then
        Exit;
      Hook;
      ShowTrayIcon;
    end
    else
    begin
      EndAnimation;
      Unhook;
      HideTrayIcon;
    end;
  end;
end;

procedure TJvTrayIcon.SetAnimated(const Value: Boolean);
begin
  if Value <> FAnimated then
  begin
    FAnimated := Value;
    if FAnimated then
      StartAnimation
    else
      EndAnimation;
  end;
end;

procedure TJvTrayIcon.SetApplicationVisible(const Value: Boolean);
begin
  if Value then
    ShowApplication
  else
    HideApplication;
end;

//HEG: New

procedure TJvTrayIcon.SetCurrentIcon(Value: TIcon);
begin
  FCurrentIcon.Assign(Value);
  FIconData.hIcon := FCurrentIcon.Handle;
  if tisTrayIconVisible in FState then
    //    if FIconData.hIcon = 0 then
    //      HideTrayIcon
    //    else
    NotifyIcon(NIF_ICON, NIM_MODIFY);
end;

procedure TJvTrayIcon.SetDelay(const Value: Cardinal);
var
  WasAnimated: Boolean;
begin
  if FDelay <> Value then
  begin
    WasAnimated := Animated;
    try
      Animated := False;
      FDelay := Value;
    finally
      Animated := WasAnimated;
    end;
  end;
end;

procedure TJvTrayIcon.SetHint(Value: string);
begin
  //Remove sLineBreak on w98/me as they are not supported
  if GetShellVersion < Shell32VersionIE5 then
    Value := StringReplace(Value, sLineBreak, ' - ', [rfReplaceAll]);

  if FHint <> Value then
  begin
    { (rb) No idea why this isn't applied immediately }
    Include(FState, tisHintChanged);
    FHint := Value;
  end;
end;

procedure TJvTrayIcon.SetIcon(Value: TIcon);
begin
  // triggers IconPropertyChanged
  FIcon.Assign(Value);
end;

procedure TJvTrayIcon.SetIconIndex(const Value: Integer);
begin
  if FIconIndex <> Value then
  begin
    FIconIndex := Value;
    IconPropertyChanged;
  end;
end;

procedure TJvTrayIcon.SetIcons(const Value: TCustomImageList);
begin
  if FIcons <> Value then
  begin
    FIcons := Value;
    IconPropertyChanged; //HEG: New
  end;
end;

procedure TJvTrayIcon.SetTask(const Value: Boolean);
begin
  if FTask <> Value then
  begin
    FTask := Value;
    if not (csDesigning in ComponentState) then
    begin
      LoadKernel32Dll;

      if Assigned(RegisterServiceProcess) then
        if FTask then
          RegisterServiceProcess(GetCurrentProcessID, 0)
        else
          RegisterServiceProcess(GetCurrentProcessID, 1);
    end;
  end;
end;

procedure TJvTrayIcon.SetVisibility(const Value: TTrayVisibilities);
var
  ToBeSet, ToBeCleared: TTrayVisibilities;
begin
  if Value <> FVisibility then
  begin
    ToBeSet := Value - FVisibility;
    ToBeCleared := FVisibility - Value;
    FVisibility := Value;

    if not Active then
      Exit;

    if csDesigning in ComponentState then
    begin
      if tvVisibleDesign in ToBeSet then
        ShowTrayIcon
      else
      if tvVisibleDesign in ToBeCleared then
        HideTrayIcon;
    end
    else
    begin
      VisibleInTaskList := tvVisibleTaskList in FVisibility;

      if tvAutoHide in ToBeSet then
      begin
        if not ApplicationVisible then
          HideApplication;
      end;

      if tvVisibleTaskBar in ToBeSet then
        ShowApplication
      else
      if tvVisibleTaskBar in ToBeCleared then
        HideApplication;

      if (tvAutoHideIcon in ToBeSet) and not IsApplicationMinimized then
        HideTrayIcon;
      if (tvAutoHideIcon in ToBeCleared) and not IsApplicationMinimized then
        ShowTrayIcon;
    end;
  end;
end;

procedure TJvTrayIcon.ShowApplication;
begin
  if tisAppHiddenButNotMinimized in FState then
  begin
    Exclude(FState, tisAppHiddenButNotMinimized);

    Application.Minimize;
    Application.ShowMainForm := True;
  end;

  // Show the taskbar button of the application..
  Include(FVisibility, tvVisibleTaskBar);
  ShowWindow(Application.Handle, SW_SHOW);

  // ..and restore the application
  Application.Restore;

  if Application.MainForm <> nil then
    Application.MainForm.Visible := True;
  if tvAutoHideIcon in Visibility then
    HideTrayIcon;
end;

procedure TJvTrayIcon.ShowTrayIcon;
begin
  // reentrance check
  if tisTrayIconVisible in FState then
    Exit;

  if not Active then
    Exit;

  if csDesigning in ComponentState then
  begin
    if not (tvVisibleDesign in Visibility) then
      Exit;
  end
  else
  if (tvAutoHideIcon in Visibility) and ApplicationVisible then
    Exit;

  // All checks passed, make the trayicon visible:

  Include(FState, tisTrayIconVisible);

  NotifyIcon(NIF_MESSAGE or NIF_ICON or NIF_TIP, NIM_ADD);

  // If we call NIM_SETVERSION, we must call it *after* NIM_ADD.
  if GetShellVersion >= Shell32VersionIE5 then
    NotifyIcon(0, NIM_SETVERSION);

  if Animated then
    StartAnimation;
end;

procedure TJvTrayIcon.StartAnimation;
begin
  // reentrance check, and trayicon needs to be visible
  if [tisAnimating, tisTrayIconVisible] * FState = [tisTrayIconVisible] then
  begin
    Include(FState, tisAnimating);
    SetTimer(FHandle, AnimationTimer, FDelay, nil)
  end;
end;

procedure TJvTrayIcon.StopTimer(ID: Integer);
begin
  if FHandle <> 0 then
    KillTimer(FHandle, ID);
end;

procedure TJvTrayIcon.Unhook;
begin
  // reentrance check
  if tisHooked in FState then
  begin
    Exclude(FState, tisHooked);
    Application.UnhookMainWindow(ApplicationHook);
  end;
end;

procedure TJvTrayIcon.WndProc(var Mesg: TMessage);
var
  I: Integer;
  Pt: TPoint;
  ShState: TShiftState;
begin
  try
    with Mesg do
      case Msg of
        WM_CALLBACKMESSAGE:
          if not (csDesigning in ComponentState) then
          begin
            GetCursorPos(Pt);
            ShState := [];
            if GetKeyState(VK_SHIFT) < 0 then
              Include(ShState, ssShift);
            if GetKeyState(VK_CONTROL) < 0 then
              Include(ShState, ssCtrl);
            if GetKeyState(VK_LBUTTON) < 0 then
              Include(ShState, ssLeft);
            if GetKeyState(VK_RBUTTON) < 0 then
              Include(ShState, ssRight);
            if GetKeyState(VK_MBUTTON) < 0 then
              Include(ShState, ssMiddle);
            if GetKeyState(VK_MENU) < 0 then
              Include(ShState, ssAlt);
            case LParam of
              WM_MOUSEMOVE:
                DoMouseMove(ShState, Pt.X, Pt.Y);
              WM_LBUTTONDOWN:
                DoMouseDown(mbLeft, ShState, Pt.X, Pt.Y);
              WM_RBUTTONDOWN:
                DoMouseDown(mbRight, ShState, Pt.X, Pt.Y);
              WM_MBUTTONDOWN:
                DoMouseDown(mbMiddle, ShState, Pt.X, Pt.Y);
              WM_LBUTTONUP:
                DoMouseUp(mbLeft, ShState, Pt.X, Pt.Y);
              WM_MBUTTONUP:
                DoMouseUp(mbMiddle, ShState, Pt.X, Pt.Y);
              WM_RBUTTONUP:
                DoMouseUp(mbRight, ShState, Pt.X, Pt.Y);
              WM_CONTEXTMENU, NIN_KEYSELECT:
                // WM_CONTEXTMENU: press Shift+F10 while trayicon has focus.
                // NIN_KEYSELECT:  press Enter or Space while trayicon has focus.
                // Windows moves the mouse pointer to the trayicon before these messages,
                // so Pt is valid.
                DoContextPopup(Pt.X, Pt.Y);
              WM_LBUTTONDBLCLK:
                DoDoubleClick(mbLeft, ShState, Pt.X, Pt.Y);
              WM_RBUTTONDBLCLK:
                DoDoubleClick(mbRight, ShState, Pt.X, Pt.Y);
              WM_MBUTTONDBLCLK:
                DoDoubleClick(mbMiddle, ShState, Pt.X, Pt.Y);
              NIN_BALLOONHIDE: //sb
                begin
                  { (rb) Double try..except }
                  try
                    if Assigned(FOnBalloonHide) then
                      FOnBalloonHide(Self);
                  except
                  end;
                  Result := Ord(True);
                end;
              NIN_BALLOONTIMEOUT: //sb
                begin
                  I := SecondsBetween(Now, FTime);
                  if I > FTimeDelay then
                    HideBalloon;
                  Result := Ord(True);
                end;
              NIN_BALLOONUSERCLICK: //sb
                begin
                  { (rb) Double try..except }
                  try
                    if Assigned(FOnBalloonClick) then
                      FOnBalloonClick(Self);
                  except
                  end;
                  Result := Ord(True);
                  //Result := DefWindowProc(FHandle, Msg, WParam, LParam);
                  HideBalloon;
                end;
            end;
          end;
        // Add by Winston Feng 2003-9-28
        // Handle the QueryEndSession and TaskbarCreated message, so trayicon
        // will be deleted and restored correctly.
        WM_QUERYENDSESSION:
          Result := 1;
        WM_ENDSESSION:
          // (rb) Is it really necessairy to respond to WM_ENDSESSION?
          if TWMEndSession(Mesg).EndSession then
            HideTrayIcon
          else
          if Active then
            ShowTrayIcon;
        WM_TIMER:
          case TWMTimer(Mesg).TimerID of
            AnimationTimer:
              DoAnimation;
            CloseBalloonTimer:
              DoCloseBalloon;
            DblClickTimer:
              DoTimerDblClick;
          end;
      else
        if Msg = FTaskbarRestartMsg then
        begin
          { You can test this on XP:
              - Click Start, then click Turn Off Computer
              - Press CTRL + Shift + Alt + Click Cancel          (all at once)
                  this will dump explorer.exe
              - Press CTRL + Alt + Delete
              - Click New Task...
              - Enter 'explorer.exe' and click OK.
                  this will restart explorer.exe
          }

          // Ensure tisTrayIconVisible is not in FState:
          HideTrayIcon;
          if Active then
            ShowTrayIcon;
        end
        else
          Result := DefWindowProc(FHandle, Msg, WParam, LParam);
      end; // case
  except
    Application.HandleException(Self);
  end;
end;

initialization
  {$IFDEF UNITVERSIONING}
  RegisterUnitVersion(HInstance, UnitVersioning);
  {$ENDIF UNITVERSIONING}

finalization
  UnloadKernel32Dll;
  {$IFDEF UNITVERSIONING}
  UnregisterUnitVersion(HInstance);
  {$ENDIF UNITVERSIONING}

end.