cooltrayicon.pas

delphi换肤控件2.0破解版,虽然版本不高但相当好用的。

{$WARNINGS OFF}
    with TCoolTrayIcon(Msg.wParam) do  // Cast to a TCoolTrayIcon instance
{$WARNINGS ON}
    begin
      case Msg.lParam of

        WM_MOUSEMOVE:
          if FEnabled then
          begin
            // MouseEnter event
            if FWantEnterExitEvents then
              if FDidExit then
              begin
                MouseEnter;
                FDidExit := False;
              end;
            // MouseMove event
            Shift := ShiftState;
            GetCursorPos(Pt);
            MouseMove(Shift, Pt.x, Pt.y);
            LastMoveX := Pt.x;
            LastMoveY := Pt.y;
          end;

        WM_LBUTTONDOWN:
          if FEnabled then
          begin
            { If we have no OnDblClick event, fire the Click event immediately.
              Otherwise start a timer and wait for a short while to see if user
              clicks again. If he does click again inside this period we have
              a double click in stead of a click. }
            if Assigned(FOnDblClick) then
            begin
              ClickTimer.Interval := GetDoubleClickTime;
              ClickTimer.Enabled := True;
            end;
            Shift := ShiftState + [ssLeft];
            GetCursorPos(Pt);
            MouseDown(mbLeft, Shift, Pt.x, Pt.y);
            FClickStart := True;
            if FLeftPopup then
              if (Assigned(FPopupMenu)) and (FPopupMenu.AutoPopup) then
              begin
                SetForegroundWindow(TrayIconHandler.FHandle);  // So menu closes when used in a DLL
                PopupAtCursor;
              end;
          end;

        WM_RBUTTONDOWN:
          if FEnabled then
          begin
            Shift := ShiftState + [ssRight];
            GetCursorPos(Pt);
            MouseDown(mbRight, Shift, Pt.x, Pt.y);
            if (Assigned(FPopupMenu)) and (FPopupMenu.AutoPopup) then
            begin
              SetForegroundWindow(TrayIconHandler.FHandle);    // So menu closes when used in a DLL
              PopupAtCursor;
            end;
          end;

        WM_MBUTTONDOWN:
          if FEnabled then
          begin
            Shift := ShiftState + [ssMiddle];
            GetCursorPos(Pt);
            MouseDown(mbMiddle, Shift, Pt.x, Pt.y);
          end;

        WM_LBUTTONUP:
          if FEnabled then
          begin
            Shift := ShiftState + [ssLeft];
            GetCursorPos(Pt);

            if FClickStart then   // Then WM_LBUTTONDOWN was called before
              FClickReady := True;

            if FClickStart and (not ClickTimer.Enabled) then
            begin
              { At this point we know a mousedown occured, and the dblclick timer
                timed out. We have a delayed click. }
              FClickStart := False;
              FClickReady := False;
              Click;              // We have a click
            end;

            FClickStart := False;

            MouseUp(mbLeft, Shift, Pt.x, Pt.y);
          end;

        WM_RBUTTONUP:
          if FBehavior = bhWin95 then
            if FEnabled then
            begin
              Shift := ShiftState + [ssRight];
              GetCursorPos(Pt);
              MouseUp(mbRight, Shift, Pt.x, Pt.y);
            end;

        WM_CONTEXTMENU, NIN_SELECT, NIN_KEYSELECT:
          if FBehavior = bhWin2000 then
            if FEnabled then
            begin
              Shift := ShiftState + [ssRight];
              GetCursorPos(Pt);
              MouseUp(mbRight, Shift, Pt.x, Pt.y);
            end;

        WM_MBUTTONUP:
          if FEnabled then
          begin
            Shift := ShiftState + [ssMiddle];
            GetCursorPos(Pt);
            MouseUp(mbMiddle, Shift, Pt.x, Pt.y);
          end;

        WM_LBUTTONDBLCLK:
          if FEnabled then
          begin
            FClickReady := False;
            IsDblClick := True;
            DblClick;
            { Handle default menu items. But only if LeftPopup is false, or it
              will conflict with the popupmenu when it is called by a click event. }
            M := nil;
            if Assigned(FPopupMenu) then
              if (FPopupMenu.AutoPopup) and (not FLeftPopup) then
                for I := PopupMenu.Items.Count -1 downto 0 do
                begin
                  if PopupMenu.Items[I].Default then
                    M := PopupMenu.Items[I];
                end;
            if M <> nil then
              M.Click;
          end;

        { The tray icon never receives WM_MOUSEWHEEL messages.
        WM_MOUSEWHEEL: ;
        }

        NIN_BALLOONSHOW: begin
          if Assigned(FOnBalloonHintShow) then
            FOnBalloonHintShow(Self);
        end;

        NIN_BALLOONHIDE:
          if Assigned(FOnBalloonHintHide) then
            FOnBalloonHintHide(Self);

        NIN_BALLOONTIMEOUT:
          if Assigned(FOnBalloonHintTimeout) then
            FOnBalloonHintTimeout(Self);

        NIN_BALLOONUSERCLICK:
          if Assigned(FOnBalloonHintClick) then
            FOnBalloonHintClick(Self);

      end;
    end;
  end

  else             // Messages that didn't go through the tray icon
    case Msg.Msg of
      { Windows sends us a WM_QUERYENDSESSION message when it prepares for
        shutdown. Msg.Result must not return 0, or the system will be unable
        to shut down. The same goes for other specific system messages. }
      WM_CLOSE, WM_QUIT, WM_DESTROY, WM_NCDESTROY: begin
        Msg.Result := 1;
      end;
{
      WM_DESTROY:
        if not (csDesigning in ComponentState) then
        begin
          Msg.Result := 0;
          PostQuitMessage(0);
        end;
}
      WM_QUERYENDSESSION, WM_ENDSESSION: begin
        Msg.Result := 1;
      end;

{$IFDEF WINNT_SERVICE_HACK}
      WM_USERCHANGED:
        if WinNT then
        begin
          // Special handling for Win NT: Load/unload common controls library
          if HComCtl32 = 0 then
          begin
            // Load and initialize common controls library
            HComCtl32 := LoadLibrary('comctl32.dll');
            { We load the entire dll. This is probably unnecessary.
              The InitCommonControlsEx method may be more appropriate. }
            InitComCtl32 := GetProcAddress(HComCtl32, 'InitCommonControls');
            InitComCtl32;
          end
          else
          begin
            // Unload common controls library (if it is loaded)
            if HComCtl32 <> $7FFFFFFF then
              FreeLibrary(HComCtl32);
            HComCtl32 := 0;
          end;
          Msg.Result := 1;
        end;
{$ENDIF}

    else      // Handle all other messages with the default handler
      Msg.Result := DefWindowProc(FHandle, Msg.Msg, Msg.wParam, Msg.lParam);
    end;
end;

{---------------- Container management ----------------}

procedure AddTrayIcon;
begin
  if not Assigned(TrayIconHandler) then
    // Create new handler
    TrayIconHandler := TTrayIconHandler.Create;
  TrayIconHandler.Add;
end;


procedure RemoveTrayIcon;
begin
  if Assigned(TrayIconHandler) then
  begin
    TrayIconHandler.Remove;
    if TrayIconHandler.RefCount = 0 then
    begin
      // Destroy handler
      TrayIconHandler.Free;
      TrayIconHandler := nil;
    end;
  end;
end;

{------------- SimpleTimer event methods --------------}

procedure TCoolTrayIcon.ClickTimerProc(Sender: TObject);
begin
  ClickTimer.Enabled := False;
  if (not IsDblClick) then
    if FClickReady then
    begin
      FClickReady := False;
      Click;
    end;
  IsDblClick := False;
end;


procedure TCoolTrayIcon.CycleTimerProc(Sender: TObject);
begin
  if Assigned(FIconList) then
  begin
    FIconList.GetIcon(FIconIndex, FIcon);
//    IconChanged(AOwner);
    CycleIcon;             // Call event method

    if FIconIndex < FIconList.Count-1 then
      SetIconIndex(FIconIndex+1)
    else
      SetIconIndex(0);
  end;
end;


procedure TCoolTrayIcon.MouseExitTimerProc(Sender: TObject);
var
  Pt: TPoint;
begin
  if FDidExit then
    Exit;
  GetCursorPos(Pt);
  if (Pt.x < LastMoveX) or (Pt.y < LastMoveY) or
     (Pt.x > LastMoveX) or (Pt.y > LastMoveY) then
  begin
    FDidExit := True;
    MouseExit;
  end;
end;

{------------------- TCoolTrayIcon --------------------}

constructor TCoolTrayIcon.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  AddTrayIcon;               // Container management
{$WARNINGS OFF}
  FIconID := Cardinal(Self); // Use Self object pointer as ID
{$WARNINGS ON}

  SettingMDIForm := True;
  FEnabled := True;          // Enabled by default
  FShowHint := True;         // Show hint by default
  SettingPreview := False;

  FIcon := TIcon.Create;
  FIcon.OnChange := IconChanged;
  FillChar(IconData, SizeOf(IconData), 0);
  IconData.cbSize := SizeOf(TNotifyIconDataEx);
  { IconData.hWnd points to procedure to receive callback messages from the icon.
    We set it to our TrayIconHandler instance. }
  IconData.hWnd := TrayIconHandler.FHandle;
  // Add an id for the tray icon
  IconData.uId := FIconID;
  // We want icon, message handling, and tooltips by default
  IconData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
  // Message to send to IconData.hWnd when event occurs
  IconData.uCallbackMessage := WM_TRAYNOTIFY;

  // Create SimpleTimers for later use
  CycleTimer := TSimpleTimer.Create;
  CycleTimer.OnTimer := CycleTimerProc;
  ClickTimer := TSimpleTimer.Create;
  ClickTimer.OnTimer := ClickTimerProc;
  ExitTimer := TSimpleTimer.CreateEx(20, MouseExitTimerProc);

  FDidExit := True;          // Prevents MouseExit from firing at startup

  SetDesignPreview(FDesignPreview);

  // Set hook(s)
  if not (csDesigning in ComponentState) then
  begin
    { For MinimizeToTray to work, we need to know when the form is minimized
      (happens when either the application or the main form minimizes).
      The straight-forward way is to make TCoolTrayIcon trap the
      Application.OnMinimize event. However, if you also make use of this
      event in the application, the OnMinimize code used by TCoolTrayIcon
      is discarded.
      The solution is to hook into the app.'s message handling (via HookAppProc).
      You can then catch any message that goes through the app. and still use
      the OnMinimize event. }
    Application.HookMainWindow(HookAppProc);
    { You can hook into the main form (or any other window), allowing you to handle
      any message that window processes. This is necessary in order to properly
      handle when the user minimizes the form using the TASKBAR icon. }
    if Owner is TWinControl then
      HookForm;
  end;
end;


destructor TCoolTrayIcon.Destroy;
begin
  try
    SetIconVisible(False);        // Remove the icon from the tray
    SetDesignPreview(False);      // Remove any DesignPreview icon
    CycleTimer.Free;
    ClickTimer.Free;
    ExitTimer.Free;
    try
      if FIcon <> nil then
        FIcon.Free;
    except
      on Exception do
        // Do nothing; the icon seems to be invalid
    end;
  finally
    // It is important to unhook any hooked processes
    if not (csDesigning in ComponentState) then
    begin
      Application.UnhookMainWindow(HookAppProc);
      if Owner is TWinControl then
        UnhookForm;
    end;
    RemoveTrayIcon;               // Container management
    inherited Destroy;
  end
end;


procedure TCoolTrayIcon.Loaded;
{ This method is called when all properties of the component have been
  initialized. The method SetIconVisible must be called here, after the
  tray icon (FIcon) has loaded itself. Otherwise, the tray icon will
  be blank (no icon image).
  Other boolean values must also be set here. }
var
  Show: Boolean;
begin
  inherited Loaded;          // Always call inherited Loaded first

  if Owner is TWinControl then
    if not (csDesigning in ComponentState) then
    begin
      Show := True;
      if Assigned(FOnStartup) then
        FOnStartup(Self, Show);

      if not Show then
      begin
        Application.ShowMainForm := False;
        HideMainForm;
      end;

//      ShowMainFormOnStartup := Show;
    end;

  ModifyIcon;
  SetIconVisible(FIconVisible);
  SetCycleIcons(FCycleIcons);
  SetWantEnterExitEvents(FWantEnterExitEvents);
  SetBehavior(FBehavior);
{$IFDEF WINNT_SERVICE_HACK}
  WinNT := IsWinNT;
{$ENDIF}
end;


function TCoolTrayIcon.LoadDefaultIcon: Boolean;