📄 vb常用代码及示例_gmh's weblog.htm
字号:
COLOR: #7777cc; TEXT-DECORATION: underline
}
#ft A:visited {
COLOR: #7777cc; TEXT-DECORATION: underline
}
#usrbar {
LETTER-SPACING: normal
}
#usrbar A {
LETTER-SPACING: normal
}
#usrbar A:link {
LETTER-SPACING: normal
}
#usrbar A:visited {
LETTER-SPACING: normal
}
#ft {
LETTER-SPACING: normal
}
#ft A {
LETTER-SPACING: normal
}
#ft A:link {
LETTER-SPACING: normal
}
#ft A:visited {
LETTER-SPACING: normal
}
</STYLE>
<DIV id=usrbar><NOBR><A href="http://www.baidu.com/" target=_blank>百度首页</A> | <A
id=hi_index href="http://hi.baidu.com/" target=_blank>百度空间</A>
<SCRIPT type=text/javascript>
document.write('| <a href="http://passport.baidu.com/?login&tpl=sp&tpl_reg=sp&u=http://hi.baidu.com' + encodeURI('/mygmh/blog/item/916cefefdac04530adafd5f5%2Ehtml') + '">登录</a>');
</SCRIPT>
</NOBR></DIV>
<DIV id=main align=left><!--[if IE]>
<SCRIPT>
var objmain = document.getElementById("main");
function updatesize(){ var bodyw = window.document.body.offsetWidth; if(bodyw <= 790) objmain.style.width="772px"; else if(bodyw >= 1016) objmain.style.width="996px"; else objmain.style.width="100%"; }
updatesize(); window.onresize = updatesize;
</SCRIPT>
<![endif]-->
<DIV id=header>
<DIV class=lc>
<DIV class=rc></DIV></DIV>
<DIV class=tit><A class=titlink title="mygmh的空间 http://hi.baidu.com/mygmh"
href="http://hi.baidu.com/mygmh">GMH's weblog</A></DIV>
<DIV class=desc>清凉一下吧~~</DIV>
<DIV id=tabline></DIV>
<DIV id=tab><A href="http://hi.baidu.com/mygmh">主页</A><A class=on
href="http://hi.baidu.com/mygmh/blog">博客</A><A
href="http://hi.baidu.com/mygmh/album">相册</A><SPAN>|</SPAN><A
href="http://hi.baidu.com/mygmh/profile">个人档案</A> <SPAN>|</SPAN><A
href="http://hi.baidu.com/mygmh/friend">好友</A> </DIV></DIV>
<DIV class=stage>
<DIV class=stagepad>
<DIV style="WIDTH: 100%">
<TABLE class=modth cellSpacing=0 cellPadding=0 width="100%" border=0>
<TBODY>
<TR>
<TD class=modtl width=7> </TD>
<TD class=modtc noWrap>
<DIV class=modhead><SPAN class=modtit>查看文章</SPAN></DIV></TD>
<TD class=modtc noWrap align=right></TD>
<TD class=modtr width=7> </TD></TR></TBODY></TABLE>
<DIV class=modbox id=m_blog>
<DIV class=tit>VB常用代码及示例</DIV>
<DIV class=date>2008年07月21日 09:56</DIV>
<TABLE style="TABLE-LAYOUT: fixed">
<TBODY>
<TR>
<TD>
<DIV class=cnt id=blog_text><SPAN
class=smallbody>VB常用代码及示例<BR><BR><BR>CODE:<BR>Private Declare Function
fCreateShellLink Lib "STKIT432.DLL" (ByVal lpstrFolderName As String,
ByVal lpstrLinkName As String, ByVal lpstrLinkPath As String, ByVal
lpstrLinkArgs As String) As Long <BR>Sub Command1_Click()<BR>Dim lReturn
As Long<BR>'添加到桌面<BR>lReturn = fCreateShellLink("..\..\Desktop", "Shortcut
to Calculator", "c:\windows\calc.exe", "")<BR>'添加到程序组<BR>lReturn =
fCreateShellLink("", "Shortcut to Calculator", "c:\windows\calc.exe",
"")<BR>'添加到启动组<BR>lReturn = fCreateShellLink("\Startup", "Shortcut to
Calculator", "c:\windows\calc.exe", "")<BR>End Sub<BR><BR><BR>问题二、如何让程序在
Windows 启动时自动执行？<BR><BR>有以下二个方法：<BR><BR>方法1:
直接将快捷方式放到启动群组中。<BR><BR>方法2:<BR>在注册档 HKEY_LOCAL_MACHINE
中找到以下机码<BR>\Software\Microsoft\Windows\CurrentVersion\Run<BR>新增一个字串值，包括二个部份<BR>1.
名称部份：自己取名，可设定为 AP 名称。<BR>2. 资料部份：则是包含 '全路径档案名称' 及
'执行参数'<BR><BR>例如：<BR><BR><BR><BR>[Copy to clipboard]CODE:<BR>Value Name =
Notepad<BR>Value Data = c:\windows\notepad.exe<BR><BR><BR><BR>问题三、在
TextBox 中如何限制只能输入数字？<BR><BR>参考下列程序：<BR><BR><BR><BR>[Copy to
clipboard]CODE:<BR>Sub Text1_KeyPress(KeyAscii As Integer)<BR>If KeyAscii
< 48 Or KeyAscii > 57 Then<BR>KeyAscii = 0<BR>End If<BR>End
Sub<BR><BR><BR>问题四、如何限制TextBox 接受某些特定字符，例如 '@#$%"。<BR><BR>方法有好几种,
以下列举二种：<BR><BR>方法1: 可以使用 IF 或 Select Case 一个个判断, 但如果不接受的字符多时, 较麻烦!
<BR>方法2: 将要剔除的字符统统放在一个字串中，只要一个 IF 判断即可 !! 如下： <BR><BR><BR><BR>[Copy to
clipboard]CODE:<BR>Private Sub Text1_KeyPress(KeyAscii As Integer)<BR>Dim
sTemplate As String<BR>sTemplate = "!@#$%^&*()_+-=" '用来存放不接受的字符<BR>If
InStr(1, sTemplate, Chr(KeyAscii)) > 0 Then<BR>KeyAscii = 0<BR>End
If<BR>End Sub<BR><BR><BR><BR>问题五、如何让鼠标进入 TextBox 时自动选定 TextBox
中之整串文字？<BR><BR>这个自动选定反白整串文字的动作，会使得输入的资料完全取代之前在 TextBox
中的所有字符。<BR><BR><BR><BR><BR>[Copy to clipboard]CODE:<BR>Private Sub
Text1_GotFocus()<BR>Text1.SelStart = 0<BR>Text1.SelLength =
Len(Text1)<BR>End
Sub<BR><BR><BR><BR>问题六、如何检查软盘驱动器里是否有软盘？<BR><BR>使用：<BR><BR><BR><BR>[Copy to
clipboard]CODE:<BR>Dim Flag As Boolean<BR>Flag =
Fun_FloppyDrive("A:")<BR>If Flag = False Then MsgBox
"A:驱没有准备好，请将磁盘插入驱动器！",
vbCritical<BR><BR>'-------------------------------<BR>'函数:检查软驱中是否有盘的存在<BR>'-------------------------------<BR>Private
Function Fun_FloppyDrive(sDrive As String) As Boolean<BR>On Error Resume
Next<BR>Fun_FloppyDrive = Dir(sDrive) <> ""<BR>End
Function<BR><BR><BR>问题七、如何弹出和关闭光驱托盘？<BR><BR><BR><BR><BR>[Copy to
clipboard]CODE:<BR>Option Explicit<BR>Private Declare Function
mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand
As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long,
ByVal hwndCallback As Long) As Long<BR><BR>Private Sub
Command1_Click()<BR>mciExecute "set cdaudio door open"
'弹出光驱<BR>Label2.Caption = "弹 出"<BR>End Sub<BR><BR>Private Sub
Command2_Click()<BR>Label2.Caption = "关 闭"<BR>mciExecute "set cdaudio door
closed" '合上光驱<BR>Unload Me<BR>End<BR>End
Sub<BR><BR><BR><BR>问题八、如何让你的程序在任务列表隐藏 <BR><BR><BR><BR><BR>[Copy to
clipboard]CODE:<BR>Private Declare Function RegisterServiceProcess Lib
"kernel32" (ByVal ProcessID As Long, ByVal ServiceFlags As Long) As
Long<BR>Private Declare Function GetCurrentProcessId Lib "kernel32" () As
Long<BR><BR>'请你试试 Ctrl+Alt+Del 是不是你的程序隐藏了<BR>Private Sub
Command1_Click()<BR>i = RegisterServiceProcess(GetCurrentProcessId,
1)<BR>End Sub <BR><BR><BR><BR>问题九、如何用程序控制滑鼠游标 (Mouse Cursor)
到指定位置？<BR><BR>以下这个例子，当 User 在 Text1 中按下 'Enter' 键后，滑鼠游标会自动移到 Command2 按钮上方
<BR><BR>请在声明区中加入以下声明：<BR><BR><BR><BR><BR>[Copy to clipboard]CODE:<BR>'16
位版本： ( Sub 无传回值 )<BR>Declare Sub SetCursorPos Lib "User" (ByVal X As
Integer, ByVal Y As Integer)<BR>'32 位版本： ( Function 有传回值，Integer 改成 Long
)<BR>Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y
As Long) As Long<BR><BR>'在 Form1 中加入以下程序码：<BR>Private Sub
Text1_KeyPress(KeyAscii As Integer)<BR>If KeyAscii = 13 Then<BR>x% =
(Form1.Left + Command2.Left + Command2.Width / 2 + 60) /
Screen.TwipsPerPixelX<BR>y% = (Form1.Top + Command2.Top + Command2.Height
/ 2 + 360) / Screen.TwipsPerPixelY<BR>SetCursorPos x%, y%<BR>End If<BR>End
Sub<BR><BR><BR>问题十、如何用鼠标移动没有标题的 Form，或移动 Form 中的控制项？<BR><BR>在声明区中放入以下声明：
<BR><BR><BR><BR><BR>[Copy to clipboard]CODE:<BR>'16 位版本： ( Sub 无返回值
)<BR>Private Declare Sub ReleaseCapture Lib "User" ()<BR>Private Declare
Sub SendMessage Lib "User" (ByVal hwnd As Integer, ByVal wMsg As Integer,
ByVal wParam As Integer, lParam As Long)<BR><BR>'32 位版本： ( Function
有返回值，Integer 改成 Long )<BR>Private Declare Function ReleaseCapture Lib
"user32" () As Long<BR>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<BR><BR>'共用常数：<BR>Const WM_SYSCOMMAND =
&H112<BR>Const SC_MOVE = &HF012<BR><BR>'若要移动
Form，程序码如下：<BR>Private Sub Form_MouseDown(Button As Integer, Shift As
Integer, X As Single, Y As Single)<BR>Dim i As Long<BR>i =
ReleaseCapture<BR>i = SendMessage(Form1.hwnd, WM_SYSCOMMAND, SC_MOVE,
0)<BR>End Sub<BR><BR>'以上功能也适用于用鼠标在 Form 中移动控制项，程序码如下：<BR>Private Sub
Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As
Single)<BR>Dim i As Long<BR>i = ReleaseCapture<BR>i =
SendMessage(Command1.hwnd, WM_SYSCOMMAND, SC_MOVE, 0)<BR>End
Sub<BR><BR>问题十一、检查文件是否存在？<BR><BR><BR><BR><BR>[Copy to
clipboard]CODE:<BR>Function FileExists(filename As String) As
Integer<BR>Dim i As Integer<BR>On Error Resume Next<BR>i =
Len(Dir$(filename))<BR>If Err Or i = 0 Then FileExists = False Else
FileExists = True<BR>End
Function<BR><BR><BR>问题十二、如何设置对VB数据库连接的动态路径<BR><BR>我个人因为经常作一些数据库方面的程序，对于程序间如何与数据库进行接口的问题之烦是深有体会，因为VB在数据库链接的时候，一般是静态，即数据库存放的路径是固定的，如用VB的DATA，adodc,DataEnvironment
等到作数据库链接时，如果存放数据库的路径被改变的话，就会找不到路经，真是一个特别烦的事。<BR>笔者的解决方法是利用app.path
来解决这个问题。
<BR>一、用data控件进行数据库链接，可以这样：<BR>在form_load()过程中放入：<BR><BR><BR><BR>[Copy to
clipboard]CODE:<BR>private form_load()<BR>Dim str As String '定义<BR>str =
App.Path<BR>If Right(str, 1) <> "\" Then<BR>str = str + "\"<BR>End
If<BR>data1.databasename=str &
"\数据库名"<BR>data1.recordsource="数据表名"<BR>data1.refresh<BR>sub
end<BR><BR>这几句话的意为，打开当前程序运行的目录下的数据库。<BR>你只要保证你的数据库在你程序所在的目录之下就行了。<BR><BR>二、利用adodc（ADO
Data Control)进行数据库链接：<BR><BR><BR><BR>[Copy to clipboard]CODE:<BR>private
form_load ()<BR>Dim str As String '定义<BR>str = App.Path<BR>If Right(str,
1) <> "\" Then<BR>str = str + "\"<BR>End If<BR>str =
"Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data
Source=" & str & "\tsl.mdb"<BR>Adodc1.ConnectionString =
str<BR>Adodc1.CommandType = adCmdText<BR>Adodc1.RecordSource = "select *
from table3"<BR>Adodc1.Refresh<BR>end
sub<BR><BR><BR>三、利用DataEnvironment进行数据库链接<BR>可在过程中放入：<BR><BR><BR><BR>[Copy
to clipboard]CODE:<BR>On Error Resume Next<BR>If
DataEnvironment1.rsCommand1.State <> adStateClosed
Then<BR>DataEnvironment1.rsCommand1.Close '如果打开，则关闭<BR>End If<BR>'i =
InputBox("请输入友人编号:", "输入")<BR>'If i = "" Then Exit
Sub<BR>DataEnvironment1.Connection1.Open App.Path &
"\userdatabase\tsl.mdb"<BR>DataEnvironment1.rsCommand1.Open "select * from
table3 where 编号='" & i & "'"<BR>'Set DataReport2.DataSource =
DataEnvironment1<BR>'DataReport2.DataMember =
"command1"<BR>'DataReport2.show<BR>end sub<BR><BR><BR>四、利用ADO(ActiveX Data
Objects)进行编程：<BR>建立连接：<BR><BR><BR><BR>[Copy to clipboard]CODE:<BR>dim conn
as new adodb.connection<BR>dim rs as new adodb.recordset<BR>dim str<BR>str
= App.Path<BR>If Right(str, 1) <> "\" Then<BR>str = str + "\"<BR>End
If<BR>str = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security
Info=False;Data Source=" & str & "\tsl.mdb"<BR>conn.open
str<BR>rs.cursorlocation=aduseclient<BR>rs.open
"数据表名",conn,adopenkeyset.adlockpessimistic<BR><BR>用完之后关闭数据库：<BR><BR><BR><BR>[Copy
to clipboard]CODE:<BR>conn.close<BR>set
conn=nothing<BR><BR><BR>问题十三、如何让用户自行输入方程式，并计算其结果？<BR><BR>假设我们要让使用者在“方程式”栏位中自由输入方程式，然后利用方程式进行计算，则引用ScriptControl控件可以很方便地做到。<BR>(
ScriptControl 控件附属于VB 6.0，如果安装后没有看到此一控件，可在光盘的 \Common\Tools\VB\Script
目录底下找此一控件， 其.文件名为Msscript.ocx。)
假设放在窗体上的ScriptControl控件名称为ScriptControl1，则在“计算”按钮的Click事件中编写如下代码： Dim
Statement As String Statement = "X=" + Text1.Text + vbCrLf + _ "Y=" +
Text2.Text + vbCrLf + _ "MsgBox ""计算结果="" & Y "
ScriptControl1.ExecuteStatement( Statement <BR><BR>问题十四、如何让一个 App 永远保持在最上层
( Always on Top )<BR><BR>请在声明区中加入以下声明<BR><BR><BR><BR><BR>[Copy to
clipboard]CODE:<BR>Private Declare Function SetWindowPos Lib "user32"
(ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal
y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As
Long<BR><BR>Const SWP_NOMOVE = &H2 '不更动目前视窗位置<BR>Const SWP_NOSIZE =
&H1 '不更动目前视窗大小<BR>Const HWND_TOPMOST = -1 '设定为最上层<BR>Const
HWND_NOTOPMOST = -2 '取消最上层设定<BR>Const FLAGS = SWP_NOMOVE Or
SWP_NOSIZE<BR><BR>'将 APP 视窗设定成永远保持在最上层<BR>SetWindowPos Me.hwnd,
HWND_TOPMOST, 0, 0, 0, 0, FLAGS<BR><BR>'取消最上层设定<BR>SetWindowPos Me.hwnd,
HWND_NOTOPMOST, 0, 0, 0, 0,
FLAGS<BR><BR><BR>问题十五、如何在程序中开启网页？<BR><BR>在声明区中声明如下 (在 .bas 档中用 Public, 在
Form 中用 Private)<BR><BR><BR><BR><BR>[Copy to clipboard]CODE:<BR>Private
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA"
(ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String,
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd
As Long) As Long<BR><BR>在程序中<BR><BR><BR><BR><BR>[Copy to
clipboard]CODE:<BR>Intranet：<BR>ShellExecute Me.hWnd, "open",
"http://Intranet主机/目录", "", "", 5<BR>Internet：<BR>ShellExecute Me.hWnd,
"open", "http://www.ruentex.com.tw", "", "", 5 <BR><BR>
<BR><BR><BR><BR>问题十六、VB可以产生四角形以外其他形状的 Form
吗？<BR><BR>这个问题，您一定无法想像有多容易，您可以产生任何形状的 Form，但必须借助 CreateEllipticRgn 及
SetWindowRgn 二个 API ，例如：<BR><BR><BR><BR><BR>[Copy to
clipboard]CODE:<BR>Private Declare Function CreateEllipticRgn Lib "gdi32"
(ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long)
As Long<BR><BR>Private Declare Function SetWindowRgn Lib "user32" (ByVal
hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As
Long<BR><BR>Private Sub Form_Load()<BR>Dim lReturn As
Long<BR>Me.Show<BR>lReturn = SetWindowRgn(hWnd, CreateEllipticRgn(10, 10,
340, 150), True)<BR>End Sub<BR><BR>执行结果图片<BR><BR>CreateEllipticRgn
之四个参数说明如下：<BR>X1：椭圆中心点之X轴位置，但以 Form 的实№边界为限。<BR>Y1：椭圆中心点之Y轴位置，但以 Form
的实№边界为限。<BR>X2：椭圆长边的长度<BR>Y2：椭圆短边的长度的<BR><BR>问题十七、如何移除 Form
右上方之『X』按钮？<BR><BR>其实 Form 右上方之三个按钮分别对应到 Form 左上方控制盒 (ControlBox) 中的几个选项
(缩到最小 / 放到最大 / 关闭)，而其中的最大化 (MaxButton) 及最小化 (Minbutton) 都可以直接在 Form
的属性中设定，但是 VB 并没有提供设定『X』按钮的功能！要达到这个功能，必须借助 API：<BR><BR>由于『X』按钮对应到
ControlBox 的关闭选项，所以我们只要移除系统 Menu (就是ControlBox) 的关闭选项即可！您自己可以先看看您现在使用的
Browser 左上方的系统 Menu，【关闭】选项是在第几个，不是第 6 个！是第 7 个，分隔线也算一个！分隔线才是第 6
个！<BR><BR>当我们移除了关闭选项之後，会留下一条很奇怪的分隔线，所以最好连分隔线也一并移除。而 Menu 的 Index 是从 0
开始，分隔线是第 6 个，所以 Index = 5。<BR><BR>修正：为了让程序码在 Windows NT 也能运作正常，将各 Integer
型态改成 Long。 89.05.04<BR><BR><BR><BR><BR>[Copy to clipboard]CODE:<BR>'抓取系统
Menu 的 hwnd<BR>Private Declare Function GetSystemMenu Lib "user32" Alias
"GetSystemMenu" (ByVal hwnd As Long, ByVal bRevert As Long) As
Long<BR><BR>'移除系统 Menu 的 API<BR>Private Declare Function RemoveMenu Lib
"user32" Alias "RemoveMenu" (ByVal hMenu As Long, ByVal nPosition As Long,
ByVal wFlags As Long) As Long<BR>'第一个参数是系统 Menu 的 hwnd<BR>'第二个参数是要移除选项的
Index<BR><BR><BR>问题十八、如何制作透明的表单
(Form)？<BR><BR>请在声明区中放入以下声明<BR><BR><BR><BR><BR>[Copy to
clipboard]CODE:<BR>Const GWL_EXSTYLE = (-20)<BR>Const WS_EX_TRANSPARENT =
&H20&<BR>Const SWP_FRAMECHANGED = &H20<BR>Const SWP_NOMOVE =
&H2<BR>Const SWP_NOSIZE = &H1<BR>Const SWP_SHOWME =
SWP_FRAMECHANGED Or SWP_NOMOVE Or SWP_NOSIZE<BR>Const HWND_NOTOPMOST =
-2<BR><BR>Private Declare Function SetWindowLong Lib "user32" Alias
"SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal
dwNewLong As Long) As Long<BR>Private Declare Function SetWindowPos Lib
"user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As
Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As
Long) As Long<BR><BR>在 Form_Load 使用的范例如下：<BR><BR><BR><BR><BR>[Copy to
clipboard]CODE:<BR>Private Sub Form_Load()<BR>SetWindowLong Me.hwnd,
GWL_EXSTYLE, WS_EX_TRANSPARENT<BR>SetWindowPos Me.hwnd, HWND_NOTOPMOST,
0&, 0&, 0&, 0&, SWP_SHOWME<BR>Me.Refresh<BR>End
Sub<BR><BR><BR>问题十九、如何在 Menu
中加入美美的图案？<BR><BR>在模组中加入以下程序码：<BR><BR><BR><BR><BR>[Copy to
clipboard]CODE:<BR>Declare Function GetMenu Lib "user32" (ByVal hwnd As
Long) As Long<BR><BR>Declare Function GetSubMenu Lib "user32" (ByVal hMenu
As Long, ByVal nPos As Long) As Long<BR><BR>Declare Function GetMenuItemID
Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As
Long<BR><BR>Declare Function SetMenuItemBitmaps Lib "user32" (ByVal hMenu
As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal
hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As
Long<BR><BR>Public Const MF_BITMAP = &H4&<BR><BR>Type
MENUITEMINFO<BR>cbSize As Long<BR>fMask As Long<BR>fType As Long<BR>fState
As Long<BR>wID As Long<BR>hSubMenu As Long<BR>hbmpChecked As
Long<BR>hbmpUnchecked As Long<BR>dwItemData As Long<BR>dwTypeData As
String<BR>cch As Long<BR>End Type<BR><BR>Declare Function GetMenuItemCount
Lib "user32" (ByVal hMenu As Long) As Long<BR><BR>Declare Function
GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As
Long, ByVal un As Long, _<BR>ByVal b As Boolean, lpMenuItemInfo As
MENUITEMINFO) As Boolean<BR><BR>Public Const MIIM_ID = &H2<BR>Public
Const MIIM_TYPE = &H10<BR>Public Const MFT_STRING =
&H0&<BR><BR>在 Form 中加入一个 PictureBox，属性设定为：<BR>AutoSize =
True<BR>Picture = .bmp (尺寸大小为 13x13，不可设定为 .ico)<BR><BR>在 Form_Load
中的程序码如下：<BR><BR>Private Sub Form_Load()<BR>'取得程序中 Mennu 的
handle<BR>hMenu& = GetMenu(Form1.hWnd)<BR>'取得第一个 submenu 的
handle<BR>hSubMenu& = GetSubMenu(hMenu&, 0)<BR>'取得 Submenu 第一个选项的
menuId<BR>hID& = GetMenuItemID(hSubMenu&,
0)<BR>'加入图片<BR>SetMenuItemBitmaps hMenu&, hID&, MF_BITMAP,
Picture1.Picture, Picture1.Picture<BR>'在一个 Menu 选项中您一共可以加入二张图片<BR>'一张是
checked 状态用，一张是 unchecked 状态用<BR>End Sub<BR><BR>89、如何把小图片填满 Form
成为背景图？<BR><BR>对于这个问题，我看过很多方法，有的方法很麻烦，要声明一大堆 Type，用一大堆的
API，但是有一个最笨但我认为最好的方法如下： (就好像拼磁砖一样，不用任何 API, 不必声明任何 Type)<BR><BR>在 Form
中放一个 PictureBox，Picture 属性设定为某一张小图，AutoSize 属性性设定
True，完成的模组如下：<BR><BR><BR><BR><BR>[Copy to clipboard]CODE:<BR>Sub
PictureTile(Frm As Form, Pic As PictureBox)<BR>Dim i As Integer<BR>Dim t
As Integer<BR>Frm.AutoRedraw = True<BR>Pic.BorderStyle = 0<BR>For t = 0 To
Frm.Height Step Pic.ScaleHeight<BR>For i = 0 To Frm.Width Step
Pic.ScaleWidth<BR>Frm.PaintPicture Pic.Picture, i, t<BR>Next i<BR>Next
t<BR>End Sub<BR><BR><BR>PictureTile 这个模组共有二个参数，第一个是表单名称，第二个则是 PictureBox
的名称。以下为一应用实例：<BR><BR><BR><BR><BR>[Copy to clipboard]CODE:<BR>Private Sub
Form_Load()<BR>PictureTile Me, Picture1<BR>End Sub<BR><BR>90、如何把小图片填满
MDIForm 成为背景图？<BR><BR>以下这个范例， 要：<BR>1、一个 MDIForm：不必设定任何属性。<BR>2、一个
Form1：不一定是 MDIChild，最好 MDIChild 为 False，但是 AutoRedraw 设成 True。<BR>3、Form1
上面放一个隐藏的 PictureBox：名称为 Picture1，不必设定 Picture
属性。<BR>4、一张图片的完整路径。<BR><BR><BR><BR><BR>[Copy to
clipboard]CODE:<BR>'将以下模组放入 MDIForm 的声明区中：<BR><BR>Sub TileMDIBkgd(MDIForm
As Form, bkgdtiler As Form, bkgdfile As String)<BR>If bkgdfile = "" Then
Exit Sub<BR>Dim ScWidth%, ScHeight%<BR>ScWidth% = Screen.Width /
Screen.TwipsPerPixelX<BR>ScHeight% = Screen.Height /
Screen.TwipsPerPixelY<BR>Load bkgdtiler<BR>bkgdtiler.Height =
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -