unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls,ShellAPI;
type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private 宣言 }
NID : TNotifyIconData;
procedure WMUSER(var Msg : TMsg); message WM_USER + 100;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
with NID do begin
cbSize :=Sizeof(NID);
hIcon := Application.Icon.Handle;
Wnd :=Form1.Handle;
szTip :='PAPY';
uCallbackMessage :=WM_USER + 100;
uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP ;
end;
//アイコンを追加
Shell_NotifyIcon(NIM_ADD, @NID);
end;
{*メッセージ処理*}
procedure
TForm1.WMUSER(var Msg: TMsg);
begin
//左クリック時
if (Msg.wParam = WM_LBUTTONDOWN) then
Label1.Caption :='左クリック' ;
//右クリック時
if (Msg.wParam = WM_RBUTTONDOWN) then
Label1.Caption :='右クリック';
//左ダブルクリック
if (Msg.wParam = WM_LBUTTONDBLCLK) then
Label1.Caption :='左ダブルクリック';
//右ダブルクリック時
if (Msg.wParam = WM_RBUTTONDBLCLK) then
Label1.Caption :='右ダブルクリック' ;
//中央ボタンをクリック
if (Msg.wParam = WM_MBUTTONDOWN) then
Label1.Caption :='中央ボタンをクリック';
//中央ボタンをクリック
if (Msg.wParam = WM_MBUTTONDBLCLK) then
Label1.Caption :='中央ボタンをダブルクリック';
//マウスが移動
if (Msg.wParam = WM_MOUSEMOVE ) then
Label1.Caption :='マウスが通過';
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
//アイコンを削除
Shell_NotifyIcon(NIM_DELETE, @NID);
end;
end. |