cooltrayicon.pas

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

    begin
      if SettingPreview then
        if InitIcon then
          Result := Shell_NotifyIcon(NIM_DELETE, @IconData);
    end
    else
    if InitIcon then
      Result := Shell_NotifyIcon(NIM_DELETE, @IconData);
  end;
end;


function TCoolTrayIcon.ModifyIcon: Boolean;
// Change icon or tooltip if icon already placed
begin
  Result := False;
  if InitIcon then
    Result := Shell_NotifyIcon(NIM_MODIFY, @IconData);
end;


function TCoolTrayIcon.ShowBalloonHint(Title, Text: String;
  IconType: TBalloonHintIcon; TimeoutSecs: TBalloonHintTimeOut): Boolean;
// Show balloon hint. Return false if error.
const
  aBalloonIconTypes: array[TBalloonHintIcon] of Byte =
    (NIIF_NONE, NIIF_INFO, NIIF_WARNING, NIIF_ERROR, NIIF_USER);
begin
  // Remove old balloon hint
  HideBalloonHint;
  // Display new balloon hint
  with IconData do
  begin
    uFlags := uFlags or NIF_INFO;
    StrLCopy(szInfo, PChar(Text), SizeOf(szInfo)-1);
    StrLCopy(szInfoTitle, PChar(Title), SizeOf(szInfoTitle)-1);
    TimeoutOrVersion.uTimeout := TimeoutSecs * 1000;
    dwInfoFlags := aBalloonIconTypes[IconType];
  end;
  Result := ModifyIcon;
  // Remove NIF_INFO before next call to ModifyIcon (or the balloon hint will redisplay itself)
  IconData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
end;


function TCoolTrayIcon.ShowBalloonHintUnicode(Title, Text: WideString;
  IconType: TBalloonHintIcon; TimeoutSecs: TBalloonHintTimeOut): Boolean;
// Show balloon hint. Return false if error.
const
  aBalloonIconTypes: array[TBalloonHintIcon] of Byte =
    (NIIF_NONE, NIIF_INFO, NIIF_WARNING, NIIF_ERROR, NIIF_USER);
var
  I: Integer;
begin
  // Remove old balloon hint
  HideBalloonHint;
  // Display new balloon hint
  with IconData do
  begin
    uFlags := uFlags or NIF_INFO;
    FillChar(szInfo, 0, SizeOf(szInfo));
    for I := 0 to SizeOf(szInfo)-1 do
      szInfo[I] := Char(Text[I]);
    szInfo[0] := #1;
    FillChar(szInfoTitle, 0, SizeOf(szInfoTitle));
    for I := 0 to SizeOf(szInfoTitle)-1 do
      szInfoTitle[I] := Char(Title[I]);
    szInfoTitle[0] := #1;
    TimeoutOrVersion.uTimeout := TimeoutSecs * 1000;
    dwInfoFlags := aBalloonIconTypes[IconType];
  end;
  Result := ModifyIcon;
  // Remove NIF_INFO before next call to ModifyIcon (or the balloon hint will redisplay itself)
  IconData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
end;


function TCoolTrayIcon.HideBalloonHint: Boolean;
// Hide balloon hint. Return false if error.
begin
  with IconData do
  begin
    uFlags := uFlags or NIF_INFO;
    StrPCopy(szInfo, '');
  end;
  Result := ModifyIcon;
end;


function TCoolTrayIcon.BitmapToIcon(const Bitmap: TBitmap;
  const Icon: TIcon; MaskColor: TColor): Boolean;
{ Render an icon from a 16x16 bitmap. Return false if error.
  MaskColor is a color that will be rendered transparently. Use clNone for
  no transparency. }
var
  BitmapImageList: TImageList;
begin
  BitmapImageList := TImageList.CreateSize(16, 16);
  try
    Result := False;
    BitmapImageList.AddMasked(Bitmap, MaskColor);
    BitmapImageList.GetIcon(0, Icon);
    Result := True;
  finally
    BitmapImageList.Free;
  end;
end;


function TCoolTrayIcon.GetClientIconPos(X, Y: Integer): TPoint;
// Return the cursor position inside the tray icon
const
  IconBorder = 1;
//  IconSize = 16;
var
  H: HWND;
  P: TPoint;
  IconSize: Integer;
begin
{ The CoolTrayIcon.Handle property is not the window handle of the tray icon.
  We can find the window handle via WindowFromPoint when the mouse is over
  the tray icon. (It can probably be found via GetWindowLong as well).

  BTW: The parent of the tray icon is the TASKBAR - not the traybar, which
  contains the tray icons and the clock. The traybar seems to be a canvas,
  not a real window (?). }

  // Get the icon size
  IconSize := GetSystemMetrics(SM_CYCAPTION) - 3;

  P.X := X;
  P.Y := Y;
  H := WindowFromPoint(P);
  { Convert current cursor X,Y coordinates to tray client coordinates.
    Add borders to tray icon size in the calculations. }
  Windows.ScreenToClient(H, P);
  P.X := (P.X mod ((IconBorder*2)+IconSize)) -1;
  P.Y := (P.Y mod ((IconBorder*2)+IconSize)) -1;
  Result := P;
end;


function TCoolTrayIcon.GetTooltipHandle: HWND;
{ All tray icons (but not the clock) share the same tooltip.
  Return the tooltip handle or 0 if error. }
var
  wnd, lTaskBar: HWND;
  pidTaskBar, pidWnd: DWORD;
begin
  // Get the TaskBar handle
  lTaskBar := FindWindowEx(0, 0, 'Shell_TrayWnd', nil);
  // Get the TaskBar Process ID
  GetWindowThreadProcessId(lTaskBar, @pidTaskBar);

  // Enumerate all tooltip windows
  wnd := FindWindowEx(0, 0, TOOLTIPS_CLASS, nil);
  while wnd <> 0 do
  begin
    // Get the tooltip process ID
    GetWindowThreadProcessId(wnd, @pidWnd);
    { Compare the process ID of the taskbar and the tooltip.
      If they are the same we have one of the taskbar tooltips. }
    if pidTaskBar = pidWnd then
      { Get the tooltip style. The tooltip for tray icons does not have the
        TTS_NOPREFIX style. }
      if (GetWindowLong(wnd, GWL_STYLE) and TTS_NOPREFIX) = 0 then
        Break;

    wnd := FindWindowEx(0, wnd, TOOLTIPS_CLASS, nil);
  end;
  Result := wnd;
end;


function TCoolTrayIcon.GetBalloonHintHandle: HWND;
{ All applications share the same balloon hint.
  Return the balloon hint handle or 0 if error. }
var
  wnd, lTaskBar: HWND;
  pidTaskBar, pidWnd: DWORD;
begin
  // Get the TaskBar handle
  lTaskBar := FindWindowEx(0, 0, 'Shell_TrayWnd', nil);
  // Get the TaskBar Process ID
  GetWindowThreadProcessId(lTaskBar, @pidTaskBar);

  // Enumerate all tooltip windows
  wnd := FindWindowEx(0, 0, TOOLTIPS_CLASS, nil);
  while wnd <> 0 do
  begin
    // Get the tooltip process ID
    GetWindowThreadProcessId(wnd, @pidWnd);
    { Compare the process ID of the taskbar and the tooltip.
      If they are the same we have one of the taskbar tooltips. }
    if pidTaskBar = pidWnd then
      // We don't want windows with the TTS_NOPREFIX style. That's the simple tooltip.
      if (GetWindowLong(wnd, GWL_STYLE) and TTS_NOPREFIX) <> 0 then
        Break;
        
    wnd := FindWindowEx(0, wnd, TOOLTIPS_CLASS, nil);
  end;
  Result := wnd;
end;


function TCoolTrayIcon.SetFocus: Boolean;
begin
  Result := Shell_NotifyIcon(NIM_SETFOCUS, @IconData);
end;


function TCoolTrayIcon.Refresh: Boolean;
// Refresh the icon
begin
  Result := ModifyIcon;
end;


procedure TCoolTrayIcon.Popup(X, Y: Integer);
begin
  if Assigned(FPopupMenu) then
  begin
    { Bring the main form (or its modal dialog) to the foreground.
      Do this by calling SetForegroundWindow(Handle);
      We don't use Application.Handle as it will make the taskbar button 
      visible in case the form/application is hidden. }
    SetForegroundWindow(Handle);
    { Win98 (unlike other Windows versions) empties a popup menu before
      closing it. This is a problem when the menu is about to display
      while it already is active (two click-events in succession). The
      menu will flicker annoyingly. Calling ProcessMessages fixes this. }
    Application.ProcessMessages;
    // Now make the menu pop up
    FPopupMenu.PopupComponent := Self;
    FPopupMenu.Popup(X, Y);
    // Remove the popup again in case user deselects it
    if Owner is TWinControl then   // Owner might be of type TService
      // Post an empty message to the owner form so popup menu disappears
      PostMessage((Owner as TWinControl).Handle, WM_NULL, 0, 0)
{
    else
      // Owner is not a form; send the empty message to the app.
      PostMessage(Application.Handle, WM_NULL, 0, 0);
}
  end;
end;


procedure TCoolTrayIcon.PopupAtCursor;
var
  CursorPos: TPoint;
begin
  if GetCursorPos(CursorPos) then
  begin
    Popup(CursorPos.X, CursorPos.Y);
  end;
end;


procedure TCoolTrayIcon.Click;
begin
  if Assigned(FOnClick) then
    FOnClick(Self);
end;


procedure TCoolTrayIcon.DblClick;
begin
  if Assigned(FOnDblClick) then
    FOnDblClick(Self);
end;


procedure TCoolTrayIcon.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  if Assigned(FOnMouseDown) then
    FOnMouseDown(Self, Button, Shift, X, Y);
end;


procedure TCoolTrayIcon.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  if Assigned(FOnMouseUp) then
    FOnMouseUp(Self, Button, Shift, X, Y);
end;


procedure TCoolTrayIcon.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(FOnMouseMove) then
    FOnMouseMove(Self, Shift, X, Y);
end;


procedure TCoolTrayIcon.MouseEnter;
begin
  if Assigned(FOnMouseEnter) then
    FOnMouseEnter(Self);
end;


procedure TCoolTrayIcon.MouseExit;
begin
  if Assigned(FOnMouseExit) then
    FOnMouseExit(Self);
end;


procedure TCoolTrayIcon.CycleIcon;
var
  NextIconIndex: Integer;
begin
  NextIconIndex := 0;
  if FIconList <> nil then
    if FIconIndex < FIconList.Count then
      NextIconIndex := FIconIndex +1;

  if Assigned(FOnCycle) then
    FOnCycle(Self, NextIconIndex);
end;


procedure TCoolTrayIcon.DoMinimizeToTray;
begin
  // Override this method to change automatic tray minimizing behavior
  HideMainForm;
  IconVisible := True;
end;


{$IFDEF WINNT_SERVICE_HACK}
function TCoolTrayIcon.IsWinNT: Boolean;
var
  ovi: TOSVersionInfo;
  rc: Boolean;
begin
  rc := False;
  ovi.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
  if GetVersionEx(ovi) then
    rc := (ovi.dwPlatformId = VER_PLATFORM_WIN32_NT) and (ovi.dwMajorVersion <= 4);
  Result := rc;
end;
{$ENDIF}


procedure TCoolTrayIcon.HideTaskbarIcon;
begin
  if IsWindowVisible(Application.Handle) then
    ShowWindow(Application.Handle, SW_HIDE);
end;


procedure TCoolTrayIcon.ShowTaskbarIcon;
begin
  if not IsWindowVisible(Application.Handle) then
    ShowWindow(Application.Handle, SW_SHOW);
end;


procedure TCoolTrayIcon.ShowMainForm;
begin
  if Owner is TWinControl then         // Owner might be of type TService
    if Application.MainForm <> nil then
    begin
      // Restore the app, but don't automatically show its taskbar icon
      // Show application's TASKBAR icon (not the tray icon)
//      ShowWindow(Application.Handle, SW_RESTORE);
      Application.Restore;
      // Show the form itself
      if Application.MainForm.WindowState = wsMinimized then
        Application.MainForm.WindowState := wsNormal;    // Override minimized state
      Application.MainForm.Visible := True;
      // Bring the main form (or its modal dialog) to the foreground
      SetForegroundWindow(Application.Handle);
    end;
end;


procedure TCoolTrayIcon.HideMainForm;
begin
  if Owner is TWinControl then         // Owner might be of type TService
    if Application.MainForm <> nil then
    begin
      // Hide the form itself (and thus any child windows)
      Application.MainForm.Visible := False;
      { Hide application's TASKBAR icon (not the tray icon). Do this AFTER
        the main form is hidden, or any child windows will redisplay the
        taskbar icon if they are visible. }
      HideTaskbarIcon;
    end;
end;


initialization
{$IFDEF DELPHI_4_UP}
  // Get shell version
  SHELL_VERSION := GetComCtlVersion;
  // Use the TaskbarCreated message available from Win98/IE4+
  if SHELL_VERSION >= ComCtlVersionIE4 then
{$ENDIF}
    WM_TASKBARCREATED := RegisterWindowMessage('TaskbarCreated');

finalization
  if Assigned(TrayIconHandler) then
  begin
    // Destroy handler
    TrayIconHandler.Free;
    TrayIconHandler := nil;
  end;

end.