cooltrayicon.pas

絮语2007视频聊天软件源程序.仅供参考

end;


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

  if ok then
  begin
    IconData.hIcon := FIcon.Handle;
    if (FHint <> '') and (FShowHint) then
      StrLCopy(IconData.szTip, PChar(FHint), SizeOf(IconData.szTip)-1)
      // StrLCopy must be used since szTip is only 64 bytes
    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
    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;


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

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


function TCoolTrayIcon.ShowBalloonHint(Title: String; 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);
begin
  if FEnabled then
  begin
    // Remove old balloon hint
    with IconData do
    begin
      uFlags := uFlags or NIF_INFO;
      StrPCopy(szInfo, '');
    end;
    ModifyIcon;
    // Display new balloon hint
    with IconData do
    begin
      uFlags := uFlags or NIF_INFO;
      StrPCopy(szInfo, Text);
      StrPCopy(szInfoTitle, Title);
      uTimeout := TimeoutSecs * 1000;
      dwInfoFlags := aBalloonIconTypes[IconType];
    end;
    Result := ModifyIcon;
    { Remove NIF_INFO before next call to ModifyIcon (or else the balloon hint
      will redisplay itself) }
    with IconData do
      uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP;
  end
  else
    Result := True;
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.Refresh: Boolean;
// Refresh the icon
begin
  Result := ModifyIcon;
end;


procedure TCoolTrayIcon.leftpopup(sender:tobject);
begin
Ftimers.Enabled:=false;
PopupAtCursor(true);
end;

procedure TCoolTrayIcon.PopupAtCursor(Vleft:boolean);
var
  CursorPos: TPoint;
begin
if Vleft then
  begin
  if Assigned(PopupMenu) then
    if PopupMenu.AutoPopup then
      if GetCursorPos(CursorPos) then
      begin
        { 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;

        // Give focus to the popupmenu
        SetForegroundWindow(Handle);
        // Bring the main form or its modal dialog to the foreground
        if Owner is TWinControl then   // Owner might be of type TService
          SetForegroundWindow((Owner as TWinControl).Handle);

        // Now make the menu pop up
        PopupMenu.PopupComponent := Self;
        PopupMenu.Popup(CursorPos.X, CursorPos.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 else begin
  if Assigned(PopupMenuEx) then
    if PopupMenuEx.AutoPopup then
      if GetCursorPos(CursorPos) then
      begin
        { 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;

        // Give focus to the popupmenu
        SetForegroundWindow(Handle);
        // Bring the main form or its modal dialog to the foreground
        if Owner is TWinControl then   // Owner might be of type TService
          SetForegroundWindow((Owner as TWinControl).Handle);

        // Now make the menu pop up
        PopupMenuEx.PopupComponent := Self;
        PopupMenuEx.Popup(CursorPos.X, CursorPos.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;
end;


procedure TCoolTrayIcon.Click;
begin
  // Execute user-assigned method
  if Assigned(FOnClick) then
    FOnClick(Self);
end;


procedure TCoolTrayIcon.DblClick;
begin
  // Execute user-assigned method
  if Assigned(FOnDblClick) then
    FOnDblClick(Self);
end;


procedure TCoolTrayIcon.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  // Execute user-assigned method
  if Assigned(FOnMouseDown) then
    FOnMouseDown(Self, Button, Shift, X, Y);
end;


procedure TCoolTrayIcon.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  // Execute user-assigned method
  if Assigned(FOnMouseUp) then
    FOnMouseUp(Self, Button, Shift, X, Y);
end;


procedure TCoolTrayIcon.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  // Execute user-assigned method
  if Assigned(FOnMouseMove) then
    FOnMouseMove(Self, Shift, X, Y);
end;


procedure TCoolTrayIcon.CycleIcon;
var
  NextIconIndex: Integer;
begin
  // Execute user-assigned method
  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;


procedure Register;
begin
  RegisterComponents('Custom', [TCoolTrayIcon]);
end;


procedure TCoolTrayIcon.ShowMainForm;
begin
  if Owner is TWinControl then    // Owner might be of type TService
    if Application.MainForm <> nil then
    begin
      // Show application's TASKBAR icon (not the traybar icon)
      ShowWindow(Application.Handle, SW_RESTORE);
//      ShowWindow(Application.Handle, SW_SHOWNORMAL);
//      Application.Restore;
      // Show the form itself
      Application.MainForm.Visible := True;
      Fmini:=false;
//      ShowWindow((Owner as TWinControl).Handle, SW_RESTORE);
    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 traybar icon).
        Do this AFTER the mainform is hidden, or any child windows
        will redisplay the taskbar icon if they are visible. }
      ShowWindow(Application.Handle, SW_HIDE);
      Fmini:=true;
    end;
end;

end.