程序运行窗口
1、复制以下程序段到记事本中另存为文件：
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\system32\stdole2.tlb#OLE Automation
Module=Tray
Startup="frmMain"
HelpFile=""
ExeName32=""
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
[MS Transaction Server]
AutoRefresh=1


2、复制以下程序段到记事本中另存为文件：
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  '窗口缺省
  Begin VB.Menu mnuPopUp
      Caption        =  ""
      Visible        =  0  'False
      Begin VB.Menu mnuRestore
        Caption        =  "Restore"
      End
  End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Form_Load()
    Print "Right Click For Menu"
    Me.ScaleMode = vbPixels 'The API works in pixels
    Hook Me 'FormHook Hook()
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 2 Then TrayMenu Me  'TrayNotify TrayMneu()
End Sub
Private Sub Form_Unload(Cancel As Integer)
    UnHook 'FormHook UnHook()
End Sub

3、复制以下程序段到记事本中另存为文件：
Attribute VB_Name = "ToolTip"
Const WS_EX_TOPMOST = &H8&
Const TTS_ALWAYSTIP = &H1
Const HWND_TOPMOST = -1
Const SWP_NOACTIVATE = &H10
Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1
Const WM_USER = &H400
Const TTM_ADDTOOLA = (WM_USER + 4)
Const TTF_SUBCLASS = &H10
Declare Function CreateWindowEx 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 Long, lpParam As Any) As Long
Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Declare 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 Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Type TOOLINFO
    cbSize As Long
    uFlags As Long
    hwnd As Long
    uid As Long
    RECT As RECT
    hinst As Long
    lpszText As String
    lParam As Long
End Type
Public hWndTT As Long
Public 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
   
    With TI
        .cbSize = Len(TI)
        .uFlags = TTF_SUBCLASS
        .hwnd = hwndForm
        .uid = 1&
        .lpszText = szText & vbNullChar
        .RECT = rct
htmlborder
    End With
   
    SendMessage hWndTT, TTM_ADDTOOLA, 0, TI
End Sub
Public Sub KillTip()
    DestroyWindow hWndTT
End Sub

4、复制以下程序段到记事本中另存为文件：
Attribute VB_Name = "DrawButton"
Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function DrawFrameControl Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal un1 As Long, ByVal un2 As Long) As Long
Declare Function GetTitleBarInfo Lib "user32" (ByVal hwnd As Long, pti As TitleBarInfo) As Boolean
Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Declare Function GetSysColorBrush Lib "user32" (ByVal nIndex As Long) As Long
Declare Function OffsetRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。