delphi 实现用户自定义通知(User Notification)

unit Form_Main;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, ActiveX, ComObj, ShlObj,
  ShLwApi;

type

  TFormMain = class(TForm, IQueryContinue, IUserNotificationCallback)
    Button1: TButton;
    CheckBox1: TCheckBox;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    I: IUserNotification2;
  public
    function QueryContinue: HRESULT; stdcall;
    function OnBalloonUserClick(const pt: TPoint): HRESULT; stdcall;
    function OnLeftClick(const pt: TPoint): HRESULT; stdcall;
    function OnContextMenu(const pt: TPoint): HRESULT; stdcall;
  end;

var
  FormMain: TFormMain;

implementation

{$R *.dfm}

procedure TFormMain.Button1Click(Sender: TObject);
begin
  I.SetIconInfo(Application.Icon.Handle, 'IUserNotification2演示');
  I.SetBalloonInfo('提示标题', '这是提示内容', 3);
  I.SetBalloonRetry(1000, 5000, 3);
  I.Show(self as IQueryContinue, 1000, self as IUserNotificationCallback);
end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
  I := CreateComObject(CLSID_UserNotification) as IUserNotification2;
end;

procedure TFormMain.FormDestroy(Sender: TObject);
begin
  I := nil;
end;

function TFormMain.OnBalloonUserClick(const pt: TPoint): HRESULT;
begin
  ShowMessage('Balloon User Click!');
end;

function TFormMain.OnContextMenu(const pt: TPoint): HRESULT;
begin
  ShowMessage('On Context Menu');
end;

function TFormMain.OnLeftClick(const pt: TPoint): HRESULT;
begin
  ShowMessage('Left Click!');
end;

function TFormMain.QueryContinue: HRESULT;
begin
  if CheckBox1.Checked then
    Result := S_OK
  else
    Result := S_FALSE;
end;

end.