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('提示标题', '这是提示内容', );

  I.SetBalloonRetry(, , );

  I.Show(self as IQueryContinue, , 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.