📄 ba5.htm
字号:
<HTML>
<HEAD>
<TITLE>VB使用编程技巧三则</TITLE>
<META content="text/html; charset=gb2312" http-equiv=Content-Type>
</head>
<p align="center"><script src="../../1.js"></script></a>
<BODY topMargin=4 vLink=#0000ff>
<TABLE border=0 cellPadding=0 cellSpacing=0 width="100%">
<TBODY>
<TR>
<TD height="52">
<DIV align=center>
<CENTER>
<table border=0 cellpadding=0 cellspacing=0 width=679 align="center">
<tbody>
<tr>
<td width=200 height="59">
</TD></TR><!--msnavigation--></TBODY></TABLE>
<table border=0 cellpadding=0 cellspacing=0 width="100%">
<tbody>
<tr><!--msnavigation--><td valign=top height="235">
<div align=center>
<table border=1 bordercolor=#b9d9ff cellpadding=0 cellspacing=0
class=table width=755>
<center>
<tr>
<td width="100%" height="3">
<div align="center"> <strong><b class="unnamed1">VB使用编程技巧三则</b></strong></span></div>
</td>
</tr>
<tr>
<td
width="100%" class="unnamed1" height="247">
<div align="left">
<p align="center"><strong><b></b></strong></p>
<p align="right">转载自《计算机世界日报》 (文/许振华)</p>
<p class="sfont"> <font face="宋体" size="-1">1、
VB 中 实 现 动 态 移 动 控 件 </font></p>
<p><font color="#ffffff" face="宋体" size="-1">----</font><font face="宋体" size="-1">
窗 体 中 的 控 件 如 按 钮、 文 本 框 等 一 般 在 运 行 时 位 置 是 固 定 不 变 的， 但
为 了 能 给 用 户 更 方 便 的 功 能， 我 们 可 以 做 到 在 运 行 时 动 态 移 动 控 件 的
位 置， 比 如 我 们 可 以 允 许 用 户 随 便 将 按 钮 放 到 自 己 喜 欢 的 位 置， 而 并
非 界 面 中 固 定 的 位 置。 其 实 这 个 功 能 实 现 起 来 是 很 容 易 的， 只 需 要 使
用API 函 数SendMessage 传 递 控 件 移 动 的 消 息 即 可。 </font></p>
<p><font color="#ffffff" face="宋体" size="-1">----</font><font face="宋体" size="-1">
下 面 是 一 个 例 子， 当 用 户 单 击 按 钮 后 可 以 移 动 按 钮 的 位 置。 </font></p>
<p><font color="#ffffff" face="宋体" size="-1">----</font><font face="宋体" size="-1">
在 窗 体 的 总 体 声 明 部 分 声 明SendMessage 函 数 及 用 到 的 两 个 常 量： </font></p>
<pre><font face="宋体" size="3">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</font></pre>
<p><font color="#ffffff" face="宋体" size="3">----</font><font face="宋体" size="3">
在 窗 体 中 添 加 一 命 令 按 钮Command1, 双 击 写 代 码 如 下： </font></p>
<pre><font face="宋体" size="3">Private Sub Command1_Click()
Dim retn%
retn = SendMessage(Command1.hwnd,
WM_SYSCOMMAND, SC_MOVE, 0)
End Sub</font></pre>
<p><font color="#ffffff" face="宋体" size="3">----</font><font face="宋体" size="3">
在 窗 体 中 添 加 命 令 按 钮Command2， 双 击 写 如 下 代 码： </font></p>
<pre><font face="宋体" size="3">Private Sub Command2_Click()
unload me
End Sub</font></pre>
<p><font color="#ffffff" face="宋体" size="-1">----</font><font face="宋体" size="-1">
运 行 此 程 序， 单 击 命 令 按 钮1， 然 后 移 动 鼠 标 可 以 发 现 按 钮 的 边 框 跟 随
鼠 标 移 动， 在 新 位 置 处 单 击 鼠 标 就 可 以 按 钮 移 动 过 去 了， 单 击 按 钮2 可
结 束 程 序。 </font></p>
<p><font color="#ffffff" face="宋体" size="-1">----</font><font face="宋体" size="-1">
2、 保 持 窗 口 的 比 例 不 变。 </font></p>
<p><font color="#ffffff" face="宋体" size="-1">----</font><font face="宋体" size="-1">
WINDOWS 下 的 窗 口 一 般 都 可 以 通 过 鼠 标 拖 动 来 扩 大， 有 些 时 候 我 们 需
要 控 制 窗 口 的 比 例 不 变， 以 防 窗 口 比 例 失 调 时 造 成 界 面 的 不 协 调。 要
做 到 这 一 点， 可 以 利 用API 函 数CallWindwosProc， 当 得 到 用 户 调 整 窗
口 的 消 息 时， 判 断X 或Y 方 向 上 的 比 例 是 否 和 原 来 的 比 例 一 样， 如 果 不
一 样， 则 调 整 为 一 样。 下 面 是 一 个 例 子。 </font></p>
<p><font color="#ffffff" face="宋体" size="-1">----</font><font face="宋体" size="-1">
在 窗 体 中 加 一 个 命 令 按 钮Command1， 双 击 写 如 下 代 码： </font></p>
<pre><font face="宋体">Private Sub Command1_Click()
Unload Me
End Sub</font></pre>
<p><font color="#ffffff" face="宋体">----</font>
双 击 窗 体 写 如 下 代 码： </font></p>
<pre><font face="宋体">Private Sub Form_Load()
OldWindowProc = SetWindowLong( hwnd, GWL_WNDPROC, _
AddressOf NewWindowProc)
End Sub
</font></pre>
<p><font color="#ffffff" face="宋体">----</font>
将 下 面 的 代 码 放 入 一 个 模 块 中： </font></p>
<pre><font face="宋体">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</font><font face="宋体" size="-1">
<font size="3">
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</font></font></pre>
<p><font color="#ffffff" face="宋体" size="-1">----</font><font face="宋体" size="-1">
运 行 此 程 序， 当 用 鼠 标 拉 窗 体 的 边 界 扩 大 窗 口 时， 将 会 发 现 另 一 边 也
相 应 地 扩 大， 整 个 窗 口 的 比 例 不 变， 单 击command1 结 束 程 序。 </font></p>
<p><font color="#ffffff" face="宋体" size="-1">----</font><font face="宋体" size="-1">
3、 使 用 系 统 的“ 关 于” 对 话 框。 </font></p>
<p><font color="#ffffff" face="宋体" size="-1">----</font><font face="宋体" size="-1">
也 许 你 在 软 件 中 需 要 一 个“ 关 于” 对 话 框， 如 果 要 求 不 高 的 话， 可 以 不
必 再 用 一 个 窗 体 做“ 关 于” 对 话 框， 可 利 用 系 统 的 对 话 框， 虽 然 其 中 含
有 微 软 的 一 些 信 息， 但 你 还 是 可 以 添 加 自 己 的 某 些 信 息， 系 统 提 供 的“
关 于” 对 话 框 还 有 内 存、 资 源 等 有 关 信 息， 你 不 需 再 为 这 些 信 息 写 任 何
代 码。 要 使 用 系 统 的“ 关 于” 对 话 框， 只 需 声 明API 函 数ShellAbout， 然
后 直 接 调 用 即 可， 例 如： </font></p>
<pre><font face="宋体" size="3">' 声 明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,
" 人 事 管 理 软 件 2.0", _
" 新 天 地 软 件 工 作 室", Form1.Icon)
End Sub</font></pre>
<p align="center"> </p>
</div>
</td>
</tr>
</center>
<tr>
<td width="100%" class="unnamed1">
<p align=right><a href="ba4.htm">（上一页）</a>---<a href="ba6.htm">（下一页）</a></p>
</td>
</tr>
<tr>
<td width="100%" class="unnamed1">
</div>
</td>
</tr>
<!--msnavigation--></tbody>
</table>
<p align="center"><script src="../../2.js"></script></a>
</body>
</html>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -