这段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
...全文
115 4 打赏 收藏 举报
写回复
4 条回复
切换为时间正序
请发表友善的回复…
发表回复
zhouhua206 2004-10-06
  • 打赏
  • 举报
回复
直接转就完了,高级语言都一样,何况使用Win API直接就可以翻译过来
popmailzjw 2004-10-06
  • 打赏
  • 举报
回复
楼上的,这些在DELPHI中都有定义呀
jessezappy 2004-10-05
  • 打赏
  • 举报
回复
我只想要内存和进程操作的那堆API函数的定义..做游戏外挂玩玩..
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "KERNEL32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function WriteProcessMemory Lib "KERNEL32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function ReadProcessMemory Lib "KERNEL32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long

Private Declare Function CloseHandle Lib "KERNEL32" (ByVal hObject As Long) As Long
popmailzjw 2004-10-05
  • 打赏
  • 举报
回复
這個翻譯應該不難吧,不過我對VB不了解,要不可以試,好像沒有太難的地方
发帖
Windows SDK/API

1177

社区成员

Delphi Windows SDK/API
社区管理员
  • Windows SDK/API社区
加入社区
帖子事件
创建了帖子
2004-10-05 11:21
社区公告
暂无公告