窗体中Option ExplicitPrivate Sub Form_Load() OldWindowProc = GetWindowLong(Me.hwnd, GWL_WNDPROC) Call SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf SubClass1_WndMessage)End SubPrivate Sub Form_Unload(Cancel As Integer) SetWindowLong Me.hwnd, GWL_WNDPROC, OldWindowProc End Sub模块中Option Explicit'## 通用 ####################################### '== Const ======================================'== Type ======================================= Public Type PointAPI X As Long Y As Long End Type'Public Type RECT ' Left As Long ' Top As Long ' Right As Long ' Bottom As Long 'End Type '## 硬件与系统函数 ############################# '== Fun ======================================== 'CopyMemory 复制内存 'timeGetTime 取得时间。单位为 微秒 'ZeroMemory 清空内存 Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Public Declare Function timeGetTime Lib "winmm.dll" () As Long Public Declare Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" (Destination As Any, ByVal Length As Long) '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Public Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As LongPrivate Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long Private Const CLR_INVALID = &HFFFFFFFF '如指定的点位于设备场景的剪切区之外,则返回CLR_INVALID Public OldWindowProc As Long Public Const GWL_WNDPROC = (-4)Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long'从指定的窗口结构中取得信息'参数/类型 说明'hwnd(long): 欲为其获取信息的窗口的句柄'nIndex(long): 欲取回的信息,可以是下述任何一个常数'GWL_EXSTYLE:扩展窗口样式'GWL_STYLE:窗口样式'GWL_WNDPROC:该窗口的窗口函数的地址'GWL_HINSTANCE:拥有窗口的实例的句柄'GWL_HWNDPARENT:该窗口之父的句柄.不要用 SetWindowWord 来改变这个值'GWL_ID:对话框中一个子窗口的标识符'GWL_USERDATA:含义由应用程序规定'对话框亦可指定下列常数'DWL_DLGPROC:这个窗口的对话框函数地址'DWL_MSGRESULT:在对话框函数中处理的一条消息返回的值'DWL_USER:含义由应用程序规定Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long'在窗体结构中为指定的窗口设置信息'参数/类型 说明'hwnd(long) 欲为其获取信息的窗口的句柄'nIndex(long) 参考GetWindowLong函数'dwNewLong(long) 由nIndex指定的窗口信息的新值 '这就是在VisualBasic中处理指针的"短柄斧"--CopyMemory.你可能在API文档中找不到它,但它确实存在,并且功能异常强大'参数/类型 说明'pDest 你想写入字节到其中的任何变量的ByRef参数(地址)'pSource 要从其中进行复制的ByRef变量'ByteLen 要复制的字节数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'把控制权传回给原来的窗口过程Public Const WM_GETMINMAXINFO = &H24' This is the structure that is passed by reference(ByRef)(ie an address) to your message handler(消息侦听器)' The key items in this structure are ptMinTrackSize and ptMaxTrackSizeType MINMAXINFO ptReserved As PointAPI ptMaxSize As PointAPI ptMaxPosition As PointAPI ptMinTrackSize As PointAPI ptMaxTrackSize As PointAPIEnd Type '== Const ====================================== '== Type ======================================= Public Function SubClass1_WndMessage(ByVal hwnd As Long, ByVal Msg As Long, ByVal wp As Long, ByVal lp As Long) As Long' Watch for the pertinent message to come in If Msg = WM_GETMINMAXINFO Then Dim MinMax As MINMAXINFO' This is necessary because the structure was passed by its address and there' is currently no intrinsic way to use an address in Visual Basic CopyMemory MinMax, ByVal lp, Len(MinMax)' This is where you set the values of the MinX,MinY,MaxX, and MaxY' The values placed in the structure must be in pixels. The values' normally used in Visual Basic are in twips. The conversion is as follows:' pixels = twips\twipsperpixel MinMax.ptMinTrackSize.X = 100 MinMax.ptMinTrackSize.Y = 50 'MinMax.ptMaxTrackSize.x = Screen.Width \ Screen.TwipsPerPixelX \ 2 'MinMax.ptMaxTrackSize.y = 3480 \ Screen.TwipsPerPixelY' Here we copy the datastructure back up to the address passed in the parameters' because Windows will look there for the information. CopyMemory ByVal lp, MinMax, Len(MinMax)' This message tells Windows that the message was handled successfully SubClass1_WndMessage = 1 Exit Function End If' Here, we forward all irrelevant messages on to the default message handler. SubClass1_WndMessage = CallWindowProc(OldWindowProc, hwnd, Msg, wp, lp)End Function
Private Sub Form_Resize() If Me.Width < 4000 Then Me.Width = 4000 If Me.Height < 4000 Then Me.Height = 4000End Sub
Private Sub Form_Resize() If Me.WindowState = vbMinimized Then Exit Sub If Me.Width < 4000 Then Me.Width = 4000 If Me.Height < 4000 Then Me.Height = 4000End Sub 最简单的
Dim OldW&, OldH& Private Sub Form_Load() OldW = Me.Width: OldH = Me.Height End SubPrivate Sub Form_Resize() Me.Width = OldW: Me.Height = OldH End Sub
'Load事件 '替换窗口过程 OldWindowProc = GetWindowLong(Me.hWnd, GWL_WNDPROC) Call SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf SubClass1_WndMessage)'UnLoad事件 还原窗口过程 Call SetWindowLong(Me.hWnd, GWL_WNDPROC, OldWindowProc) '模块代码 Public OldWindowProc As Long Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex 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 Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal ByteLen As Long) 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 Public Const WM_GETMINMAXINFO = &H24 Public Const GWL_WNDPROC = (-4)Type MINMAXINFO ptReserved As POINTAPI ptMaxSize As POINTAPI ptMaxPosition As POINTAPI ptMinTrackSize As POINTAPI ptMaxTrackSize As POINTAPI End TypePublic Function SubClass1_WndMessage(ByVal hWnd As Long, ByVal Msg As Long, ByVal wp As Long, ByVal lp As Long) As Long
'如果出现问题在这里加个判断。。比如最大化或者最小化时不执行以下代码 If Msg = WM_GETMINMAXINFO Then Dim MinMax As MINMAXINFO CopyMemory MinMax, ByVal lp, Len(MinMax)
OldWindowProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
Call SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf SubClass1_WndMessage)End SubPrivate Sub Form_Unload(Cancel As Integer)
SetWindowLong Me.hwnd, GWL_WNDPROC, OldWindowProc
End Sub模块中Option Explicit'## 通用 #######################################
'== Const ======================================'== Type =======================================
Public Type PointAPI
X As Long
Y As Long
End Type'Public Type RECT
' Left As Long
' Top As Long
' Right As Long
' Bottom As Long
'End Type
'## 硬件与系统函数 #############################
'== Fun ========================================
'CopyMemory 复制内存
'timeGetTime 取得时间。单位为 微秒
'ZeroMemory 清空内存
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function timeGetTime Lib "winmm.dll" () As Long
Public Declare Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" (Destination As Any, ByVal Length As Long)
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Public Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As LongPrivate Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Const CLR_INVALID = &HFFFFFFFF '如指定的点位于设备场景的剪切区之外,则返回CLR_INVALID
Public OldWindowProc As Long
Public Const GWL_WNDPROC = (-4)Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long'从指定的窗口结构中取得信息'参数/类型 说明'hwnd(long): 欲为其获取信息的窗口的句柄'nIndex(long): 欲取回的信息,可以是下述任何一个常数'GWL_EXSTYLE:扩展窗口样式'GWL_STYLE:窗口样式'GWL_WNDPROC:该窗口的窗口函数的地址'GWL_HINSTANCE:拥有窗口的实例的句柄'GWL_HWNDPARENT:该窗口之父的句柄.不要用 SetWindowWord 来改变这个值'GWL_ID:对话框中一个子窗口的标识符'GWL_USERDATA:含义由应用程序规定'对话框亦可指定下列常数'DWL_DLGPROC:这个窗口的对话框函数地址'DWL_MSGRESULT:在对话框函数中处理的一条消息返回的值'DWL_USER:含义由应用程序规定Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long'在窗体结构中为指定的窗口设置信息'参数/类型 说明'hwnd(long) 欲为其获取信息的窗口的句柄'nIndex(long) 参考GetWindowLong函数'dwNewLong(long) 由nIndex指定的窗口信息的新值
'这就是在VisualBasic中处理指针的"短柄斧"--CopyMemory.你可能在API文档中找不到它,但它确实存在,并且功能异常强大'参数/类型 说明'pDest 你想写入字节到其中的任何变量的ByRef参数(地址)'pSource 要从其中进行复制的ByRef变量'ByteLen 要复制的字节数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'把控制权传回给原来的窗口过程Public Const WM_GETMINMAXINFO = &H24' This is the structure that is passed by reference(ByRef)(ie an address) to your message handler(消息侦听器)' The key items in this structure are ptMinTrackSize and ptMaxTrackSizeType MINMAXINFO ptReserved As PointAPI ptMaxSize As PointAPI ptMaxPosition As PointAPI ptMinTrackSize As PointAPI ptMaxTrackSize As PointAPIEnd Type
'== Const ======================================
'== Type =======================================
Public Function SubClass1_WndMessage(ByVal hwnd As Long, ByVal Msg As Long, ByVal wp As Long, ByVal lp As Long) As Long' Watch for the pertinent message to come in If Msg = WM_GETMINMAXINFO Then Dim MinMax As MINMAXINFO' This is necessary because the structure was passed by its address and there' is currently no intrinsic way to use an address in Visual Basic CopyMemory MinMax, ByVal lp, Len(MinMax)' This is where you set the values of the MinX,MinY,MaxX, and MaxY' The values placed in the structure must be in pixels. The values' normally used in Visual Basic are in twips. The conversion is as follows:' pixels = twips\twipsperpixel MinMax.ptMinTrackSize.X = 100
MinMax.ptMinTrackSize.Y = 50 'MinMax.ptMaxTrackSize.x = Screen.Width \ Screen.TwipsPerPixelX \ 2 'MinMax.ptMaxTrackSize.y = 3480 \ Screen.TwipsPerPixelY' Here we copy the datastructure back up to the address passed in the parameters' because Windows will look there for the information. CopyMemory ByVal lp, MinMax, Len(MinMax)' This message tells Windows that the message was handled successfully SubClass1_WndMessage = 1 Exit Function End If' Here, we forward all irrelevant messages on to the default message handler. SubClass1_WndMessage = CallWindowProc(OldWindowProc, hwnd, Msg, wp, lp)End Function
MinMax.ptMinTrackSize.Y = 50
这两句就是限制最小的。
If Me.Width < 4000 Then Me.Width = 4000
If Me.Height < 4000 Then Me.Height = 4000End Sub
If Me.WindowState = vbMinimized Then Exit Sub
If Me.Width < 4000 Then Me.Width = 4000
If Me.Height < 4000 Then Me.Height = 4000End Sub
最简单的
Private Sub Form_Load()
OldW = Me.Width: OldH = Me.Height
End SubPrivate Sub Form_Resize()
Me.Width = OldW: Me.Height = OldH
End Sub
'Load事件
'替换窗口过程
OldWindowProc = GetWindowLong(Me.hWnd, GWL_WNDPROC)
Call SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf SubClass1_WndMessage)'UnLoad事件
还原窗口过程
Call SetWindowLong(Me.hWnd, GWL_WNDPROC, OldWindowProc)
'模块代码
Public OldWindowProc As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex 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 Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal ByteLen As Long)
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
Public Const WM_GETMINMAXINFO = &H24
Public Const GWL_WNDPROC = (-4)Type MINMAXINFO
ptReserved As POINTAPI
ptMaxSize As POINTAPI
ptMaxPosition As POINTAPI
ptMinTrackSize As POINTAPI
ptMaxTrackSize As POINTAPI
End TypePublic Function SubClass1_WndMessage(ByVal hWnd As Long, ByVal Msg As Long, ByVal wp As Long, ByVal lp As Long) As Long
'如果出现问题在这里加个判断。。比如最大化或者最小化时不执行以下代码 If Msg = WM_GETMINMAXINFO Then
Dim MinMax As MINMAXINFO
CopyMemory MinMax, ByVal lp, Len(MinMax)
'窗口最小
MinMax.ptMinTrackSize.x =500 '最小X
MinMax.ptMinTrackSize.y =500 '最小Y
'将这上下两组属性设置为一样的值就可以了保持固定大小了..单位为-像素 MinMax.ptMaxTrackSize.x =500 '最大X
MinMax.ptMaxTrackSize.y =500 '最大Y
CopyMemory ByVal lp, MinMax, Len(MinMax)
SubClass1_WndMessage = 1
Exit Function
End If
SubClass1_WndMessage = CallWindowProc(OldWindowProc, hWnd, Msg, wp, lp)
End Function'在窗口的Resize事件中固定根本不行。。地球人都知道会闪的。。难看。。
Private Sub Form_Load()
OldW = Me.Width: OldH = Me.Height
End SubPrivate Sub Form_Resize()
Me.Width = OldW: Me.Height = OldH
End Sub