VB实现在窗口的标题栏上添加一个按钮的功能实现程序最小化到系统托盘.docx

1、VB实现在窗口的标题栏上添加一个按钮的功能实现程序最小化到系统托盘程序运行窗口1、复制以下程序段到记事本中另存为文件：Type=ExeReference=*G00020430-0000-0000-C000-000000000046#2.0#0#C:WINDOWSsystem32stdole2.tlb#OLE AutomationModule=TrayStartup=frmMainHelpFile=ExeName32=Project1.exePath32=.WINDOWSDesktopCommand32=Name=Project1HelpContextID=0CompatibleMode=0Ma

2、jorVer=1MinorVer=0RevisionVer=0AutoIncrementVer=0ServerSupportFiles=0VersionCompanyName=NoneCompilationType=0OptimizationType=0FavorPentiumPro(tm)=0CodeViewDebugInfo=0NoAliasing=0BoundsCheck=0OverflowCheck=0FlPointCheck=0FDIVCheck=0UnroundedFP=0StartMode=0Unattended=0Retained=0ThreadPerObject=0MaxNu

3、mberOfThreads=1MS Transaction ServerAutoRefresh=12、复制以下程序段到记事本中另存为文件：Begin VB.Form frmMain AutoRedraw = -1 True Caption = TitleBar Tray Button Demo ClientHeight = 2040 ClientLeft = 60 ClientTop = 345 ClientWidth = 4680 LinkTopic = Form1 ScaleHeight = 2040 ScaleWidth = 4680 StartUpPosition = 3 窗口缺省 B

4、egin VB.Menu mnuPopUp Caption = Visible = 0 False Begin VB.Menu mnuRestore Caption = Restore End EndEndAttribute VB_Name = frmMainAttribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = FalsePrivate Sub Form_Load() Print Right Click F

5、or Menu Me.ScaleMode = vbPixels The API works in pixels Hook Me FormHook Hook()End SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) If Button = 2 Then TrayMenu Me TrayNotify TrayMneu()End SubPrivate Sub Form_Unload(Cancel As Integer) UnHook FormHook UnHook

6、()End Sub3、复制以下程序段到记事本中另存为文件：Attribute VB_Name = ToolTipConst WS_EX_TOPMOST = &H8&Const TTS_ALWAYSTIP = &H1Const HWND_TOPMOST = -1Const SWP_NOACTIVATE = &H10Const SWP_NOMOVE = &H2Const SWP_NOSIZE = &H1Const WM_USER = &H400Const TTM_ADDTOOLA = (WM_USER + 4)Const TTF_SUBCLASS = &H10Declare Function Cr

7、eateWindowEx Lib user32 Alias CreateWindowExA (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As L

8、ong, lpParam As Any) As LongDeclare Function DestroyWindow Lib user32 (ByVal hwnd As Long) As LongDeclare Function SetWindowPos Lib user32 (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As LongPublic Dec

9、lare Function SendMessage Lib user32 Alias SendMessageA (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongType TOOLINFO cbSize As Long uFlags As Long hwnd As Long uid As Long RECT As RECT hinst As Long lpszText As String lParam As LongEnd TypePublic hWndTT As LongP

10、ublic Sub CreateTip(hwndForm As Long, szText As String, rct As RECT) hWndTT = CreateWindowEx(WS_EX_TOPMOST, tooltips_class32, , TTS_ALWAYSTIP, _ 0, 0, 0, 0, hwndForm, 0&, App.hInstance, 0&) SetWindowPos hWndTT, HWND_TOPMOST, 0, 0, 0, 0, _ SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE Dim TI As TOOLINFO

11、 With TI .cbSize = Len(TI) .uFlags = TTF_SUBCLASS .hwnd = hwndForm .uid = 1& .lpszText = szText & vbNullChar .RECT = rct End With SendMessage hWndTT, TTM_ADDTOOLA, 0, TIEnd SubPublic Sub KillTip() DestroyWindow hWndTTEnd Sub4、复制以下程序段到记事本中另存为文件：Attribute VB_Name = DrawButtonDeclare Function GetWindow

12、DC Lib user32 (ByVal hwnd As Long) As LongDeclare Function DrawFrameControl Lib user32 (ByVal hdc As Long, lpRect As RECT, ByVal un1 As Long, ByVal un2 As Long) As LongDeclare Function GetTitleBarInfo Lib user32 (ByVal hwnd As Long, pti As TitleBarInfo) As BooleanDeclare Function FillRect Lib user32

13、 (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As LongDeclare Function GetSysColorBrush Lib user32 (ByVal nIndex As Long) As LongDeclare Function OffsetRect Lib user32 (lpRect As RECT, ByVal x As Long, ByVal y As Long) As LongType RECT Left As Long Top As Long Right As Long Bottom As Lon

14、gEnd TypeType TitleBarInfo cbSize As Long rcTitleBar As RECT A RECT structure that receives the coordinates of the title bar rgState(5) As Long An array that receives a DWORD value for each element of the title barEnd Type rgState array Values 0 The titlebar Itself 1 Reserved 2 Min button 3 Max butt

15、on 4 Help button 5 Close button rgstate return constatnts STATE_SYSTEM_FOCUSABLE = &H00100000 STATE_SYSTEM_INVISIBLE = &H00008000 STATE_SYSTEM_OFFSCREEN = &H00010000 STATE_SYSTEM_PRESSED = &H00000008 STATE_SYSTEM_UNAVAILABLE = &H00000001 Const DFC_BUTTON = 4Const DFCS_BUTTONPUSH = &H10Const DFCS_PUS

16、HED = &H200Declare Function GetSystemMetrics Lib user32 (ByVal nIndex As Long) As LongPublic Declare Function PtInRect Lib user32 (lpRect As RECT, ByVal x As Long, ByVal y As Long) As LongPublic Declare Function GetCursorPos Lib user32 (lpPoint As POINTAPI) As LongPublic Type POINTAPI x As Long y As

17、 LongEnd TypeConst SM_CXFRAME = 32 Const COLOR_BTNTEXT = 18Dim lDC As LongPublic R As RECTPublic Sub ButtonDraw(frm As Form, bState As Boolean) Dim TBButtons As Integer Dim TBarHeight As Integer Dim TBButtonHeight As Integer Dim TBButtonWidth As Integer Dim DrawWidth As Integer Dim TBI As TitleBarIn

18、fo Dim TBIRect As RECT Dim bRslt As Boolean Dim WinBorder As Integer With frm If .BorderStyle = 0 Then Exit Sub Dont draw a button if there is no titlebar -How Many Buttons in TitleBar- If Not .ControlBox Then TBButtons = 0 If .ControlBox Then TBButtons = 1 If .ControlBox And .WhatsThisButton Then I

19、f .BorderStyle 4 Then TBButtons = 2 Else tButtons = 1 End If End If If .ControlBox And .MinButton And .BorderStyle = 2 Then TBButtons = 3 If .ControlBox And .MinButton And .BorderStyle = 5 Then TBButtons = 1 If .ControlBox And .MaxButton And .BorderStyle = 2 Then TBButtons = 3 If .ControlBox And .Ma

20、xButton And .BorderStyle = 5 Then TBButtons = 1 - -Get height of Titlebar- Using this method gets the height of the titlebar regardless of the window style. It does, however, restrict its use to Win98/2000. So if you want to use this code in Win95, then call GetSystemMetrics to find the windowstyle

21、and titlebar size. TBI.cbSize = Len(TBI) bRslt = GetTitleBarInfo(.hwnd, TBI) TBarHeight = TBIRect.Bottom - TBIRect.Top - 1 - -Get WindowBorder Size- If .BorderStyle = 2 Or .BorderStyle = 5 Then R.Top = GetSystemMetrics(32) + 2 WinBorder = R.Top - 6 Else R.Top = 5 WinBorder = -1 End If End With - -Us

22、e Titlebar Height to determin button size- TBButtonHeight = TBarHeight - 4 TBButtonWidth = TBButtonHeight + 2 and the size and space of the dot on the button DrawWidth = TBarHeight / 8 - -Determin the position of our button- R.Bottom = R.Top + TBButtonHeight Select Case TBButtons Case 1 R.Right = fr

23、m.ScaleWidth - (TBButtonWidth) + WinBorder Case 2 R.Right = frm.ScaleWidth - (TBButtonWidth * 2) + 2) + WinBorder Case 3 R.Right = frm.ScaleWidth - (TBButtonWidth * 3) + 2) + WinBorder Case Else End Select R.Left = R.Right - TBButtonWidth - -Get the Widow DC so that we may draw in the title bar- lDC

24、 = GetWindowDC(frm.hwnd) - -Determin the position of the dot- Dim StartXY As Integer, EndXY As Integer Select Case TBarHeight Case Is 20 StartXY = DrawWidth + 1 EndXY = DrawWidth - 1 Case Else StartXY = (DrawWidth * 2) EndXY = DrawWidth End Select - -We have all the information we need So Draw the b

25、utton- Dim rDot As RECT If bState Then DrawFrameControl lDC, R, DFC_BUTTON, DFCS_BUTTONPUSH Or DFCS_PUSHED rDot.Left = R.Right - (1 + StartXY): rDot.Top = R.Bottom - (1 + StartXY) rDot.Right = R.Right - (1 + EndXY): rDot.Bottom = R.Bottom - (1 + EndXY) Else DrawFrameControl lDC, R, DFC_BUTTON, DFCS_

26、BUTTONPUSH rDot.Left = R.Right - (2 + StartXY): rDot.Top = R.Bottom - (2 + StartXY) rDot.Right = R.Right - (2 + EndXY): rDot.Bottom = R.Bottom - (2 + EndXY) End If FillRect lDC, rDot, GetSysColorBrush(COLOR_BTNTEXT) - -Set Tooltip- Dim TTRect As RECT TTRect.Bottom = R.Bottom + (TBarHeight - (TBarHei

27、ght * 2) + WinBorder + 5) TTRect.Left = R.Left - (4 - WinBorder) TTRect.Right = R.Right - (4 - WinBorder) TTRect.Top = R.Top + (TBarHeight - (TBarHeight * 2) + WinBorder + 5) KillTip ToolTip KillTip() CreateTip appForm.hwnd, System Tray, TTRect ToolTip CreateTip()End Sub5、复制以下程序段到记事本中另存为文件：Attribute VB_Name = TrayNotifyDeclare Function Shell_NotifyIcon Lib shell32.dll Alias Shell_NotifyIconA (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As LongDeclare Function CreatePopupMenu Lib us