formsizehook.bas

电话本信息 基本上实现电话功能 自己下载侃侃吧

Attribute VB_Name = "FormSizeHook"
Option Explicit

Type POINTAPI
     X As Long
     Y As Long
End Type

Type MINMAXINFO
     ptReserved As POINTAPI
     ptMaxSize As POINTAPI
     ptMaxPosition As POINTAPI
     ptMinTrackSize As POINTAPI
     ptMaxTrackSize As POINTAPI
End Type

Private 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
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal ByteLen As Long)

Public Const GWL_WNDPROC = (-4)
Public Const WM_GETMINMAXINFO = &H24

Dim theOldWinProc As Long
Dim mhWnd As Long

'==================================================
'回调函数，拦截窗体尺寸改变信息
Function theNewWinProc(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
                  
    Select Case wMsg
        Case WM_GETMINMAXINFO
            Dim MinMax As MINMAXINFO

            CopyMemory MinMax, ByVal lParam, Len(MinMax)

            MinMax.ptMinTrackSize.X = 800
            MinMax.ptMinTrackSize.Y = 574
'            MinMax.ptMaxTrackSize.x = 808
'            MinMax.ptMaxTrackSize.y = 250

            CopyMemory ByVal lParam, MinMax, Len(MinMax)

            theNewWinProc& = 1
            Exit Function
    End Select

    theNewWinProc = CallWindowProc(theOldWinProc, hwnd, wMsg, wParam, lParam)
End Function
'==================================================


'==================================================
'HOOK挂钩
Sub LockFormSize(ByVal nhWnd As Long)
    If theOldWinProc <> 0 Then Exit Sub
    mhWnd = nhWnd
    theOldWinProc = SetWindowLong(nhWnd, GWL_WNDPROC, AddressOf theNewWinProc)
End Sub
'==================================================


'==================================================
'HOOK脱钩
Sub UnLockFormSize()
    If theOldWinProc = 0 Then Exit Sub
    SetWindowLong mhWnd, GWL_WNDPROC, theOldWinProc
    theOldWinProc = 0
End Sub
'==================================================