cooltrayicon.pas

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

{ This method is called to determine whether to assign a default icon to
  the component. Descendant classes (like TextTrayIcon) can override the
  method to change this behavior. }
begin
  Result := True;
end;


procedure TCoolTrayIcon.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  // Check if either the imagelist or the popup menu is about to be deleted
  if (AComponent = IconList) and (Operation = opRemove) then
  begin
    FIconList := nil;
    IconList := nil;
  end;
  if (AComponent = PopupMenu) and (Operation = opRemove) then
  begin
    FPopupMenu := nil;
    PopupMenu := nil;
  end;
end;


procedure TCoolTrayIcon.IconChanged(Sender: TObject);
begin
  ModifyIcon;
end;


{ All app. messages pass through HookAppProc. You can override the messages
  by not passing them along to Windows (set Result=True). }

function TCoolTrayIcon.HookAppProc(var Msg: TMessage): Boolean;
var
  Show: Boolean;
//  HideForm: Boolean;
begin
  Result := False;  // Should always be False unless we don't want the default message handling

  case Msg.Msg of

    WM_SIZE:
      // Handle MinimizeToTray by capturing minimize event of application
      if Msg.wParam = SIZE_MINIMIZED then
      begin
        if FMinimizeToTray then
          DoMinimizeToTray;
        { You could insert a call to a custom minimize event here, but it would
          behave exactly like Application.OnMinimize, so I see no need for it. }
      end;

    WM_WINDOWPOSCHANGED: begin
      { Handle MDI forms: MDI children cause the app. to be redisplayed on the
        taskbar. We hide it again. This may cause a quick flicker. }
      if SettingMDIForm then
        if Application.MainForm <> nil then
        begin

          if Application.MainForm.FormStyle = fsMDIForm then
          begin
            Show := True;
            if Assigned(FOnStartup) then
              FOnStartup(Self, Show);
            if not Show then
              HideTaskbarIcon;
          end;

          SettingMDIForm := False;     // So we only do this once
        end;
    end;

    WM_SYSCOMMAND:
      // Handle MinimizeToTray by capturing minimize event of application
      if Msg.wParam = SC_RESTORE then
      begin
        if Application.MainForm.WindowState = wsMinimized then
          Application.MainForm.WindowState := wsNormal;
        Application.MainForm.Visible := True;
      end;

  end;

  // Show the tray icon if the taskbar has been re-created after an Explorer crash
  if Msg.Msg = WM_TASKBARCREATED then
    if FIconVisible then
      ShowIcon;
end;


procedure TCoolTrayIcon.HookForm;
begin
  if (Owner as TWinControl) <> nil then
  begin
    // Hook the parent window
    OldWndProc := Pointer(GetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC));
{$IFDEF DELPHI_6_UP}
    NewWndProc := Classes.MakeObjectInstance(HookFormProc);
{$ELSE}
    NewWndProc := MakeObjectInstance(HookFormProc);
{$ENDIF}
    SetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC, LongInt(NewWndProc));
  end;
end;


procedure TCoolTrayIcon.UnhookForm;
begin
  if ((Owner as TWinControl) <> nil) and (Assigned(OldWndProc)) then
    SetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC, LongInt(OldWndProc));
  if Assigned(NewWndProc) then
{$IFDEF DELPHI_6_UP}
    Classes.FreeObjectInstance(NewWndProc);
{$ELSE}
    FreeObjectInstance(NewWndProc);
{$ENDIF}
  NewWndProc := nil;
  OldWndProc := nil;
end;

{ All main form messages pass through HookFormProc. You can override the
  messages by not passing them along to Windows (via CallWindowProc).
  You should be careful with the graphical messages, though. }

procedure TCoolTrayIcon.HookFormProc(var Msg: TMessage);

  function DoMinimizeEvents: Boolean;
  begin
    Result := False;
    if FMinimizeToTray then
      if Assigned(FOnMinimizeToTray) then
      begin
        FOnMinimizeToTray(Self);
        DoMinimizeToTray;
        Msg.Result := 1;
        Result := True;
      end;
  end;

begin
  case Msg.Msg of
(*
    WM_PARENTNOTIFY: begin
      if Msg.WParamLo = WM_CREATE then
        if not HasCheckedShowMainFormOnStartup then
        begin
          HasCheckedShowMainFormOnStartup := True;
          if not ShowMainFormOnStartup then
            if Application.MainForm <> nil then
            begin
              Application.ShowMainForm := False;
              HideMainForm;
            end;
        end;
    end;
*)
    WM_SHOWWINDOW: begin
      if (Msg.wParam = 1) and (Msg.lParam = 0) then
      begin
        // Show the taskbar icon (Windows may have shown it already)
//        ShowWindow(Application.Handle, SW_RESTORE);
        // Bring the taskbar icon and the main form to the foreground
        SetForegroundWindow(Application.Handle);
        SetForegroundWindow((Owner as TWinControl).Handle);
      end

      else if (Msg.wParam = 0) and (Msg.lParam = SW_PARENTCLOSING) then
      begin
        // Application is minimizing (or closing), handle MinimizeToTray
        if not Application.Terminated then
          if DoMinimizeEvents then
            Exit;            // Don't pass the message on
      end;

    end;
(*
    WM_WINDOWPOSCHANGING: begin
              HideMainForm;
//      Exit;
    end;
*)
    WM_SYSCOMMAND:
      // Handle MinimizeToTray by capturing minimize event of form
      if Msg.wParam = SC_MINIMIZE then
        if DoMinimizeEvents then
          Exit;              // Don't pass the message on
{
    This condition was intended to solve the "Windows can't shut down" issue.
    Unfortunately, setting FormStyle or BorderStyle recreates the form, which
    means it receives a WM_DESTROY and WM_NCDESTROY message. Since these are
    not passed on the form simply disappears when setting either property.
    Anyway, if these messages need to be handled (?) they should probably
    be handled at application level, rather than form level.

    WM_DESTROY, WM_NCDESTROY: begin
      Msg.Result := 1;
      Exit;
    end;
}
  end;
{
  case Msg.Msg of
    WM_QUERYENDSESSION: begin
      Msg.Result := 1;
    end;
  else
}
    // Pass the message on
    Msg.Result := CallWindowProc(OldWndProc, (Owner as TWinControl).Handle,
                  Msg.Msg, Msg.wParam, Msg.lParam);
{
  end;
}
end;


procedure TCoolTrayIcon.SetIcon(Value: TIcon);
begin
  FIcon.OnChange := nil;
//  FIcon := Value;
  FIcon.Assign(Value);      
  FIcon.OnChange := IconChanged;
  ModifyIcon;
end;


procedure TCoolTrayIcon.SetIconVisible(Value: Boolean);
begin
  if Value then
    ShowIcon
  else
    HideIcon;
end;


procedure TCoolTrayIcon.SetDesignPreview(Value: Boolean);
begin
  FDesignPreview := Value;
  SettingPreview := True;         // Raise flag
  { Assign a default icon if Icon property is empty. This will assign an icon
    to the component when it is created for the very first time. When the user
    assigns another icon it will not be overwritten next time the project loads.
    HOWEVER, if the user has decided explicitly to have no icon a default icon
    will be inserted regardless. I figured this was a tolerable price to pay. }
  if (csDesigning in ComponentState) then
  begin
    if FIcon.Handle = 0 then
      if LoadDefaultIcon then
        FIcon.Handle := LoadIcon(0, IDI_WINLOGO);
    { It is tempting to assign the application's icon (Application.Icon) as a
      default icon. The problem is there's no Application instance at design time.
      Or is there? Yes there is: the Delphi editor! Application.Icon is the icon
      found in delphi32.exe. How to use:
        FIcon.Assign(Application.Icon);
      Seems to work, but I don't recommend it. Why would you want to, anyway? }
    SetIconVisible(Value);
  end;
  SettingPreview := False;        // Clear flag
end;


procedure TCoolTrayIcon.SetCycleIcons(Value: Boolean);
begin
  FCycleIcons := Value;
  if Value then
  begin
    SetIconIndex(0);
    CycleTimer.Interval := FCycleInterval;
    CycleTimer.Enabled := True;
  end
  else
    CycleTimer.Enabled := False;
end;


procedure TCoolTrayIcon.SetCycleInterval(Value: Cardinal);
begin
  if Value <> FCycleInterval then
  begin
    FCycleInterval := Value;
    SetCycleIcons(FCycleIcons);
  end;
end;


{$IFDEF DELPHI_4_UP}
procedure TCoolTrayIcon.SetIconList(Value: TCustomImageList);
{$ELSE}
procedure TCoolTrayIcon.SetIconList(Value: TImageList);
{$ENDIF}
begin
  FIconList := Value;
{
  // Set CycleIcons = false if IconList is nil
  if Value = nil then
    SetCycleIcons(False);
}
  SetIconIndex(0);
end;


procedure TCoolTrayIcon.SetIconIndex(Value: Integer);
begin
  if FIconList <> nil then
  begin
    FIconIndex := Value;
    if Value >= FIconList.Count then
      FIconIndex := FIconList.Count -1;
    FIconList.GetIcon(FIconIndex, FIcon);
  end
  else
    FIconIndex := 0;

  ModifyIcon;
end;


procedure TCoolTrayIcon.SetHint(Value: THintString);
begin
  FHint := Value;
  ModifyIcon;
end;


procedure TCoolTrayIcon.SetShowHint(Value: Boolean);
begin
  FShowHint := Value;
  ModifyIcon;
end;


procedure TCoolTrayIcon.SetWantEnterExitEvents(Value: Boolean);
begin
  FWantEnterExitEvents := Value;
  ExitTimer.Enabled := Value;
end;


procedure TCoolTrayIcon.SetBehavior(Value: TBehavior);
begin
  FBehavior := Value;
  case FBehavior of
    bhWin95:   IconData.TimeoutOrVersion.uVersion := 0;
    bhWin2000: IconData.TimeoutOrVersion.uVersion := NOTIFYICON_VERSION;
  end;
  Shell_NotifyIcon(NIM_SETVERSION, @IconData);
end;


function TCoolTrayIcon.InitIcon: Boolean;
// Set icon and tooltip
var
  ok: Boolean;
begin
  Result := False;
  ok := True;
  if (csDesigning in ComponentState) then
    ok := (SettingPreview or FDesignPreview);

  if ok then
  begin
    try
      IconData.hIcon := FIcon.Handle;
    except
      on EReadError do   // Seems the icon was destroyed
      begin
        IconData.hIcon := 0;
//        Exit;
      end;
    end;
    if (FHint <> '') and (FShowHint) then
    begin
      StrLCopy(IconData.szTip, PChar(String(FHint)), SizeOf(IconData.szTip)-1);
      { StrLCopy must be used since szTip is only 128 bytes. }
      { From IE ver. 5 szTip is 128 chars, before that only 64 chars. I suppose
        I could use GetComCtlVersion to check the version and then truncate
        the string accordingly, but Windows seems to handle this ok by itself. }
      IconData.szTip[SizeOf(IconData.szTip)-1] := #0;
    end
    else
      IconData.szTip := '';
    Result := True;
  end;
end;


function TCoolTrayIcon.ShowIcon: Boolean;
// Add/show the icon on the tray
begin
  Result := False;
  if not SettingPreview then
    FIconVisible := True;
  begin
    if (csDesigning in ComponentState) then
    begin
      if SettingPreview then
        if InitIcon then
          Result := Shell_NotifyIcon(NIM_ADD, @IconData);
    end
    else
      if InitIcon then
        Result := Shell_NotifyIcon(NIM_ADD, @IconData);
  end;
end;


function TCoolTrayIcon.HideIcon: Boolean;
// Remove/hide the icon from the tray
begin
  Result := False;
  if not SettingPreview then
    FIconVisible := False;
  begin
    if (csDesigning in ComponentState) then