---- 1、 VB 中 实 现 动 态 移 动 控 件
---- 窗 体 中 的 控 件 如 按 钮、 文 本 框 等 一 般 在 运 行 时 位 置 是 固 定 不 变 的， 但 为 了 能 给 用 户 更 方 便 的 功 能， 我 们 可 以 做 到 在 运 行 时 动 态 移 动 控 件 的 位 置， 比 如 我 们 可 以 允 许 用 户 随 便 将 按 钮 放 到 自 己 喜 欢 的 位 置， 而 并 非 界 面 中 固 定 的 位 置。 其 实 这 个 功 能 实 现 起 来 是 很 容 易 的， 只 需 要 使 用API 函 数SendMessage 传 递 控 件 移 动 的 消 息 即 可。
---- 下 面 是 一 个 例 子， 当 用 户 单 击 按 钮 后 可 以 移 动 按 钮 的 位 置。
---- 在 窗 体 的 总 体 声 明 部 分 声 明SendMessage 函 数 及 用 到 的 两 个 常 量：
Private Declare Function SendMessage
Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As
Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
Const WM_SYSCOMMAND = &H112
Const SC_MOVE = &HF012
---- 在 窗 体 中 添 加 一 命 令 按 钮Command1, 双 击 写 代 码 如 下：
Private Sub Command1_Click()
Dim retn%
retn = SendMessage(Command1.hwnd,
WM_SYSCOMMAND, SC_MOVE, 0)
End Sub
---- 在 窗 体 中 添 加 命 令 按 钮Command2， 双 击 写 如 下 代 码：
Private Sub Command2_Click()
unload me
End Sub
---- 运 行 此 程 序， 单 击 命 令 按 钮1， 然 后 移 动 鼠 标 可 以 发 现 按 钮 的 边 框 跟 随 鼠 标 移 动， 在 新 位 置 处 单 击 鼠 标 就 可 以 按 钮 移 动 过 去 了， 单 击 按 钮2 可 结 束 程 序。
---- 2、 保 持 窗 口 的 比 例 不 变。
---- 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 结 束 程 序。
---- 3、 使 用 系 统 的“ 关 于” 对 话 框。
---- 也 许 你 在 软 件 中 需 要 一 个“ 关 于” 对 话 框， 如 果 要 求 不 高 的 话， 可 以 不 必 再 用 一 个 窗 体 做“ 关 于” 对 话 框， 可 利 用 系 统 的 对 话 框， 虽 然 其 中 含 有 微 软 的 一 些 信 息， 但 你 还 是 可 以 添 加 自 己 的 某 些 信 息， 系 统 提 供 的“ 关 于” 对 话 框 还 有 内 存、 资 源 等 有 关 信 息， 你 不 需 再 为 这 些 信 息 写 任 何 代 码。 要 使 用 系 统 的“ 关 于” 对 话 框， 只 需 声 明API 函 数ShellAbout， 然 后 直 接 调 用 即 可， 例 如：
' 声 明API 函 数
Private Declare Function
ShellAbout Lib "shell32.dll" _
Alias "ShellAbout" (ByVal hwnd
As Long, ByVal szApp As String, _
ByVal szOtherStuff As String,
ByVal hIcon As Long) As Long
在 需 要 的 地 方 使 用 它：
Private Sub ABOUTCd_Click()
x = ShellAbout(Form1.hwnd, " VB编程乐园网站指南", "博士电脑软件工作室", Form1.Icon)
End Sub
|
