VB实现在窗口的标题栏上添加一个按钮的功能实现程序最小化到系统托盘.docx
《VB实现在窗口的标题栏上添加一个按钮的功能实现程序最小化到系统托盘.docx》由会员分享，可在线阅读，更多相关《VB实现在窗口的标题栏上添加一个按钮的功能实现程序最小化到系统托盘.docx（19页珍藏版）》请在冰豆网上搜索。
VB实现在窗口的标题栏上添加一个按钮的功能实现程序最小化到系统托盘
程序运行窗口
1、复制以下程序段到记事本中另存为文件：
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:
\WINDOWS\system32\stdole2.tlb#OLEAutomation
Module=Tray
Startup="frmMain"
HelpFile=""
ExeName32="Project1.exe"
Path32="..\..\..\..\..\..\WINDOWS\Desktop"
Command32=""
Name="Project1"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="None"
CompilationType=0
OptimizationType=0
FavorPentiumPro（tm）=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
[MSTransactionServer]
AutoRefresh=1
2、复制以下程序段到记事本中另存为文件：
BeginVB.FormfrmMain
AutoRedraw=-1'True
Caption="TitleBarTrayButtonDemo"
ClientHeight=2040
ClientLeft=60
ClientTop=345
ClientWidth=4680
LinkTopic="Form1"
ScaleHeight=2040
ScaleWidth=4680
StartUpPosition=3'窗口缺省
BeginVB.MenumnuPopUp
Caption=""
Visible=0'False
BeginVB.MenumnuRestore
Caption="Restore"
End
End
End
AttributeVB_Name="frmMain"
AttributeVB_GlobalNameSpace=False
AttributeVB_Creatable=False
AttributeVB_PredeclaredId=True
AttributeVB_Exposed=False
PrivateSubForm_Load（）
Print"RightClickForMenu"
Me.ScaleMode=vbPixels'TheAPIworksinpixels
HookMe'FormHookHook（）
EndSub
PrivateSubForm_MouseDown（ButtonAsInteger,ShiftAsInteger,xAsSingle,yAsSingle）
IfButton=2ThenTrayMenuMe'TrayNotifyTrayMneu（）
EndSub
PrivateSubForm_Unload（CancelAsInteger）
UnHook'FormHookUnHook（）
EndSub
3、复制以下程序段到记事本中另存为文件：
AttributeVB_Name="ToolTip"
ConstWS_EX_TOPMOST=&H8&
ConstTTS_ALWAYSTIP=&H1
ConstHWND_TOPMOST=-1
ConstSWP_NOACTIVATE=&H10
ConstSWP_NOMOVE=&H2
ConstSWP_NOSIZE=&H1
ConstWM_USER=&H400
ConstTTM_ADDTOOLA=（WM_USER+4）
ConstTTF_SUBCLASS=&H10
DeclareFunctionCreateWindowExLib"user32"Alias"CreateWindowExA"（ByValdwExStyleAsLong,ByVallpClassNameAsString,ByVallpWindowNameAsString,ByValdwStyleAsLong,ByValxAsLong,ByValyAsLong,ByValnWidthAsLong,ByValnHeightAsLong,ByValhWndParentAsLong,ByValhMenuAsLong,ByValhInstanceAsLong,lpParamAsAny）AsLong
DeclareFunctionDestroyWindowLib"user32"（ByValhwndAsLong）AsLong
DeclareFunctionSetWindowPosLib"user32"（ByValhwndAsLong,ByValhWndInsertAfterAsLong,ByValxAsLong,ByValyAsLong,ByValcxAsLong,ByValcyAsLong,ByValwFlagsAsLong）AsLong
PublicDeclareFunctionSendMessageLib"user32"Alias"SendMessageA"（ByValhwndAsLong,ByValwMsgAsLong,ByValwParamAsLong,lParamAsAny）AsLong
TypeTOOLINFO
cbSizeAsLong
uFlagsAsLong
hwndAsLong
uidAsLong
RECTAsRECT
hinstAsLong
lpszTextAsString
lParamAsLong
EndType
PublichWndTTAsLong
PublicSubCreateTip（hwndFormAsLong,szTextAsString,rctAsRECT）
hWndTT=CreateWindowEx（WS_EX_TOPMOST,"tooltips_class32","",TTS_ALWAYSTIP,_
0,0,0,0,hwndForm,0&,App.hInstance,0&）
SetWindowPoshWndTT,HWND_TOPMOST,0,0,0,0,_
SWP_NOMOVEOrSWP_NOSIZEOrSWP_NOACTIVATE
DimTIAsTOOLINFO
WithTI
.cbSize=Len（TI）
.uFlags=TTF_SUBCLASS
.hwnd=hwndForm
.uid=1&
.lpszText=szText&vbNullChar
.RECT=rct
EndWith
SendMessagehWndTT,TTM_ADDTOOLA,0,TI
EndSub
PublicSubKillTip（）
DestroyWindowhWndTT
EndSub
4、复制以下程序段到记事本中另存为文件：
AttributeVB_Name="DrawButton"
DeclareFunctionGetWindowDCLib"user32"（ByValhwndAsLong）AsLong
DeclareFunctionDrawFrameControlLib"user32"（ByValhdcAsLong,lpRectAsRECT,ByValun1AsLong,ByValun2AsLong）AsLong
DeclareFunctionGetTitleBarInfoLib"user32"（ByValhwndAsLong,ptiAsTitleBarInfo）AsBoolean
DeclareFunctionFillRectLib"user32"（ByValhdcAsLong,lpRectAsRECT,ByValhBrushAsLong）AsLong
DeclareFunctionGetSysColorBrushLib"user32"（ByValnIndexAsLong）AsLong
DeclareFunctionOffsetRectLib"user32"（lpRectAsRECT,ByValxAsLong,ByValyAsLong）AsLong
TypeRECT
LeftAsLong
TopAsLong
RightAsLong
BottomAsLong
EndType
TypeTitleBarInfo
cbSizeAsLong
rcTitleBarAsRECT'ARECTstructurethatreceivesthecoordinatesofthetitlebar
rgState（5）AsLong'AnarraythatreceivesaDWORDvalueforeachelementofthetitlebar
EndType
'rgStatearrayValues
'0ThetitlebarItself
'1Reserved
'2Minbutton
'3Maxbutton
'4Helpbutton
'5Closebutton
'
'rgstatereturnconstatnts
'STATE_SYSTEM_FOCUSABLE=&H00100000
'STATE_SYSTEM_INVISIBLE=&H00008000
'STATE_SYSTEM_OFFSCREEN=&H00010000
'STATE_SYSTEM_PRESSED=&H00000008
'STATE_SYSTEM_UNAVAILABLE=&H00000001
ConstDFC_BUTTON=4
ConstDFCS_BUTTONPUSH=&H10
ConstDFCS_PUSHED=&H200
DeclareFunctionGetSystemMetricsLib"user32"（ByValnIndexAsLong）AsLong
PublicDeclareFunctionPtInRectLib"user32"（lpRectAsRECT,ByValxAsLong,ByValyAsLong）AsLong
PublicDeclareFunctionGetCursorPosLib"user32"（lpPointAsPOINTAPI）AsLong
PublicTypePOINTAPI
xAsLong
yAsLong
EndType
ConstSM_CXFRAME=32
ConstCOLOR_BTNTEXT=18
DimlDCAsLong
PublicRAsRECT
PublicSubButtonDraw（frmAsForm,bStateAsBoolean）
DimTBButtonsAsInteger
DimTBarHeightAsInteger
DimTBButtonHeightAsInteger
DimTBButtonWidthAsInteger
DimDrawWidthAsInteger
DimTBIAsTitleBarInfo
DimTBIRectAsRECT
DimbRsltAsBoolean
DimWinBorderAsInteger
Withfrm
If.BorderStyle=0ThenExitSub'Don'tdrawabuttonifthereisnotitlebar
'----HowManyButtonsinTitleBar------------------------------------------
IfNot.ControlBoxThenTBButtons=0
If.ControlBoxThenTBButtons=1
If.ControlBoxAnd.WhatsThisButtonThen
If.BorderStyle<4Then
TBButtons=2
Else
tButtons=1
EndIf
EndIf
If.ControlBoxAnd.MinButtonAnd.BorderStyle=2ThenTBButtons=3
If.ControlBoxAnd.MinButtonAnd.BorderStyle=5ThenTBButtons=1
If.ControlBoxAnd.MaxButtonAnd.BorderStyle=2ThenTBButtons=3
If.ControlBoxAnd.MaxButtonAnd.BorderStyle=5ThenTBButtons=1
'------------------------------------------------------------------------
'----GetheightofTitlebar----------------------------------------------
'Usingthismethodgetstheheightofthetitlebarregardlessofthewindow
'style.Itdoes,however,restrictitsusetoWin98/2000.Soifyouwantto
'usethiscodeinWin95,thencallGetSystemMetricstofindthewindowstyle
'andtitlebarsize.
TBI.cbSize=Len（TBI）
bRslt=GetTitleBarInfo（.hwnd,TBI）
TBarHeight=TBIRect.Bottom-TBIRect.Top-1
'-----------------------------------------------------------------------
'----GetWindowBorderSize----------------------------------------------
If.BorderStyle=2Or.BorderStyle=5Then
R.Top=GetSystemMetrics（32）+2
WinBorder=R.Top-6
Else
R.Top=5
WinBorder=-1
EndIf
EndWith
'---------------------------------------------------------------------------
'----UseTitlebarHeighttodeterminbuttonsize----------------------------
TBButtonHeight=TBarHeight-4
TBButtonWidth=TBButtonHeight+2
'andthesizeandspaceofthedotonthebutton
DrawWidth=TBarHeight/8
'---------------------------------------------------------------------------
'----Determinthepositionofourbutton------------------------------------
R.Bottom=R.Top+TBButtonHeight
SelectCaseTBButtons
Case1
R.Right=frm.ScaleWidth-（TBButtonWidth）+WinBorder
Case2
R.Right=frm.ScaleWidth-（（TBButtonWidth*2）+2）+WinBorder
Case3
R.Right=frm.ScaleWidth-（（TBButtonWidth*3）+2）+WinBorder
CaseElse
EndSelect
R.Left=R.Right-TBButtonWidth
'--------------------------------------------------------------------------
'----GettheWidowDCsothatwemaydrawinthetitlebar-----------------
lDC=GetWindowDC（frm.hwnd）
'--------------------------------------------------------------------------
'----Determinthepositionofthedot--------------------------------------
DimStartXYAsInteger,EndXYAsInteger
SelectCaseTBarHeight
CaseIs<20
StartXY=DrawWidth+1
EndXY=DrawWidth-1
CaseElse
StartXY=（DrawWidth*2）
EndXY=DrawWidth
EndSelect
'--------------------------------------------------------------------------
'----WehavealltheinformationweneedSoDrawthebutton----------------
DimrDotAsRECT
IfbStateThen
DrawFrameControllDC,R,DFC_BUTTON,DFCS_BUTTONPUSHOrDFCS_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
DrawFrameControllDC,R,DFC_BUTTON,DFCS_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）
EndIf
FillRectlDC,rDot,GetSysColorBrush（COLOR_BTNTEXT）
'---------------------------------------------------------------------------
'----SetTooltip------------------------------------------------------------
DimTTRectAsRECT
TTRect.Bottom=R.Bottom+（TBarHeight-（（TBarHeight*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'ToolTipKillTip（）
CreateTipappForm.hwnd,"SystemTray",TTRect'ToolTipCreateTip（）
EndSub
5、复制以下程序段到记事本中另存为文件：
AttributeVB_Name="TrayNotify"
DeclareFunctionShell_NotifyIconLib"shell32.dll"Alias"Shell_NotifyIconA"（ByValdwMessageAsLong,lpDataAsNOTIFYICONDATA）AsLong
DeclareFunctionCreatePopupMenuLib"us
升级会员 