mdlbase.bas

这是好东西南的,大家快来看看呀,对于有C语言编程的的有好大的帮助

Attribute VB_Name = "mdlBase"
'*************************************************************************
'**模 块 名：mdlBase
'**说    明：YFsoft YFsoft 叶帆Blog:http://blog.csdn.net/yefanqiu/
'**创 建 人：叶帆
'**日    期：2004-12-14 09:32:06
'**修 改 人：
'**日    期：
'**描    述：控件公用的模块
'**版    本：V1.0.0
'*************************************************************************
Option Explicit
'向窗口进程发送消息
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

Public Const WM_SYSCOMMAND = &H112
Public Const SC_MOVE = &HF010&
Public Const SC_RESTORE = &HF120&
Public Const SC_SIZE = &HF000&
Public Const SWP_NOMOVE = 2
Public Const SWP_NOSIZE = 1
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public Const WM_LBUTTONDOWN = &H201

Public OldLeft As Single, OldTop As Single              '移动窗体位置时的辅助参数
Public OldWindowProc As Long       '旧的窗口进程号
Public TheWnd As Long
Public intFlag As Integer

'将消息传答窗口函数
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
'发送修改任务栏图标
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

Public Const WM_USER = &H400
Public Const WM_LBUTTONUP = &H202
Public Const WM_MBUTTONUP = &H208
Public Const WM_RBUTTONUP = &H205
Public Const TRAY_CALLBACK = (WM_USER + 1001&)
Public Const GWL_WNDPROC = (-4)
Public Const GWL_USERDATA = (-21)
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIF_MESSAGE = &H1
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2

Public Type NOTIFYICONDATA      'ICON图标数据信息
    cbSize As Long
    hwnd As Long
    uID As Long
    uFlags As Long
    uCallbackMessage As Long
    hIcon As Long
    szTip As String * 64
End Type

Private TheData As NOTIFYICONDATA

#If Win16 Then
    Declare Sub SetWindowPos Lib "User" (ByVal hwnd As Integer, ByVal hWndInsertAfter As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal cx As Integer, ByVal CY As Integer, ByVal wFlags As Integer)
#Else
    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
#End If

Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName _
        As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, _
        ByVal nSize As Long, ByVal lpFileName As String) As Long
 
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal _
        lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long

Public Const HTCAPTION = 2
Public Const WM_NCLBUTTONDOWN = &HA1
Public Declare Function ReleaseCapture Lib "user32" () As Long

Public Const GW_CHILD = 5
Public Const CW_HWNDNEXT = 2

'获得窗口的句柄
Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
'获得窗口的类
Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public Declare Function GetFocus Lib "user32" () As Long
Public Declare Function GetForegroundWindow Lib "user32" () As Long
Public Declare Function SetActiveWindow Lib "user32" (ByVal hwnd As Long) As Long

' *********************************************
' 新的窗口进程
' *********************************************
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  '单击左键显示窗体
            intFlag = 1
            RemoveFromTray  '清除托盘内的图标
            Exit Function
        End If

        If lParam = WM_RBUTTONUP Then  '单击右键键显示菜单
            intFlag = 2
            Exit Function
        End If
    End If

    '发送其余的消息到原先的窗口信息处理进程
    NewWindowProc = CallWindowProc(OldWindowProc, hwnd, Msg, wParam, lParam)
End Function

' *********************************************
' 在托盘中增加窗体的图标
' *********************************************
Public Sub AddToTray(hwnd As Long, pic As Picture)
    '必须在设计状态下设置ShowInTaskbar为false，因为在运行状态下该属性只读。

    ' 保存当前窗体和菜单信息
    TheWnd = hwnd
    
    ' 设置新的窗口信息处理进程             '窗口进程        '窗口进程地址
    OldWindowProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf NewWindowProc)
    
    ' 设置窗体图标的信息
    With TheData
        .uID = 0
        .hwnd = hwnd
        .cbSize = Len(TheData)
        .hIcon = pic.Handle
        .uFlags = NIF_ICON
        .uCallbackMessage = TRAY_CALLBACK
        .uFlags = .uFlags Or NIF_MESSAGE
        .cbSize = Len(TheData)
    End With
    
    '把图标放到图盘
    Shell_NotifyIcon NIM_ADD, TheData
End Sub
' *********************************************
' 删除托盘内的图标
' *********************************************
Public Sub RemoveFromTray()
    '删除托盘内的图标
    With TheData
        .uFlags = 0
    End With
    Shell_NotifyIcon NIM_DELETE, TheData
    
    ' 恢复原来窗口信息处理进程.
    SetWindowLong TheWnd, GWL_WNDPROC, OldWindowProc
End Sub
' *********************************************
' 设置新的托盘图标提示
' *********************************************
Public Sub SetTrayTip(tip As String)
    With TheData
        .szTip = tip & vbNullChar
        .uFlags = NIF_TIP
    End With
    Shell_NotifyIcon NIM_MODIFY, TheData
End Sub
' *********************************************
' 设置新的托盘图标
' *********************************************
Public Sub SetTrayIcon(pic As Picture)
    ' 如果图片的格式不是ICON类型，则退出
    If pic.Type <> vbPicTypeIcon Then Exit Sub

    '更新托盘图标
    With TheData
        .hIcon = pic.Handle
        .uFlags = NIF_ICON
    End With
    Shell_NotifyIcon NIM_MODIFY, TheData
End Sub