这段vb函数代码如何转换为delphi代码(关于api callwindowproc)
lrest 2004-10-05 11:21:13 '此函数能够同时控制任意窗体的最大宽、高度.
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes&)
Private Declare Function CallWindowProc& Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc&, ByVal hwnd&, ByVal Msg&, ByVal wParam&, ByVal lParam&)
Private Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" (ByVal hwnd&, ByVal nIndex&, ByVal dwNewLong&)
' Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type MINMAXINFO
ptReserved As POINTAPI
ptMaxSize As POINTAPI
ptMaxPosition As POINTAPI
ptMinTrackSize As POINTAPI
ptMaxTrackSize As POINTAPI
End Type
Public procOld As Long
Private udtMMI As MINMAXINFO
Private SaveOldproc As New Collection
Const GWL_WNDPROC = -4
Private Function LockWindowProc(ByVal hwnd As Long, ByVal iMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case iMsg
Case &H24 'WM_GETMINMAXINFO=&H24
Dim udtMINMAXINFO As MINMAXINFO
'动态查找当前窗体的最在宽、高度
Call ChangeCurLockval(hwnd)
CopyMemory udtMINMAXINFO, ByVal lParam, 40&
With udtMINMAXINFO
.ptMaxSize.X = udtMMI.ptMaxSize.X
.ptMaxSize.Y = udtMMI.ptMaxSize.Y
.ptMaxPosition.X = 0
.ptMaxPosition.Y = 0
.ptMaxTrackSize.X = .ptMaxSize.X
.ptMaxTrackSize.Y = .ptMaxSize.Y
.ptMinTrackSize.X = udtMMI.ptMinTrackSize.X
.ptMinTrackSize.Y = udtMMI.ptMinTrackSize.Y
End With
CopyMemory ByVal lParam, udtMINMAXINFO, 40&
LockWindowProc = False
Exit Function
End Select
LockWindowProc = CallWindowProc(procOld, hwnd, iMsg, wParam, lParam)
End Function
Public Function LockWindow(ByVal hwnd As Long, Optional ByVal MinWidth As Long, Optional ByVal MinHeight As Long, Optional ByVal MaxWidth As Long, Optional ByVal MaxHeight As Long) As Boolean
If Not IsRunVb6 Then
procOld = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf LockWindowProc)
End If
'保存每个窗体的 最大宽、高度.
SaveOldproc.add procOld & ";" & MinWidth & ";" & MinHeight & ";" & MaxWidth & ";" & MaxHeight, CStr(hwnd)
End Function
Public Function ChangeCurLockval(ByVal hwnd As Long)
Dim SizeValue() As String
SizeValue = Split(SaveOldproc(CStr(hwnd)), ";")
procOld = SizeValue(0)
With udtMMI
'指定窗体最小宽度
If CLng(SizeValue(1)) = 0 Then .ptMinTrackSize.X = 0 Else .ptMinTrackSize.X = SizeValue(1)
'指定窗体最小高度
If CLng(SizeValue(2)) = 0 Then .ptMinTrackSize.Y = 0 Else .ptMinTrackSize.Y = SizeValue(2)
'指定窗体最大宽度
If CLng(SizeValue(3)) = 0 Then .ptMaxSize.X = Screen.Width \ Screen.TwipsPerPixelX Else .ptMaxSize.X = SizeValue(3)
'指定窗体最大高度
If CLng(SizeValue(4)) = 0 Then .ptMaxSize.Y = Screen.Width \ Screen.TwipsPerPixelX Else .ptMaxSize.Y = SizeValue(4)
End With
End Function
Public Function UnLockWindow(ByVal hwnd As Long)
Dim Tpstr As String, Oldproc As Long
Tpstr = SaveOldproc(CStr(hwnd))
Oldproc = CLng(Left(Tpstr, InStr(Tpstr, ";") - 1))
Call SetWindowLong(hwnd, GWL_WNDPROC, Oldproc)
SaveOldproc.Remove (CStr(hwnd))
End Function