WINDOWS 下 的 窗 口 一 般 都 可 以 通 过 鼠 标 拖 动 来 扩 大， 有 些 时 候 我 们 需 要 控 制 窗 口 的 比 例 不 变， 以 防 窗 口 比 例 失 调 时 造 成 界 面 的 不 协 调。 要 做 到 这 一 点， 可 以 利 用API 函 数CallWindwosProc， 当 得 到 用 户 调 整 窗 口 的 消 息 时， 判 断X 或Y 方 向 上 的 比 例 是 否 和 原 来 的 比 例 一 样， 如 果 不 一 样， 则 调 整 为 一 样。 下 面 是 一 个 例 子。
在 窗 体 中 加 一 个 命 令 按 钮Command1， 双 击 写 如 下 代 码：
Private Sub Command1_Click()
Unload Me
End Sub
双 击 窗 体 写 如 下 代 码：
Private Sub Form_Load()
OldWindowProc = SetWindowLong( hwnd, GWL_WNDPROC, AddressOf NewWindowProc)
End Sub
将 下 面 的 代 码 放 入 一 个 模 块 中：
Option Explicit
Public OldWindowProc As Lon
' 声 明API 函 数 如 下：
Declare Function CallWindowProc Lib
"user32" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, ByVal
hwnd As Long, ByVal msg As Long, _
ByVal wParam As Long, lParam As
WINDOWPOS) As Long
Declare Function SetWindowLong Lib
"user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex
As Long, ByVal dwNewLong As Long) As Long
Public Const GWL_WNDPROC = -4
' 定 义 一 个 窗 口 位 置 数 据 类 型
Type WINDOWPOS
hwnd As Long
hWndInsertAfter As Long
x As Long
y As Long
cx As Long
cy As Long
flags As Long
End Type
Public Const WM_WINDOWPOSCHANGING = &H46
Public Const WM_WINDOWPOSCHANGED = &H47
' 处 理 窗 口 变 化 的 函 数
Public Function NewWindowProc
(ByVal hwnd As Long, ByVal msg As Long, _
ByVal wParam As Long, lParam As WINDOWPOS) As Long
Static done_before As Boolean
Static aspect As Single
Dim new_aspect As Single
If msg = WM_WINDOWPOSCHANGING Then
If lParam.cy > 0 Then
' 保 存 原 来 的 比 例
If Not done_before Then
aspect = lParam.cx / lParam.cy
done_before = True
End If
new_aspect = lParam.cx / lParam.cy
If new_aspect > aspect Then
lParam.cy = lParam.cx / aspect
Else
lParam.cx = aspect * lParam.cy
End If
End If
End If
NewWindowProc = CallWindowProc
( OldWindowProc, hwnd, msg, wParam, lParam)
End Function
运 行 此 程 序， 当 用 鼠 标 拉 窗 体 的 边 界 扩 大 窗 口 时， 将 会 发 现 另 一 边 也 相 应 地 扩 大， 整 个 窗 口 的 比 例 不 变， 单 击command1 结 束 程 序。
|
