.NET开发

本类阅读TOP10

·NHibernate快速指南(翻译)
·vs.net 2005中文版下载地址收藏
·【小技巧】一个判断session是否过期的小技巧
·VB/ASP 调用 SQL Server 的存储过程
·?dos下编译.net程序找不到csc.exe文件
·通过Web Services上传和下载文件
·学习笔记(补)《.NET框架程序设计(修订版)》--目录
·VB.NET实现DirectDraw9 (2) 动画
·VB.NET实现DirectDraw9 (1) 托管的DDraw
·建站框架规范书之——文件命名

分类导航
VC语言Delphi
VB语言ASP
PerlJava
Script数据库
其他语言游戏开发
文件格式网站制作
软件工程.NET开发
visual basic中设置窗体总在最底

作者:未知 来源:月光软件站 加入时间:2005-5-13 月光软件站

'Module1

Option Explicit

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Public Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Public Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Public Const GWL_WNDPROC = (-4&)

Public Const WM_WINDOWPOSCHANGING = &H46&

Public Type WINDOWPOS
        hwnd As Long
        hWndInsertAfter As Long
        x As Long
        y As Long
        cx As Long
        cy As Long
        flags As Long
End Type

Public Const HWND_BOTTOM = &H1&

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Public Function WinPropBag_ProcAddress(ByVal hwnd As Long, ByVal fStoreValue As Boolean, Optional ByVal lProcAddress As Long = 0, Optional ByVal fRemoveProp As Boolean = False) As Long
    If fStoreValue Then
        '保存属性
        SetProp hwnd, "MY_WINPROP_PROCADDRESS", lProcAddress
    Else
        '取出属性
        WinPropBag_ProcAddress = GetProp(hwnd, "MY_WINPROP_PROCADDRESS")
        If fRemoveProp Then
            '删除属性
            RemoveProp hwnd, "MY_WINPROP_PROCADDRESS"
        End If
    End If
   
End Function

Public Sub Subclassing(ByVal hWndTarget As Long, Optional ByVal fUnsubclassing As Boolean = False)
    If fUnsubclassing Then
        WinPropBag_ProcAddress hWndTarget, True, SetWindowLong(hWndTarget, GWL_WNDPROC, AddressOf MyWindowProc)
    Else
        SetWindowLong hWndTarget, GWL_WNDPROC, WinPropBag_ProcAddress(hwnd:=hWndTarget, fStoreValue:=False, fRemoveProp:=True)
    End If
End Sub

Public Function MyWindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If uMsg = WM_WINDOWPOSCHANGING Then
        '可以这样写
        Dim ut As WINDOWPOS
        CopyMemory ut, ByVal lParam, Len(ut)
        ut.hWndInsertAfter = HWND_BOTTOM
        CopyMemory ByVal lParam, ut, Len(ut)
        '也可以这接这样写
        'CopyMemory ByVal lParam + 4, HWND_BOTTOM, 4
    End If
    MyWindowProc = CallWindowProc(WinPropBag_ProcAddress(hwnd, False), hwnd, uMsg, wParam, lParam)
End Function

'Form1

Private Sub Form_Load()
    Subclassing Me.hwnd, True
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Subclassing Me.hwnd, False
End Sub




相关文章

相关软件