窗体缩小到右下角

来源:cww 更改王国荣 Run PC 49期的文章

基本上, 窗体缩小後只能在「开始」功能表右边的工作列, 要缩到右下角要花功夫;
右下角的图示都不是窗体或程式, 对 Windows 来说, 它只是一个图示, 而想建立此
一图示, 方法是呼叫Shell_NotifyIconA API 函数

   Dim nid As NOTIFYICONDATA
   Call Shell_NotifyIconA(NIM_ADD, nid)


呼叫 Shell_NotifyIconA 之前, 必须间填好 NOTIFYICONDATA 资料结构(如以上的
nid 变数)的内容, 而 NOTIFYICONDATA 各资料成员的意义如下:

  1. cbSize:需填入 NOTIFYICONDATA 资料结构的长度。固定Len(nid)
  2. hWnd:handle of window, 指被缩小进来的Window。
  3. uID:使用者为图示所设定的 ID。可自订
  4. uFlags:用来设定以下三个叁数(uCallbackMessage、hIcon、szTip)是否
	     有效, 通常设定成 (NIF_MESSAGE + NIF_ICON + NIF_TIP) 表示全部有
	     效。NIF_MESSAGE :表示在Icon上面按Mouse时,会将讯息传给hWnd数所
	     指的Window Procedure,NIF_ICON表示要有ICON於右下方,NIF_TIP
	     表示Mouse移过去时会有Tip出现
  5. uCallbackMessage:将来使用者在图示上按下滑鼠时, Windows 会以讯息
		      通知视窗程序, 而此一叁数为讯息之编号。
  6. hIcon:图示。
  7. szTip:提示讯息。

该Function有一个传回值,如果呼叫成功传回1,否则传回 0

我使用一个NIcon的Class来解决这件事,另外还有一个NIcon.Bas要共同搭配,如果说
您不想让程式在执行AddNIcon时,仍显示窗体不隐藏,那您得修改一下AddNIcon,而若
真如此,可能您也不需要有NIF_MESSAGE的功能,也就不用那一段SubClass的功能了。

NIcon 的Initial设定
  m_MsgNo = WM_USER
  m_ID = 9999    注:使用者为图示所设定的 ID
  m_tip = Trim(Screen.ActiveForm.Caption) 窗体的Caption
  Set m_Form = Screen.ActiveForm
  m_hIcon = m_Form.Icon.Handle 窗体的Icon
  

AddNIcon(para_Form as Form) 来新增一个Icon於右下角
  para_Form指的是要被缩小的Form,当执行Shell_NotifyIconA(NIM_ADD, nid)成
  功时,表示已有图示於其上,所以我们将Form 隐藏,而什麽时候让Form再度出现呢?
  当我们在Icon上按一下Mouse左键时会出现,而这应该如做呢?方才说过,因NIF_MESSAGE
  的设定,使得在Icon上的Mosue Click等会传送nid.uCallbackMessage的讯息给
  nid.hWnd所在的Window Procedure,所以我们使用SubClass的动作,在NICON.BAS
  中的WndProcForIcon中,Check是否有我们定义的讯息出现,而进一步加以处理。

DelNIcon 来移除Icon,并取消SubClass的动作
ModNIcon 更动由AddNIcon所做出Icon的图示与Tip
MsgNo	 设定自WM_USER 起的第几个自订讯息,因我们程式说不定有其他自订讯息,
	 所以我们可以设定MsgNo,以便不和其他讯息混淆,MsgNo自0算起;指的是
	 nid..uCallbackMessage
Tip	 设定Tip
ID	 设定Icon一个唯一的ID以便和其他Icon区分,设定一次後,不要再更改
ICON	 设定Icon的图示

这里有几个重要的地方要提出来,首先,

这个程式原本同时只允许一个NIcon的产生,也就是一个程式不能有两个Icon缩於右下方
,这是因为用到SubClass的关系,如果我用们告PreWinProc为.Bas中的public变数来存
原先的Window Procedure的位址,如果现在有两个Icon想缩进右下方,则第二个缩进去
时,会把第一个所记录的PreWinProc给盖掉,那麽,等一下一定会当机。所以一个程式
想要有两个Icon进去,就必需是PrWinProc是属於NIcon.Cls的区域变数,所以每一个NIcon
的Instance有自己的PreWndProc变数,但这里有一个问题,在.BAS中又需要PreWndProc
当做叁数传给CallWindowProc以呼叫原来的Window Procdure,而们又没有办法传
NIcon.Cls的PreWndProc进入.Bas的 Function WndProcForIcon(因这个Function的格式
固定),此时,我们先在NIcon.Cls中定一个区域变数PreWndProc,再使用一个VB使用者
很少用到的技巧:在NIcon.AddNicon中有一行,用以记录这PreWndProc

        ret = SetWindowLong(m_Form.hWnd, GWL_USERDATA, preWndProc)

32位元的程式设计中,每个Window都会保留32Bits给Application运用,在此记录
preWndProc的值,而在.Bas中再以

     prevWndProcForIcon = GetWindowLong(hWnd, GWL_USERDATA)

取出原先存的值,或许会问,Form不是有个 Tag吗?是的,但是,我们在NIcon.Bas中,
能取得的只有hWnd,而得不到Form的Reference(如果我们同一程式有两个Form成Icon於
右下方,因二者都是用Function WndProcForIcon,这个CallBack Function,唯一能分别
由是Form1或Form2所引起的呼叫的,只有其上的hWnd)。

另外,使用这个Class,最怕的就是使用了setWindowLong更动原先Window Procedure的
位址,如果程式结束前没有将之设定回来,那程式不会正常结束,而要让程式能正常结
束,则一定要让DelNIcon能执行到,除了使用者直接呼叫之外,也可以不用管它,让
NIcon正常结束时,执行Terminate的程式,那里便会自动去呼叫DelNIcon,千万不要在呼
叫AddNicon(me)之後,未执行到DelNicon便下End 指令,那麽,程式一定会当,若要结束
,请用unload Form的方式来结束。最後,如果同一个程式有一个以上的Form要缩成Icon
,那所有的MsgNo要相同(这一点要求不会太过份),原因由.Bas的程式很清楚可见,IconMsg
是一个公用变数,为各个NIcon的Instance所共用,不允许随意更动。

以下文章在NIcon.cls
Option Explicit
 Private m_tip As String
 Private m_MsgNo As Long
 Private m_ID As Long
 Private m_hIcon As Long
 Private m_Icon As IPictureDisp
 Private m_Form As Form
 Private nid As NOTIFYICONDATA
 Private HadAdd As Boolean
 Private preWndProc As Long
 Public Property Get Tip() As String
 Tip = m_tip
 End Property

 '设定Mouse移至Icon时所show出之Tip
 Public Property Let Tip(ByVal vNewValue As String)
 m_tip = vNewValue
 End Property

 Public Property Get MsgNo() As Long
 MsgNo = m_MsgNo - WM_USER
 End Property
 '设定Mosue Click於Icon时,所送出之讯息编号
 Public Property Let MsgNo(ByVal vNewValue As Long)
 m_MsgNo = vNewValue + WM_USER
 End Property
 '设定ID
 Public Property Get ID() As Long
 ID = m_ID
 End Property

 Public Property Let ID(ByVal vNewValue As Long)
 m_ID = vNewValue
 End Property
 '设定Icon的图示
 Public Property Set Icon(ByVal vNewValue As IPictureDisp)
 Set m_Icon = vNewValue
 m_hIcon = m_Icon.Handle
 End Property
 '将原先的Form隐藏,并在右下方加入一个Icon,传入的是待处理的Form
 Public Function AddNIcon(ByVal para_form As Form) As Boolean
 Dim ret As Long
 AddNIcon = False
 If Not HadAdd Then
     Call Shell_NotifyIconA(NIM_DELETE, nid)
     Set m_Form = para_form
     nid.cbSize = Len(nid)
     nid.hWnd = m_Form.hWnd
     nid.uID = m_ID
     nid.uFlags = NIF_ICON + NIF_TIP + NIF_MESSAGE
     nid.hIcon = m_hIcon
     nid.szTip = m_tip + Chr(0)
     nid.uCallbackMessage = m_MsgNo
     Dim i As Integer
     i = Shell_NotifyIconA(NIM_ADD, nid)
     If i = 1 Then '新增成功
	IconMsg = m_MsgNo
	preWndProc = GetWindowLong(m_Form.hWnd, GWL_WNDPROC)
	'记录原先window procedure的Addr於Window的extra 32 bits,每个Window都会保留
	'32Bits给Application运用,在此记录preWndProc的值
	ret = SetWindowLong(m_Form.hWnd, GWL_USERDATA, preWndProc)
	ret = SetWindowLong(m_Form.hWnd, GWL_WNDPROC, AddressOf WndProcForIcon)
	m_Form.Hide  '如果不想加入时就隐藏form,这行请Mark,并在您的程式中自行决定何时Hide form
	AddNIcon = True
	HadAdd = True
     End If
 End If
 End Function

 '删除於右下方的Icon
 Public Sub DelNIcon()
  Dim ret As Long
  If preWndProc <> 0 Then
     ret = SetWindowLong(m_Form.hWnd, GWL_WNDPROC, preWndProc)
     preWndProc = 0
  End If
  If HadAdd Then
     Call Shell_NotifyIconA(NIM_DELETE, nid)
     HadAdd = False
     Set m_Form = Nothing
  End If
 End Sub
 '修改Icon的设定,能改的只有Icon的图与Icon的Tip
 Public Function ModNIcon() As Boolean
 ModNIcon = False
 If HadAdd Then
    nid.hIcon = m_hIcon
    nid.szTip = m_tip + Chr(0)
    Dim i
    i = Shell_NotifyIconA(NIM_MODIFY, nid)
    If i = 1 Then
       ModNIcon = True
    End If
 End If
 End Function

 Private Sub Class_Initialize()
 m_MsgNo = WM_USER
 m_ID = 9999
 m_tip = Trim(Screen.ActiveForm.Caption)
 Set m_Form = Screen.ActiveForm
 m_hIcon = m_Form.Icon.Handle
 HadAdd = False
 End Sub

 Private Sub Class_Terminate()
 Call DelNIcon
 End Sub

以下文在NIcon.Bas
 Public Const WM_USER = &H400
 Public Const GWL_WNDPROC = (-4)
 Public Const GWL_USERDATA = (-21)
 Public Const WM_LBUTTONDOWN = &H201
 Public Const NIM_ADD = 0
 Public Const NIM_MODIFY = 1
 Public Const NIM_DELETE = 2
 Public Const NIF_MESSAGE = 1
 Public Const NIF_ICON = 2
 Public Const NIF_TIP = 4
 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
 Public IconMsg As Long

 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 GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex 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
 Declare Function Shell_NotifyIconA Lib "SHELL32" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Integer

 Function WndProcForIcon(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
     Dim prevWndProcForIcon As Long
     '取回前一个Window procdure所在的位置,这个值是在Nicon.AddNicon中放进去的
     prevWndProcForIcon = GetWindowLong(hWnd, GWL_USERDATA)
     If Msg = IconMsg Then
	 If lParam = WM_LBUTTONDOWN Then
	    Dim mForm As Form
	    For Each mForm In Forms
		If mForm.hWnd = hWnd Then
		   mForm.Show
		End If
	    Next
	 End If
         '若您按Mosue右键或Double Click等,要执行什麽事,请在这里加进来
     End If
     WndProcForIcon = CallWindowProc(prevWndProcForIcon, hWnd, Msg, wParam, lParam)
 End Function
以下在Form
'执行时,请不要用强制结束的方式结束,要让NICON Class有机会执行到Terminate的Code
Private nid As New NIcon
Private Sub Command1_Click()
nid.Tip = "HaHa!!"
nid.ID = 9998 '若没设,会使用内订值9999
nid.MsgNo = 2 '若没设,内订0
Call nid.AddNIcon(Me)
End Sub

Private Sub Command2_Click()
nid.DelNIcon
End Sub

Private Sub Command3_Click()
'以下这一行可以修改成您所要的Icon後再unmark
'Set nid.Icon = LoadPicture("f:\vbprg\nicon\technlgy.ico")
nid.Tip = "Another Tip"
Call nid.ModNIcon
End Sub
'不要在Command1没有按下之前就按Command4
Private Sub Command4_Click()
Me.Hide '按了Command1後使之产生Icon於右下方,再於Icon处mouse Click
	'form会再出现,要让Form再度不见时,请直接执行me.hide
End Sub