delphi托盘弹出信息

Posted 2023-04-22

我想做delphi托盘弹出信息,就象发现新硬件.插入U盘的那种,麻烦知道的朋友发下代码,如果可以的话就十分感谢了

你用的什么版本的Delphi啊？Delphi2005以上系统已经自带的托盘控件，如果是之前版本的，可以找第三方控件,下面的代码是Delphi2006自带的控件的源码，你可以保存成文件，直接引用，也可以注册成控件，直接放控件到Form上：

TCustomTrayIcon = class(TComponent)
private
FAnimate: Boolean;
FData: TNotifyIconData;
FIsClicked: Boolean;
FCurrentIcon: TIcon;
FIcon: TIcon;
FIconList: TImageList;
FPopupMenu: TPopupMenu;
FTimer: TTimer;
FHint: String;
FIconIndex: Integer;
FVisible: Boolean;
FOnMouseMove: TMouseMoveEvent;
FOnClick: TNotifyEvent;
FOnDblClick: TNotifyEvent;
FOnMouseDown: TMouseEvent;
FOnMouseUp: TMouseEvent;
FOnAnimate: TNotifyEvent;
FBalloonHint: string;
FBalloonTitle: string;
FBalloonFlags: TBalloonFlags;
class var
RM_TaskbarCreated: DWORD;
protected
procedure SetHint(const Value: string);
function GetAnimateInterval: Cardinal;
procedure SetAnimateInterval(Value: Cardinal);
procedure SetAnimate(Value: Boolean);
procedure SetBalloonHint(const Value: string);
function GetBalloonTimeout: Integer;
procedure SetBalloonTimeout(Value: Integer);
procedure SetBalloonTitle(const Value: string);
procedure SetVisible(Value: Boolean); virtual;
procedure SetIconIndex(Value: Integer); virtual;
procedure SetIcon(Value: TIcon);
procedure SetIconList(Value: TImageList);
procedure WindowProc(var Message: TMessage); virtual;
procedure DoOnAnimate(Sender: TObject); virtual;
property Data: TNotifyIconData read FData;
function Refresh(Message: Integer): Boolean; overload;
public
constructor Create(Owner: TComponent); override;
destructor Destroy; override;
procedure Refresh; overload;
procedure SetDefaultIcon;
procedure ShowBalloonHint; virtual;
property Animate: Boolean read FAnimate write SetAnimate default False;
property AnimateInterval: Cardinal read GetAnimateInterval write SetAnimateInterval default 1000;
property Hint: string read FHint write SetHint;
property BalloonHint: string read FBalloonHint write SetBalloonHint;
property BalloonTitle: string read FBalloonTitle write SetBalloonTitle;
property BalloonTimeout: Integer read GetBalloonTimeout write SetBalloonTimeout default 3000;
property BalloonFlags: TBalloonFlags read FBalloonFlags write FBalloonFlags default bfNone;
property Icon: TIcon read FIcon write SetIcon;
property Icons: TImageList read FIconList write SetIconList;
property IconIndex: Integer read FIconIndex write SetIconIndex default 0;
property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;
property Visible: Boolean read FVisible write SetVisible default False;
property OnClick: TNotifyEvent read FOnClick write FOnClick;
property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
property OnAnimate: TNotifyEvent read FOnAnimate write FOnAnimate;
end;

TTrayIcon = class(TCustomTrayIcon)
published
property Animate;
property AnimateInterval;
property Hint;
property BalloonHint;
property BalloonTitle;
property BalloonTimeout;
property BalloonFlags;
property Icon;
property Icons;
property IconIndex;
property PopupMenu;
property Visible;
property OnClick;
property OnDblClick;
property OnMouseMove;
property OnMouseUp;
property OnMouseDown;
property OnAnimate;
end;

TTrayIcon

constructor TCustomTrayIcon.Create(Owner: TComponent);
begin
inherited;
FAnimate := False;
FBalloonFlags := bfNone;
BalloonTimeout := 3000;
FIcon := TIcon.Create;
FCurrentIcon := TIcon.Create;
FTimer := TTimer.Create(Nil);
FIconIndex := 0;
FVisible := False;
FIsClicked := False;
FTimer.Enabled := False;
FTimer.OnTimer := DoOnAnimate;
FTimer.Interval := 1000;

if not (csDesigning in ComponentState) then
begin
FillChar(FData, SizeOf(FData), 0);
FData.cbSize := SizeOf(FData);
FData.Wnd := Classes.AllocateHwnd(WindowProc);
FData.uID := FData.Wnd;
FData.uTimeout := 3000;
FData.hIcon := FCurrentIcon.Handle;
FData.uFlags := NIF_ICON or NIF_MESSAGE;
FData.uCallbackMessage := WM_SYSTEM_TRAY_MESSAGE;
StrPLCopy(FData.szTip, Application.Title, SizeOf(FData.szTip) - 1);

if Length(Application.Title) > 0 then
FData.uFlags := FData.uFlags or NIF_TIP;

Refresh;
end;
end;

destructor TCustomTrayIcon.Destroy;
begin
if not (csDesigning in ComponentState) then
Refresh(NIM_DELETE);

FCurrentIcon.Free;
FIcon.Free;
FTimer.Free;
Classes.DeallocateHWnd(FData.Wnd);
inherited;
end;

procedure TCustomTrayIcon.SetVisible(Value: Boolean);
begin
if FVisible <> Value then
begin
FVisible := Value;
if (not FAnimate) or (FAnimate and FCurrentIcon.Empty) then
SetDefaultIcon;

if not (csDesigning in ComponentState) then
begin
if FVisible then
begin
if not Refresh(NIM_ADD) then
raise EOutOfResources.Create(STrayIconCreateError);
end
else if not (csLoading in ComponentState) then
begin
if not Refresh(NIM_DELETE) then
raise EOutOfResources.Create(STrayIconRemoveError);
end;
if FAnimate then
FTimer.Enabled := Value;
end;
end;
end;

procedure TCustomTrayIcon.SetIconList(Value: TImageList);
begin
if FIconList <> Value then
begin
FIconList := Value;
if not (csDesigning in ComponentState) then
begin
if Assigned(FIconList) then
FIconList.GetIcon(FIconIndex, FCurrentIcon)
else
SetDefaultIcon;
Refresh;
end;
end;
end;

procedure TCustomTrayIcon.SetHint(const Value: string);
begin
if CompareStr(FHint, Value) <> 0 then
begin
FHint := Value;
StrPLCopy(FData.szTip, FHint, SizeOf(FData.szTip) - 1);

if Length(Hint) > 0 then
FData.uFlags := FData.uFlags or NIF_TIP
else
FData.uFlags := FData.uFlags and not NIF_TIP;

Refresh;
end;
end;

function TCustomTrayIcon.GetAnimateInterval: Cardinal;
begin
Result := FTimer.Interval;
end;

procedure TCustomTrayIcon.SetAnimateInterval(Value: Cardinal);
begin
FTimer.Interval := Value;
end;

procedure TCustomTrayIcon.SetAnimate(Value: Boolean);
begin
if FAnimate <> Value then
begin
FAnimate := Value;
if not (csDesigning in ComponentState) then
begin
if (FIconList <> nil) and (FIconList.Count > 0) and Visible then
FTimer.Enabled := Value;
if (not FAnimate) and (not FCurrentIcon.Empty) then
FIcon.Assign(FCurrentIcon);
end;
end;
end;

Message handler for the hidden shell notification window. Most messages
use WM_SYSTEM_TRAY_MESSAGE as the Message ID, with WParam as the ID of the
shell notify icon data. LParam is a message ID for the actual message, e.g.,
WM_MOUSEMOVE. Another important message is WM_ENDSESSION, telling the shell
notify icon to delete itself, so Windows can shut down.

Send the usual events for the mouse messages. Also interpolate the OnClick
event when the user clicks the left button, and popup the menu, if there is
one, for right click events.
procedure TCustomTrayIcon.WindowProc(var Message: TMessage);

Return the state of the shift keys.
function ShiftState: TShiftState;
begin
Result := [];

if GetKeyState(VK_SHIFT) < 0 then
Include(Result, ssShift);
if GetKeyState(VK_CONTROL) < 0 then
Include(Result, ssCtrl);
if GetKeyState(VK_MENU) < 0 then
Include(Result, ssAlt);
end;

var
Point: TPoint;
Shift: TShiftState;
begin
case Message.Msg of
WM_QUERYENDSESSION:
Message.Result := 1;

WM_ENDSESSION:
begin
if TWmEndSession(Message).EndSession then
Refresh(NIM_DELETE);
end;

WM_SYSTEM_TRAY_MESSAGE:
begin
case Message.lParam of
WM_MOUSEMOVE:
begin
if Assigned(FOnMouseMove) then
begin
Shift := ShiftState;
GetCursorPos(Point);
FOnMouseMove(Self, Shift, Point.X, Point.Y);
end;
end;

WM_LBUTTONDOWN:
begin
if Assigned(FOnMouseDown) then
begin
Shift := ShiftState + [ssLeft];
GetCursorPos(Point);
FOnMouseDown(Self, mbMiddle, Shift, Point.X, Point.Y);
end;

FIsClicked := True;
end;

WM_LBUTTONUP:
begin
Shift := ShiftState + [ssLeft];
GetCursorPos(Point);
if FIsClicked and Assigned(FOnClick) then
begin
FOnClick(Self);
FIsClicked := False;
end;
if Assigned(FOnMouseUp) then
FOnMouseUp(Self, mbLeft, Shift, Point.X, Point.Y);
end;

WM_RBUTTONDOWN:
begin
if Assigned(FOnMouseDown) then
begin
Shift := ShiftState + [ssRight];
GetCursorPos(Point);
FOnMouseDown(Self, mbRight, Shift, Point.X, Point.Y);
end;
end;

WM_RBUTTONUP:
begin
Shift := ShiftState + [ssRight];
GetCursorPos(Point);
if Assigned(FOnMouseUp) then
FOnMouseUp(Self, mbRight, Shift, Point.X, Point.Y);
if Assigned(FPopupMenu) then
begin
SetForegroundWindow(Application.Handle);
Application.ProcessMessages;
FPopupMenu.AutoPopup := False;
FPopupMenu.PopupComponent := Owner;
FPopupMenu.Popup(Point.x, Point.y);
end;
end;

WM_LBUTTONDBLCLK, WM_MBUTTONDBLCLK, WM_RBUTTONDBLCLK:
if Assigned(FOnDblClick) then
FOnDblClick(Self);

WM_MBUTTONDOWN:
begin
if Assigned(FOnMouseDown) then
begin
Shift := ShiftState + [ssMiddle];
GetCursorPos(Point);
FOnMouseDown(Self, mbMiddle, Shift, Point.X, Point.Y);
end;
end;

WM_MBUTTONUP:
begin
if Assigned(FOnMouseUp) then
begin
Shift := ShiftState + [ssMiddle];
GetCursorPos(Point);
FOnMouseUp(Self, mbMiddle, Shift, Point.X, Point.Y);
end;
end;

NIN_BALLOONHIDE, NIN_BALLOONTIMEOUT:
begin
FData.uFlags := FData.uFlags and not NIF_INFO;
end;
end;
end;

else if (Message.Msg = RM_TaskBarCreated) and Visible then
Refresh(NIM_ADD);
end;
end;

procedure TCustomTrayIcon.Refresh;
begin
if not (csDesigning in ComponentState) then
begin
FData.hIcon := FCurrentIcon.Handle;

if Visible then
Refresh(NIM_MODIFY);
end;
end;

function TCustomTrayIcon.Refresh(Message: Integer): Boolean;
begin
Result := Shell_NotifyIcon(Message, @FData);
end;

procedure TCustomTrayIcon.SetIconIndex(Value: Integer);
begin
if FIconIndex <> Value then
begin
FIconIndex := Value;
if not (csDesigning in ComponentState) then
begin
if Assigned(FIconList) then
FIconList.GetIcon(FIconIndex, FCurrentIcon);
Refresh;
end;
end;
end;

procedure TCustomTrayIcon.DoOnAnimate(Sender: TObject);
begin
if Assigned(FOnAnimate) then
FOnAnimate(Self);
if Assigned(FIconList) and (FIconIndex < FIconList.Count - 1) then
IconIndex := FIconIndex + 1
else
IconIndex := 0;
Refresh;
end;

procedure TCustomTrayIcon.SetIcon(Value: TIcon);
begin
FIcon.Assign(Value);
FCurrentIcon.Assign(Value);
Refresh;
end;

procedure TCustomTrayIcon.SetBalloonHint(const Value: string);
begin
if CompareStr(FBalloonHint, Value) <> 0 then
begin
FBalloonHint := Value;
StrPLCopy(FData.szInfo, FBalloonHint, SizeOf(FData.szInfo) - 1);
Refresh(NIM_MODIFY);
end;
end;

procedure TCustomTrayIcon.SetDefaultIcon;
begin
if not FIcon.Empty then
FCurrentIcon.Assign(FIcon)
else
FCurrentIcon.Assign(Application.Icon);
Refresh;
end;

procedure TCustomTrayIcon.SetBalloonTimeout(Value: Integer);
begin
FData.uTimeout := Value;
end;

function TCustomTrayIcon.GetBalloonTimeout: Integer;
begin
Result := FData.uTimeout;
end;

procedure TCustomTrayIcon.ShowBalloonHint;
begin
FData.uFlags := FData.uFlags or NIF_INFO;
FData.dwInfoFlags := Integer(FBalloonFlags);
Refresh(NIM_MODIFY);
end;

procedure TCustomTrayIcon.SetBalloonTitle(const Value: string);
begin
if CompareStr(FBalloonTitle, Value) <> 0 then
begin
FBalloonTitle := Value;
StrPLCopy(FData.szInfoTitle, FBalloonTitle, SizeOf(FData.szInfoTitle) - 1);
Refresh(NIM_MODIFY);
end;
end;

initialization
// 这段代码是为了让通知窗口重建的时候通知应用程序
TCustomTrayIcon.RM_TaskBarCreated := RegisterWindowMessage('TaskbarCreated'); 参考技术A 用rz套件里的rztrayicon就可以实现

delphi弹出信息框大全

1． 警告信息框 MessageBox(Handle,‘警告信息框‘,‘警告信息框‘,MB_ICONWARNING);

2．疑问信息框 MessageBox(Handle,‘疑问信息框‘,‘疑问信息框‘,MB_ICONQUESTION);

3．错误提示框 MessageBox(Handle,‘错误信息框‘,‘错误信息框‘,MB_ICONERROR);

4．提示信息框 MessageBox(Handle,‘提示信息框‘,‘提示信息框‘,MB_ICONASTERISK);

5．说明信息框 MessageBox(Handle,‘说明信息框‘,‘说明信息框‘,MB_HELP);

6．提示信息框 MessageBox(Handle,‘提示信息框‘,‘提示信息框‘,MB_OK);

7．确认信息框 MessageBox(Handle,‘确认信息框‘,‘确认信息框‘,MB_OKCANCEL);

8．重试信息框 MessageBox(Handle,‘重试信息框‘,‘重试信息框‘,MB_RETRYCANCEL);

9．是否信息框 Application.MessageBox(Handle,‘是否信息框‘,‘是否信息框‘,MB_YESNO);

10．是否取消信息框 Application.MessageBox(Handle,‘是否取消信息框‘,‘是否取消信息框‘,MB_YESNOCANCEL);

11 简单提示信息框 ShowMessage(‘这个就是ShowMessage函数生成的信息提示框！‘);

_____________________________________________________________________________

1． 警告信息框 MessageBox(Handle,‘程序超出内存。‘,‘错误‘,MB_OK+MB_ICONERROR)

MessageBox(0, ‘配置文件成功‘, ‘提示‘, mb_iconinformation



-----------------------------------

以下是详细说明

//ShowMessage:
begin
ShowMessage(‘提示内容‘); {标题默认工程名, 如: Proect1}

Application.Title := ‘警告‘; {如果修改工程标题...}
ShowMessage(‘提示内容‘); {标题是‘警告‘}

ShowMessage(‘第一行‘ + #13#10 + ‘第二行‘); {提示信息换行}
ShowMessage(‘第一行‘#13‘第二行‘); {也可以}
end;



--------------------------------------------------------------------------------



//InputBox:
var
s: string;
begin
s := InputBox(‘标题‘,‘提示信息‘,‘默认输入‘);
ShowMessage(s); //显示输入的内容
end;


--------------------------------------------------------------------------------



//InputQuery:
var
s: string;
begin
InputQuery(‘标题‘,‘提示信息‘,s); //为字符串变量 S 输入值, 返回布尔型
ShowMessage(s); //显示输入的内容
end;


--------------------------------------------------------------------------------



//MessageBox:
var
i: Integer;
begin
i := MessageBox(0,‘提示内容‘,‘标题‘,mrOk); //第一个参数一般用 Self.Handle, 0代表桌面

//可选参数 
//mrNone
//mrOk
//mrCancel
//mrAbort
//mrRetry
//mrIgnore
//mrYes
//mrNo
//mrAll
//mrNoToAll
//mrYesToAll

ShowMessage(IntToStr(i));

//还可以组合第四个参数以调用不同的图标:
MessageBox(0,‘提示内容‘,‘标题‘,mrOk + MB_ICONHAND);

//MB_ICONHAND
//MB_ICONQUESTION
//MB_ICONEXCLAMATION
//MB_ICONASTERISK
//MB_USERICON
//MB_ICONWARNING
//MB_ICONERROR
//MB_ICONINFORMATION
//MB_ICONSTOP
end;

//后来补充, 还是应该使用 API 的原有参数更好些:
{可选参数或它们的组合}
MB_OK = $00000000;
MB_OKCANCEL = $00000001;
MB_ABORTRETRYIGNORE = $00000002;
MB_YESNOCANCEL = $00000003;
MB_YESNO = $00000004;
MB_RETRYCANCEL = $00000005;
MB_ICONHAND = $00000010;
MB_ICONQUESTION = $00000020;
MB_ICONEXCLAMATION = $00000030;
MB_ICONASTERISK = $00000040;
MB_USERICON = $00000080;
MB_ICONWARNING = MB_ICONEXCLAMATION;
MB_ICONERROR = MB_ICONHAND;
MB_ICONINFORMATION = MB_ICONASTERISK;
MB_ICONSTOP = MB_ICONHAND;
MB_DEFBUTTON1 = $00000000;
MB_DEFBUTTON2 = $00000100;
MB_DEFBUTTON3 = $00000200;
MB_DEFBUTTON4 = $00000300;
MB_APPLMODAL = $00000000;
MB_SYSTEMMODAL = $00001000;
MB_TASKMODAL = $00002000;
MB_HELP = $00004000;
MB_NOFOCUS = $00008000;
MB_SETFOREGROUND = $00010000;
MB_DEFAULT_DESKTOP_ONLY = $00020000;
MB_TOPMOST = $00040000;
MB_RIGHT = $00080000;
MB_RTLREADING = $00100000;
MB_SERVICE_NOTIFICATION = $00200000;
MB_SERVICE_NOTIFICATION_NT3X = $00040000;
MB_TYPEMASK = $0000000F;
MB_ICONMASK = $000000F0;
MB_DEFMASK = $00000F00;
MB_MODEMASK = $00003000;
MB_MISCMASK = $0000C000;

{可能的返回值}
IDOK = 1; ID_OK = IDOK;
IDCANCEL = 2; ID_CANCEL = IDCANCEL;
IDABORT = 3; ID_ABORT = IDABORT;
IDRETRY = 4; ID_RETRY = IDRETRY;
IDIGNORE = 5; ID_IGNORE = IDIGNORE;
IDYES = 6; ID_YES = IDYES;
IDNO = 7; ID_NO = IDNO;
IDCLOSE = 8; ID_CLOSE = IDCLOSE;
IDHELP = 9; ID_HELP = IDHELP;
IDTRYAGAIN = 10;
IDCONTINUE = 11;


--------------------------------------------------------------------------------



//MessageDlg:
var
i: Integer;
begin
MessageDlg(‘提示信息‘,mtWarning,mbYesNo,0);

//第二个参数调用不同的图标:
//mtWarning
//mtError
//mtInformation
//mtConfirmation
//mtCustom

//第三个参数调用不同的按钮:
//mbYesNo = [mbYes, mbNo];
//mbYesNoCancel = [mbYes, mbNo, mbCancel];
//mbYesAllNoAllCancel = [mbYes, mbYesToAll, mbNo, mbNoToAll, mbCancel];
//mbOKCancel = [mbOK, mbCancel];
//mbAbortRetryIgnore = [mbAbort, mbRetry, mbIgnore];
//mbAbortIgnore = [mbAbort, mbIgnore];
//可以直接输入集合元素,譬如: MessageDlg(‘aaa‘,mtWarning,[mbYes],1);

//第四个参数帮助ID, 没有添0
//还有重载的第5个参数是设定默认按钮
//如果要本地话显示需要修改源文件, 一般可以用 MessageBox 代替
end;


--------------------------------------------------------------------------------



//MessageDlgPos:
begin
MessageDlgPos(‘提示信息‘,mtCustom,mbYesNoCancel,0,400,100);
//比 MessageDlg 多出两个参数来控制显示位置
end;