如题。
解决方案 »
- PageControl 清除tabsheet
- 程序运行提示"没有注册类别",寻找了许久都没有找到问题根源。
- <大家新年好>请问如何在"繁体"操作系统下转出"简体"的文字的.Txt或.Word文档?现转出的是乱码。
- 我用query1查询多个表。修改查询数据问题
- 如何Override函数?
- 关于adoquery的 filter属性的设置问题
- TreeView的主要使用方法...
- 菜鸟问题!!!
- from1自动建立,form2非自动建立,如何在form1中调用form2,我这样不行?
- 如何在listview里面加入背景?
- 初学请多指教(三层):要实现无状态的问题和利用数据集更新的问题(很急)?
- 我用edit.text:=timetostr(now);显示当前时间,可是我想显示到秒。怎样做。thanks
unit TrayIcon;interfaceuses
SysUtils, Windows, Messages, Classes, Graphics, Controls, ShellAPI, Forms, menus;const WM_TOOLTRAYICON = WM_USER+1;
WM_RESETTOOLTIP = WM_USER+2;type TTrayIcon = class(TComponent) private { Field Variables } IconData: TNOTIFYICONDATA;
fIcon : TIcon;
fToolTip : String;
fWindowHandle : HWND;
fActive : boolean;
fShowDesigning : Boolean; { Events } fOnClick : TNotifyEvent;
fOnDblClick : TNotifyEvent;
fOnRightClick : TMouseEvent;
fPopupMenu : TPopupMenu; function AddIcon : boolean;
function ModifyIcon : boolean;
function DeleteIcon : boolean; procedure SetActive(Value : boolean);
procedure SetShowDesigning(Value : boolean);
procedure SetIcon(Value : TIcon);
procedure SetToolTip(Value : String);
procedure WndProc(var msg : TMessage); procedure FillDataStructure;
procedure DoRightClick( Sender : TObject ); protected public constructor create(aOwner : TComponent); override;
destructor destroy; override; published property Active : boolean read fActive write SetActive;
property ShowDesigning : boolean read fShowDesigning write SetShowDesigning;
property Icon : TIcon read fIcon write SetIcon;
property ToolTip : string read fTooltip write SetToolTip; property OnClick : TNotifyEvent read FOnClick write FOnClick;
property OnDblClick : TNotifyEvent read FOnDblClick write FOnDblClick;
property OnRightClick : TMouseEvent read FOnRightClick write FonRightClick;
property PopupMenu : TPopupMenu read fPopupMenu write fPopupMenu; end;procedure Register;implementation{$R TrayIcon.res}procedure TTrayIcon.SetActive(Value : boolean);
begin
if value <> fActive then begin
fActive := Value;
if not (csdesigning in ComponentState) then begin
if Value then begin
AddIcon;
end else begin
DeleteIcon;
end;
end;
end;
end;procedure TTrayIcon.SetShowDesigning(Value : boolean);
begin
if csdesigning in ComponentState then begin
if value <> fShowDesigning then begin
fShowDesigning := Value;
if Value then begin
AddIcon;
end else begin
DeleteIcon;
end;
end;
end;
end;procedure TTrayIcon.SetIcon(Value : Ticon);
begin
if Value <> fIcon then
begin
fIcon.Assign(value);
ModifyIcon;
end;
end;procedure TTrayIcon.SetToolTip(Value : string);
begin // This routine ALWAYS re-sets the field value and re-loads the
// icon. This is so the ToolTip can be set blank when the component
// is first loaded. If this is changed, the icon will be blank on
// the tray when no ToolTip is specified. if length( Value ) > 62 then
Value := copy(Value,1,62);
fToolTip := value;
ModifyIcon;end;constructor TTrayIcon.create(aOwner : Tcomponent);
begin
inherited create(aOwner);
FWindowHandle := AllocateHWnd( WndProc );
FIcon := TIcon.Create;
end;destructor TTrayIcon.destroy;
begin if (not (csDesigning in ComponentState) and fActive)
or ((csDesigning in ComponentState) and fShowDesigning) then
DeleteIcon; FIcon.Free;
DeAllocateHWnd( FWindowHandle );
inherited destroy;end;procedure TTrayIcon.FillDataStructure;
begin with IconData do begin cbSize := sizeof(TNOTIFYICONDATA);
wnd := FWindowHandle;
uID := 0; // is not passed in with message so make it 0
uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
hIcon := fIcon.Handle;
StrPCopy(szTip,fToolTip);
uCallbackMessage := WM_TOOLTRAYICON; end;end;function TTrayIcon.AddIcon : boolean;
begin
FillDataStructure;
result := Shell_NotifyIcon(NIM_ADD,@IconData); // For some reason, if there is no tool tip set up, then the icon
// doesn't display. This fixes that. if fToolTip = '' then
PostMessage( fWindowHandle, WM_RESETTOOLTIP,0,0 );end;function TTrayIcon.ModifyIcon : boolean;
begin FillDataStructure;
if fActive then
result := Shell_NotifyIcon(NIM_MODIFY,@IconData)
else
result := True;end;procedure TTrayIcon.DoRightClick( Sender : TObject );
var MouseCo: Tpoint;
begin GetCursorPos(MouseCo); if assigned( fPopupMenu ) then begin
SetForegroundWindow( Application.Handle );
Application.ProcessMessages;
fPopupmenu.Popup( Mouseco.X, Mouseco.Y );
end; if assigned( FOnRightClick ) then
begin
FOnRightClick(self,mbRight,[],MouseCo.x,MouseCo.y);
end;
end;function TTrayIcon.DeleteIcon : boolean;
begin
result := Shell_NotifyIcon(NIM_DELETE,@IconData);
end;procedure TTrayIcon.WndProc(var msg : TMessage);
begin
with msg do
if (msg = WM_RESETTOOLTIP) then
SetToolTip( fToolTip )
else if (msg = WM_TOOLTRAYICON) then begin
case lParam of
WM_LBUTTONDBLCLK : if assigned (FOnDblClick) then FOnDblClick(self);
WM_LBUTTONUP : if assigned(FOnClick)then FOnClick(self);
WM_RBUTTONUP : DoRightClick(self);
end;
end
else // Handle all messages with the default handler
Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);end;procedure Register;
begin
RegisterComponents('Win95', [TTrayIcon]);
end;end.
begin
Application.Minimize;
end;
然后放到面板上,就可以使用了。
在最小化的时候,使用这个控件,它还支持你设置PopupMenu。算了!你要是真不懂就算我白说。
只要在一个事件中把窗口的属性改一下就行了
仔细看,里面很详细的,还有如何制作跳动的,结帖吧
能把CoolTrayIcon 控件發給我看看嗎?
[email protected]