菜单项的动态装入
菜单项的动态装入
菜单项的动态装入是指菜单项的个数不固定. 例子就是文件菜单中最近打开的文件的列表。在第一次打开文件之前,该列表是空的,并且不在文件菜单中出现;打开一个文件后,该列表不再是空的,并且文件菜单中出现代表被打开文件的菜单项。

具体的实现过程如下:

在文件菜单里增加一个菜单项,标题任意,并假设菜单项的Name属性是opened_files_ list;
更改菜单项opened_files_list的可见属性,使
opened_files_list.Visible=False
更改菜单项opened_files_list的下标属性,使
opened_files_list.Index=0
在程序中控制菜单项opened_files_list的动态装入。

假设要显示打开过的第二个文件的文件名,并且该文件名存放在一个文件名数组opened _file_name里。以下的代码就实现了这一功能:

Load opened_files_list(1)
opened_files_list(1).Caption="&2"+opened_file_name(1)
opened_files_list(1).Visible=True

需要注意的是,对于下标为0的菜单项,不能用Load方法。因为在程序执行时,该菜单项就 已经被装入到内存里了;另外,在菜单项的标题属性字符里的"&"字符具有特殊的含义,它的作 用是在显示该属性字符串的同时,并不显示"&"本身,而紧跟"&"的字符在显示时具有下划线, 并且该字符成为热键。

如果下标不为0的菜单项不再需要,为了减少对内存资源的占用,可以用Unload方法把它 从内存卸出;同样地,不能用Unload卸出下标为0的菜单项。

成组更新控件属性
013 成组更新控件属性
下面是成组更新 Enabled 属性的例子：
Sub EnableAll(Enabled As Boolean, ParamArray objs() As Variant)
   Dim obj As Variant
   For Each obj In objs
       obj.Enabled = Enabled
   Next obj
End Sub
应用：
EnableAll True, Text1, Text2, Command1, Command2

处理 Select 语句中的单引号
处理 Select 语句中的单引号 98-8-06
在数据库应用中， 经常要动态生成 Select 语句，典型的情况：
 SqlString = "Select * from myBas where Name  = '" & Text1 & "'"
好啦， 问题出现了， 如果在录入的 Text1 中有一个单引号，结果是把 SqlString 发给数据库时， 将出错！

其实要做的防范很简单， 增加一个函数：

FUNCTION CheckString (s) as String
pos = InStr(s, "'")
While pos > 0
s = Mid(s, 1, pos) & "'" & Mid(s, pos + 1)
pos = InStr(pos + 2, s, "'")
Wend

CheckString="'" & s & "'"
END FUNCTION

以后在动态生成 Select 语句， 使用：
 SqlString = "Select * from myBas where Name  = " & CheckString(Text1)

窗口事件的发生顺序
1 Form_Initialize
2 Form_Load
3 Form_Resize
4 Form_Activate
5 Form_GotFocus
6 Form_Paint
7 Form_Unload
8 Form_Terminate

创建不规则窗口
001 创建不规则窗口
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long

Private Sub Form_Load()
Show
SetWindowRgn hWnd,   CreateEllipticRgn(0, 0, 300, 200),   True
End Sub
上述代码可以创建一个椭圆形状的窗口。

创建位图菜单
                       VB开发小技巧（摘录）
                           创建位图菜单
               ###################################
                               谭翁
----在通常的程序中菜单总是以文本的方式存在，有时候显得非常单调乏味。如果能够
在菜单中加入位图图形，将会极大地增加用户的使用兴趣。本文介绍了如何使用位图制
作菜单选项。

创建位图菜单
----创建位图菜单其实非常简单，它需要用到Windows应用程序编程接口（API）的一些
菜单函数和位图函数，你需要将这些函数的声明包含在你的应用程序的标准模块中，具
体的内容请参见样例程序。步骤如下：
使用函数GetSubMenu来提取子菜单项的句柄，并通过使用函数CreateCompatibleDC来创
建一个兼容的设备环境描述表；
在一个循环过程中通过使用CreateCompatibleBitmap函数，SelectObject函数以及
BitBlt函数来分别将针对各个菜单项所载入的位图选入到兼容设备环境中；
通过ModifyMenu函数绘制真正的位图菜单选项；
使用DeleteDC函数来释放设备环境，以便其他的程序可以使用它们。
----提取位图可以有多种方法，在本样例程序中在窗体上设置了四个图形框控件，使用
它们载入4个预设的图标来作为菜单选项位图的源文件，当然你也可以使用其他的方
法，例如使用LoadPicture函数来从磁盘装载位图。

样例程序
在Visual Basic中开始一个新的工程，采用缺省的方法建立Form1。
创建一个新的模块，采用缺省的方法建立Module1.Bas。
将如下的声明语句和常量添加到Module1.Bas模块中：
Option Explicit
Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long,
 ByVal nPos As Long) As Long
Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long,
 ByVal nPos As Long) As Long
Declare Function ModifyMenu Lib "user32" Alias "ModifyMenuA"
(ByVal hMenu As Long,ByVal nPosition As Long, ByVal wFlags As Long,
 ByVal wIDNewItem As Long, ByVal lpString As Any) As Long
Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Declare Function CreateCompatibleBitmap Lib "gdi32"
(ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long,
ByVal hObject As Long) As Long
Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long,
ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC
As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As
Long
Public Const SRCCOPY = &HCC0020
Public Const MF_BYPOSITION = &H400&
Public Const MF_BITMAP = &H4&
注意上面的声明语句需要书写在一行内。
在Form1上添加4个图形框控件，将它们的Name属性设置为Picture1，将它们的Index属
性依次设置为0，1，2，3，将它们的AutoRedrew属性设置为True，将它们的AutoResize
属性设置为Ture，以及将它们的Visable属性设置为False。
将上面的4个图形框控件的Picture属性依次设置为Face1.ico，Face2.ico，
Face3.ico，Face4.ico。
在Form1上添加第一个菜单项，将它的标题设置为“[&F]文件”，名称设置？nuFile。
在其下添加一个子菜单项，将它的标题设置为“[&E]退出”，名称设置为mnuExit。
在Form1上添加第二个菜单项，将它的标题设置为“[&A]脸谱”，名称设置为mnuFace。
在其下添加4个子菜单项，分别将改4个子菜单项的名称设置为“[N]正常”，“[&S]微
笑”，“ [&L]大笑”，以及“[&O]悲伤”。将它们的名称设置为“mnuFaceSel”，并
相应将这4个子菜单项的索引设置为0，1，2，3。
将如下的代码添加到Form1的Form_Load事件中：
Private Sub Form_Load()
   Dim nLoopCtr As Integer
   Dim lResult As Long
   Dim hTempDC As Long
   Dim nWidth As Integer
   Dim nHeight As Integer
   Dim lTempID As Long
   Dim hMenuID As Long
   Dim lItemCount As Long
   Dim hBitmap As Long

   nWidth = Picture1(nLoopCtr).Width \ Screen.TwipsPerPixelX
   nHeight = Picture1(nLoopCtr).Height \ Screen.TwipsPerPixelY
   hMenuID = GetSubMenu(GetMenu((Me.hwnd)), 1)

   hTempDC = CreateCompatibleDC(Picture1(nLoopCtr).hdc)

   For nLoopCtr = 0 To 3
       hBitmap = CreateCompatibleBitmap(Picture1(nLoopCtr).hdc, nWidth,
                 nHeight)

       lTempID = SelectObject(hTempDC, hBitmap)

       lResult = BitBlt(hTempDC, 0, 0, nWidth, nHeight,
(Picture1(nLoopCtr).
                 hdc), 0, 0, SRCCOPY)

       lTempID = SelectObject(hTempDC, lTempID)

       mnuFaceSel(nLoopCtr).Caption = ""

       lResult = ModifyMenu(hMenuID, nLoopCtr, MF_BYPOSITION Or MF_BITMAP,
                 GetMenuItemID(hMenuID, nLoopCtr), hBitmap)

   Next nLoopCtr

   lResult = DeleteDC(hTempDC)
End Sub
将如下的代码添加到“退出”子菜单的单击事件中：
Private Sub mnuExit_Click(Index As Integer)
   Select Case Index
       Case 0
           Unload Me
   End Select
End Sub
运行该样例程序，单击“脸谱”菜单，则会看到由4个脸谱图标所形成的位图子菜单
项，单击“文件”\“退出”菜单可退出应用程序。
　

从全路径名中提取文件名
从全路径名中提取文件名 98-6-06
Function StripPath(T$) As String
Dim x%, ct%
StripPath$ = T$
x% = InStr(T$, "\")
Do While x%
ct% = x%
x% = InStr(ct% + 1, T$, "\")
Loop
If ct% > 0 Then StripPath$ = Mid$(T$, ct% + 1)
End Function
例子：
File = StripPath("c:\windows\hello.txt")

打开 Internet 拨号连接窗口
在程序中打开 Internet 拨号连接窗口 98-6-19
Private Sub StartConnection()
Dim X
X = Shell("rundll32.exe rnaui.dll,RnaDial " & "_连接的名称_", 1)
DoEvents
SendKeys "{enter}", True
DoEvents
End Sub

打开 Win95 的创建快捷方式窗口
打开 Win95 的创建快捷方式窗口
以下的代码演示了如何利用 Win95 的 Wizard 在指定的目录中建立快捷方式。

Dim X As Integer
X = Shell("C:\WINDOWS\rundll32.exe AppWiz.Cpl,NewLinkHere " & App.Path & "\", 1)

打开和关闭CD-ROM 驱动器
打开和关闭CD-ROM 驱动器 98-7-09
声明：
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  
使用：
'打开
retvalue = mcisendstring("set CDAudio door open", returnstring, 127, 0)
'关闭
retvalue = mcisendstring("set CDAudio door closed", returnstring, 127, 0)