mdlformsize.bas

来自「配置数据库参数 采用VB6.0 ADO+SQL Server 2000数据库实」· BAS 代码 · 共 43 行

Attribute VB_Name = "mdlFormSize"
Option Explicit

'API声明
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

'类型声明
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

Public OldWindowProc As Long

Public Function FormSize_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 = 760
    MinMax.ptMinTrackSize.y = 575
    MinMax.ptMaxTrackSize.x = 1024
    MinMax.ptMaxTrackSize.y = 768
    CopyMemory ByVal LP, MinMax, Len(MinMax)
    FormSize_WndMessage = 1
    Exit Function
  End If
  FormSize_WndMessage = CallWindowProc(OldWindowProc, hwnd, Msg, WP, LP)
End Function