重金收购SYSTARY托盘控件的例程

Question

网上有很多這樣的源代碼﹐免費的tray control都有﹐不要買

Answer 1

我有控件啊，网上很多的
[email protected]

Answer 2

很多软件运行时会在系统托盘区(就是桌面右下角显示时间的区域)出现一个小图标，它作为程序运行的一个标志，我们可以通过使用小图标所弹出的菜单来控制应用程序的状态。本例就给出了一个功能比较完整的托盘程序，我们可以看到怎样用API函数Shell_NotifyIcon来添加、删除、更改托盘图标；而且例中还演示了为托盘图标添加右键菜单和浮动提示的方法。 　　程序(附后)用到了Shell_NotifyIcon、SendMessage、CallWindowProc、SetWindowLong等API函数，其中Shell_NotifyIcon是主要的函数，它用来添加、删除、更改系统托盘区(taskbar status area)的图标，所以我们先来看看这个函数的声明和参数：　　使用API函数之前必须先在程序中声明如下：Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long 
 
　　 
　　其中各参数的意义如下表: 参数： 意义 
dwMessage 为消息设置值，它可以是以下的几个常数值：0、1、2 
NIM_ADD = 0　 加入图标到系统状态栏中 
NIM_MODIFY = 1  修改系统状态栏中的图标 
NIM_DELETE = 2  删除系统状态栏中的图标 　　LpData 用以传入NOTIFYICONDATA数据结构变量，其结构如下所示：Type NOTIFYICONDATA　　cbSize As Long 　　　　　　　需填入NOTIFYICONDATA数据结构的长度
　　HWnd As Long 　　　　　　　　设置成窗口的句柄 
　　Uid As Long　　　　　　　　　为图标所设置的ID值
　　UFlags As Long 　　　　　　　设置uCallbackMessage,hIcon,szTip是否有效
　　UCallbackMessage As Long　　 消息编号
　　HIcon As Long 　　　　　　　 显示在状态栏上的图标
　　SzTip As String * 64　　　　 提示信息
End Type 　　返回值 Long，非零表示成功，零表示失败 　　在使用这个API函数之前我们应该先定义结构类型NOTIFYICONDATA：Public Type NOTIFYICONDATA 
　　　　　cbSize As Long HWnd As Long 
　　　　　Uid As Long UFlags As Long 
　　　　　UCallbackMessage As Long 
　　　　　HIcon As Long 
　　　　　SzTip As String * 64 
　　　End Type  　　然后定义一个NOTIFYICONDATA的变量TheData来记录设置托盘图标的数据Private TheData As NOTIFYICONDATA 　　这时我们就可以使用这个函数来设置系统托盘图标了，具体方法如下：　　　1、添加图标With TheData 
　　　　.Uid = 0
　　　　.HWnd = frm.HWnd　　　　　　　'frm.HWnd是程序主窗体的句柄
　　　　.cbSize = Len(TheData)
　　　　.HIcon = frm.Icon.Handle　　'frm.Icon.Handle指向主窗体的图标
　　　　.UFlags = NIF_ICON
　　　　.UCallbackMessage = TRAY_CALLBACK 
　　　　 '作用是允许返回消息，在下一节中会有详细解释。
　　　　.UFlags = .UFlags Or NIF_MESSAGE
　　　　.cbSize = Len(TheData)
　　　End With
　　　Shell_NotifyIcon NIM_ADD, TheData 　
　　'根据前面定义NIM_ADD，设置为“添加模式”，然后添加 
　　　　　　2、删去图标With TheData
　　　　.UFlags = 0
End With 
Shell_NotifyIcon NIM_DELETE, TheData　　
'根据前面定义NIM_DELETE，设置为“删除模式” 
　　　 
　　　3、更改图标With TheData 
　　.HIcon = pic.Handle 　　　
　　'pic是图片狂PictureBox，存放图标文件
　　.UFlags = NIF_ICON
End With 
Shell_NotifyIcon NIM_MODIFY, TheData　
'根据前面定义NIM_MODIFY，设置为“更改模式” 
　　　 
　　　4、为图标添加浮动提示信息With TheData 
　　　　.SzTip = tip & vbNullChar　
　　　　　 'tip是字符串string，存储提示信息
　　　　.UFlags = NIF_TIP 　　
　　　　'指明要对浮动提示进行设置 
End With 
Shell_NotifyIcon NIM_MODIFY, TheData　
'根据前面定义NIM_MODIFY，设置为“修改模式”  
　　　　　通过以上几段代码我们就能根据自己需要添加、删除、更改系统托盘图标，并能添加系统图标上的浮动提示信息。但这时的托盘图标是孤立的，我们并不能利用它来控制应用程序的行为，怎么办呢？别急，请往下看……

Answer 3

如果你下载(源程序下载)并运行这个例程序，你会发现如果我们在托盘图标上点击鼠标右键，则会弹出一个右键菜单。如果点击相应的菜单项，程序主窗体会随之变化，这样就可以控制程序的行为。而如果当主窗体处于最小化状态时，我们在托盘图标上点击左键，窗体会恢复到原来的大小。其实实现上述的功能都要依赖于WINDOWS操作系统的消息机制，要完全弄懂这个机制挺不容易的，但是我们可以按下述文字来理解它。　　把WINDOWS操作系统看作人的大脑，它接收、处理、并发送各种各样的信息给我们的各个器官(当然是比喻各个应用程序了)，也就是说它是消息的中枢。而每个应用程序(甚至每一个按钮、标签、窗体等等统称为窗口)在运行时都会被分配一个窗口过程WINDOWPROC，由这个窗口过程来接收和处理操作系统发来的消息(实际上存在一个消息队列)，通常情况下这个窗口过程是由操作系统指定的，它会自动的响应并处理一些WINDOWS消息(如窗体移动、最大化、最小化、错误信息等)。好，到这我们先停一下，提出一个疑问，这些消息能否由我们自己写程序来处理呢？答案是肯定的，不过还得借助API函数的威力了，怎么用？我们还是先看看这些API函数的定义和参数吧。 　　程序中用到了SendMessage、CallWindowProc、SetWindowLong等API函数，其中SendMessage函数的作用是将一条消息发给某个窗口；CallWindowProc函数用来发送消息到一个窗口过程；而使用SetWindowLong函数来为窗口结构中为指定的窗口设置属性。使用API函数之前必须先在程序中声明如下：　Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal HWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long　Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal HWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long 　Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal HWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long  
　　　其中各参数的意义如下表: 　　CallWindowProc函数参数 意义 
lpPrevWndFunc  Long，原来的窗口过程地址 
HWnd Long，窗口句柄 
Msg Long，发送的消息 
wParam Long，消息类型，参考wParam参数表  
lParam Long，依据wParam参数的不同而不同  　　返回值 Long，依据发送的消息不同而变化 　　SetWindowLong函数 ： 参数 意义 
hwnd  Long，欲为其取得信息的窗口的句柄 
nIndex Long，请参考GetWindowLong函数的nIndex参数的说明 
dwNewLong Long，由nIndex指定的窗口信息的新值  　　返回值 Long，指定数据的前一个值 　　SendMessage函数 ： 参数 意义 
hwnd  Long，要接收消息的那个窗口的句柄 
wMsg Long，消息的标识符 
wParam Long，具体取决于消息 
lParam Any，具体取决于消息  　　返回值 Long，由具体的消息决定 
　　我们要自己写程序来处理消息，必须先更改窗口的属性，从原来由默认的窗口过程来处理消息变成由我们自己写的消息处理过程来处理消息。方法是使用SetWindowLong函数来取得默认窗口过程的地址，然后转向为我们自己写的窗口过程的地址，具体的实现方法如下代码：'GWL_WNDPROC获得该窗口的窗口过程的地址，AddressOf是取址函数，NewWindowProc是我们写的过程
OldWindowProc = SetWindowLong(frm.HWnd, GWL_WNDPROC, AddressOf 
　　　　　　　　　　　　　　　NewWindowProc) 
　 
　　然后在NewWindowProc函数中写入如下代码，需要注意的是下面代码中红色的TRAY_CALLBACK是由托盘区图标传来的消息，要让托盘图标传回消息，必须在添加托盘图标时指定：　　　Public Function NewWindowProc(ByVal HWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 
　　　'如果用户点击了托盘中的图标，则进行判断是点击了左键还是右键
　　　If Msg = TRAY_CALLBACK Then 
　　　　　'如果点击了左键 
　　　　　If lParam = WM_LBUTTONUP Then
　　　　　　　'而这时窗体的状态是最小化时 
　　　　　　　If TheForm.WindowState = vbMinimized Then _ 
　　　　　　　　'恢复到最小化前的窗体状态 
　　　　　　　　　　TheForm.WindowState = TheForm.LastState 
　　　　　　　　　　TheForm.SetFocus
　　　　　　　　　　Exit Function
　　　　　　　End If 
　　　　　End If 
　　　　　'如果点击了右键 
　　　　　If lParam = WM_RBUTTONUP Then 
　　　　　　　'则弹出右键菜单 
　　　　　　　TheForm.PopupMenu TheMenu 
　　　　　　　Exit Function 
　　　　　End If 
　　　End If 
　　　'如果是其他类型的消息则传递给原有默认的窗口函数
　　　NewWindowProc = CallWindowProc(OldWindowProc, HWnd, Msg, wParam, lParam) 
　　　End Function

Answer 4

程序说明:使用GetBitmapBits函数,将图片的颜色信息读到一个数组中,然后就对数组的数据进行扫描,使用CreateRectRgn函数生成每一个有用点的图窗体,再使用CombineRgn函数对有用的图象合并,组成所要的窗体,最后使用SetWindowRgn来设定窗体程序代码:
Module1Public Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As LongPublic Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As LongPublic Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As LongPublic Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As LongPublic Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As LongPublic Const RGN_OR = 2Public Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As LongPublic Type BITMAP '14 bytes
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End TypeDim bmByte() As BytePublic Declare Function ReleaseCapture Lib "user32" () As LongPublic Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long'Public Const WM_SYSCOMMAND = &H112
'Public Const SC_MOVE = &HF012
Public Const HTCAPTION = 2
Public Const WM_NCLBUTTONDOWN = &HA1Public Sub SetAutoRgn(hForm As Form, Optional transColor As Byte = vbNull)
Dim X As Long, Y As Long
Dim Rgn1 As Long, Rgn2 As Long
Dim SPos As Long, EPos As Long
Dim bm As BITMAP
Dim hbm As Long
Dim Wid As Long, Hgt As Long
Dim xoff As Long, yoff As Long
获取窗体背景图片尺寸hbm = hForm.Picture
GetObjectAPI hbm, Len(bm), bm
Wid = bm.bmWidth
Hgt = bm.bmHeightReDim bmByte(1 To Wid, 1 To Hgt)
GetBitmapBits hbm, Wid * Hgt, bmByte(1, 1) 获取图像数组如果没有传入transColor参数，则用第一个像素作为透明色If transColor = vbNull Then transColor = bmByte(1, 1)Rgn1 = CreateRectRgn(0, 0, 0, 0)For Y = 1 To Hgt 逐行扫描
X = 0
Do
X = X + 1While (bmByte(X, Y) = transColor) And (X < Wid)
X = X + 1 跳过是透明色的点
Wend
SPos = X
While (bmByte(X, Y) <> transColor) And (X < Wid)
X = X + 1 跳过不是透明色的点
Wend
EPos = X - 1'这一段是合并区域
If SPos <= EPos Then
Rgn2 = CreateRectRgn(SPos - 1, Y - 1, EPos, Y)
CombineRgn Rgn1, Rgn1, Rgn2, RGN_OR
DeleteObject Rgn2
End If
Loop Until X >= Wid
Next YSetWindowRgn hForm.hwnd, Rgn1, True 设定窗体形状区域
DeleteObject Rgn1End SubForm1Private Sub Form_Load()Form1.Left = Screen.Width / 2 - Form1.Width / 2
Form1.Top = Screen.Height / 2 - Form1.Height / 2If Me.Picture <> 0 Then Call SetAutoRgn(Me)End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
 
移动窗体
If Button = vbLeftButton Then
ReleaseCapture
SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&End If
End Sub