118、反向思考---怎样让程序跑慢一点？(二)
原来我们提到了使用 Sleep API 来达到让程序暂停的方法，方法很简单，程序码也很简短，但是美中不足的是，它只能用在 32 位元的环境中！
难道在 16 位元的环境中就没办法了吗？或者，一定要使用 API 吗？
还是有办法的，而且不用 API，最棒的是所有版本的 VB 都可使用！
'在您的程序中，加入以下的模组：
Public Sub Delay(HowLong As Date)
TempTime = DateAdd("s", HowLong, Now)
While TempTime > Now
DoEvents '让 windows 去处理其他事
Wend
End Sub
'在程序中只要如下使用即可：
Private Sub Command1_Click()
Delay 5
End Sub
119、列出电脑中所有磁盘
我们曾讨论过使用 GetDriveType API 再加上回圈一个一个判断磁盘的型态，再列在 ListBox 中供选择。但是在实际应用程序中，有时候我们根本不需要知道各个磁盘的型态，我们的目的只是很单纯地让使用者来挑选档案的位置而已！例如趋势科技的 Pccillin 要从磁盘 Upgrade 病毒码时，它会询问您磁盘代号，就是使用这种作法！
这时候，我们可以换一种更快的方式，(只是有人认为不能顺便列出磁盘型态仍是一种缺点) 如下：
'在声明区中加入以下声明：
Const LB_DIR = &H18D 'LB 即是 ListBox 的缩写
Const DDL_DRIVES = &H4000
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
Public Function AddDrives2ListBox(lhWnd As Long)
Call SendMessage(lhWnd, LB_DIR, DDL_DRIVES, "*")
End Function
'而程序中之使用方法如下：(只有一个参数，就是 ListBox 的 hwnd)
Private Sub Form_Load()
AddDrives2ListBox List1.hwnd
End Sub
有人问我，ListBox 的很多功能都和 ComboBox 很像，这个例子，可以使用 ComboBox 吗？
可以的，也不难，将声明区的声明改成：
Const CB_DIR = &H145 'CB 即是 ComboBox 的缩写
Const DDL_DRIVES = &H4000
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
Public Function AddDrives2ComboBox(lhWnd As Long)
Call SendMessage(lhWnd, CB_DIR, DDL_DRIVES, "*")
End Function
'而程序中之使用方法如下：(只有一个参数，就是 ComboBox 的 hwnd)
Private Sub Form_Load()
AddDrives2ComboBox Combo1.hwnd
End Sub
120、模拟【网路上的芳邻】及【我的电脑】中的【连线 / 中断网路磁盘】(二)
对于实际的网路作业，WNet API 是非常有用的，例如：我们在《问题93》模拟【网路上的芳邻】及【我的电脑】中的【连线 / 中断网路磁盘】中我们就使用了 WNetAddConnection 及 WNetCancelConnection 这二个 API 很有效地来处理连线及中断网路磁盘，但是我们不知道每一个使用者电脑中的实际设定，使用直接指定的强迫连线及中断，或许会影响使用者原本电脑中的设定。
下面的方法是一个比较中性的作法，就是出现【连线 / 中断网路磁盘】的问话框，让使用者根据自己电脑的情形，来决定要连线的网路磁盘要对应到自己的那一个磁盘？要中断的又是那一个对应的磁盘？其实，这个方法更接近实际模拟【网路上的芳邻】及【我的电脑】中的【连线 / 中断网路磁盘】！
请在声明区中加入以下声明及模组：
Private Declare Function WNetConnectionDialog Lib "mpr.dll" (ByVal hwnd As Long, ByVal dwType As Long) As Long
Private Declare Function WNetDisconnectDialog Lib "mpr.dll" (ByVal hwnd As Long, ByVal dwType As Long) As Long
Sub ShowMapDrives(hwnd As Long)
WNetConnectionDialog hwnd, 1
End Sub
Sub ShowUnMapDrives(hwnd As Long)
WNetDisconnectDialog hwnd, 1
End Sub
'程序中使用方式如下：
Private Sub Command1_Click()
'出现 连线网路磁盘 问话框
ShowMapDrives Me.hwnd
End Sub
Private Sub Command2_Click()
'出现 中断网路磁盘 问话框
ShowUnMapDrives Me.hwnd
End Sub
121、取得印表机的连接埠
在测试上一个《问题 100》模拟【网路上的芳邻】及【我的电脑】中的【连线 / 中断网路磁碟机】 (二) 时，我们用到了 WNetConnectionDialog API，这个 API 又让我想到了另一个小功能！
您设定过印表机吗，如果有，在设定印表机时，设定问话框中有一个 Tab 是【详细资料】页，在此页中有一个按钮是让我们《取得印表机连接埠》，WNetConnectionDialog 这个 API 的功能之一就是叫出《取得印表机连接埠》问话框！
'一样在声明区中加入以下声明：
Private Declare Function WNetConnectionDialog Lib "mpr.dll" (ByVal hWnd As Long, ByVal dwType As Long) As Long
Sub ShowPrinterPort(hWnd As Long)
WNetConnectionDialog hWnd, 2
End Sub
'在程序中使用方法如下：
Private Sub Command1_Click()
ShowPrinterPort Me.hWnd
End Sub
122、读取及设定文件的属性
当我们在任一个文件上按滑鼠右键，选择【内容】，在文件内容的【一般】页签中我们可以看到每一个文件有四个属性：保存、只读、隐藏及系统。
使用 GetFileAttributes 及 SetFileAttributes 二个 API 我们就可以读取及设定这四个属性。
'请在声明区中加入以下声明：
'设定文件属性
Private Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long
'读取文件属性
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Const FILE_ATTRIBUTE_READONLY = &H1 '设定为只读
Const FILE_ATTRIBUTE_HIDDEN = &H2 '设定为隐藏
Const FILE_ATTRIBUTE_SYSTEM = &H4 '设定为系统
Const FILE_ATTRIBUTE_ARCHIVE = &H20 '设定为保存
Const FILE_ATTRIBUTE_NORMAL = &H80 '设定为一般 (取消前四种属性)
'要设定二种以上的属性可以用 or 串联以上之属性，来看看例子：
'设定 db1.mdb 为只读
SetFileAttributes "c:\db1.mdb", FILE_ATTRIBUTE_READONLY
'设定 db1.mdb 为只读 + 隐藏
SetFileAttributes "c:\db1.mdb", FILE_ATTRIBUTE_READONLY Or FILE_ATTRIBUTE_HIDDEN
'设定 db1.mdb 为只读 + 隐藏 + 系统 + 保存
SetFileAttributes "c:\db1.mdb", FILE_ATTRIBUTE_READONLY Or FILE_ATTRIBUTE_HIDDEN _
Or FILE_ATTRIBUTE_SYSTEM Or FILE_ATTRIBUTE_ARCHIVE
'取消 db1.mdb 所有设定
SetFileAttributes "c:\db1.mdb", FILE_ATTRIBUTE_NORMAL
'要读取文件目前的属性，则是用 GetFileAttributes API，以读取 db1.mdb 为例：
MsgBox GetFileAttributes("c:\db1.mdb")
'返回值如上面的常数声明值，例如：
'若返回值为 6 ( =2+4 ) 表示此文件为 隐藏 + 系统
'但是若返回值为 128 表示此文件未设定任何属
123、避免 Null 产生的错误
当我们从资料库读出资料时，有的栏位之内容可能为 Null，若不加以处理而要将资料搬给某一栏位时，会有错误产生，虽然 VB 本身有提供一个 IsNull 函数以供判断，但是您知道吗，我写了这么多年的 VB 资料库程序，从来没有用过 IsNull 来判断资料库栏位值，为什么呢？我又怎么做呢？
其实很简单，我不管从资料库读出来的是不是 Null，写法一律如下：
Text1.text = rs1("Field1") & ""
如果这个栏位的值是 Null，加上 ( ＆ 〃 ) 之後就变成了 "" 了！
但是要小心，我的新同事们常常会犯一个错误，我们看看以下二个式子：
1、Text1.text = Trim(rs1("Field1")) & "" ' ( 可能是错的 )
2、Text1.text = Trim(rs1("Field1") & "") ' ( 这样写才对 )
第一个式子如果栏位值是 Null，使用 trim$ 便会产生错误，对於这些状况，其实只要记住一个原则即可：
不管从资料库读出之资料要做什么动作，不管三七二十一先加上 ( ＆ 〃 ) 就对了
再来看看一个例子，以加深印象：
Text1.text = Format( (rs1("Field1") & ""), "yymmdd")
124、如何找出 Windows 目录的正确路径？
有时候我们在程序中必须用到 Windows 的目录，以存取 Windows 目录下的文件，照理说，这应该是最简单的功能，前提是每个人在 Setup Windows 必须采用 Windows 的预设目录名称，也就是 C:\Windows，但是常常不是这样，有时候由于要使新旧版本共存，或者其他原因，有人会将 Windows 目录改成 c:\win95、c:\win98、Windows95 或 Windows98......
若是程序中必须用到 Windows 目录，要找到正确的路径，做法如下：
'在声明区中加入以下声明：
Const MAX_PATH = 260
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Function GetWinPath()
Dim strFolder As String
Dim lngResult As Long
strFolder = String(MAX_PATH, 0)
lngResult = GetWindowsDirectory(strFolder, MAX_PATH)
If lngResult <> 0 Then
GetWinPath = Left(strFolder, InStr(strFolder, Chr(0)) - 1)
Else
GetWinPath = ""
End If
End Function
'在程序中使用方法如下：
Private Sub Command1_Click()
Call MsgBox("您电脑中 Windows 目录的正确路径是： " & GetWinPath, vbInformation)
End Sub
125、如何找出 System 目录的正确路径？
和《问题104》如何找出 Windows 目录的正确路径？一样，由于有很多系统文件都放在 System 目录下，有时候我们在程序中必须用到 System 的目录，以存取 System 目录下的文件，但是有时候由於要使新旧版本共存，或者其他原因，有人会将 Windows 目录改成 c:\win95、c:\win98、Windows95 或 Windows98......
若是程序中必须用到 System 目录，要找到正确的路径，做法如下：
'在声明区中加入以下声明：
Const MAX_PATH = 260
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Function GetSystemPath()
Dim strFolder As String
Dim lngResult As Long
strFolder = String(MAX_PATH, 0)
lngResult = GetSystemDirectory(strFolder, MAX_PATH)
If lngResult <> 0 Then
GetSystemPath = Left(strFolder, InStr(strFolder, Chr(0)) - 1)
Else
GetSystemPath = ""
End If
End Function
'在程序中使用方法如下：
Private Sub Command1_Click()
Call MsgBox("您电脑中 System 目录的正确路径是：" & GetSystemPath, vbInformation)
End Sub
126、如何找出 Temp 目录的正确路径？
有时候，我们的 VB 程序在执行时，会产生一些文件，或许只是暂存档，这时您可以考虑放在 Windows 的 Temp 目录下，这个目录在预设的情形下是在 c:\windows\temp，但是， User 有时候由于要使新旧版本共存，或者其他原因，有人会将 Windows 目录改成 c:\win95、c:\win98、Windows95 或 Windows98......
若是程序中必须用到 Temp 目录，要找到正确的路径，做法如下：
'在声明区中加入以下声明：
Const MAX_PATH = 260
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Function GetTmpPath()
Dim strFolder As String
Dim lngResult As Long
strFolder = String(MAX_PATH, 0)
lngResult = GetTempPath(MAX_PATH, strFolder)
If lngResult <> 0 Then
GetTmpPath = Left(strFolder, InStr(strFolder, Chr(0)) - 1)
Else: GetTmpPath = ""
End If
End Function
'在程序中使用方法如下：
Private Sub Command1_Click()
Call MsgBox("您电脑中 Temp 目录的正确路径是" & GetTmpPath, vbInformation)
End Sub
127、建立 Windows95/98 的快捷方式
在前面我们提到过快捷方式，不过当时提到的快捷方式是专门用于连结 Internet 的网页使用的，现在我们要谈的则是在 Windows95/98 中的一般快捷方式，也就是要放在【开始】或【桌面】上，方便使用者启动程序的快捷方式！
'请在声明区中加入以下的声明：(以下为 VB4-32 / VB5)
'VB4-32
Declare Function fCreateShellLink Lib "STKIT432.DLL" (ByVal lpstrFolderName as String, ByVal lpstrLinkName as String, ByVal lpstrLinkPath as String, ByVal lpstrLinkArgs as String) As Long
'VB5
Declare Function OSfCreateShellLink Lib "VB5STKIT.DLL" Alias "fCreateShellLink" (ByVal lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal lpstrLinkPath As String, ByVal lpstrLinkArguments As String) As Long
'参数说明：
lpstrFolderName 要放置快捷方式的位置，但是指的是对应到【开始】的【程序】的相对位置
【程序】的实际目录位置是 C:\Windows\Start Menu\Programs
【桌面】的实际目录位置是 C:\Windows\Desktop
所以如果想将快捷方式放在桌面上，此参数的设定值应为 "..\..\Desktop"
lpstrLinkName 快捷方式要显示出来的说明文字
lpstrLinkPath 快捷方式要开启或执行的文件的实际位置
lpstrLinkArgs 开启或执行的文件若需要参数，则放在这
'在程序中使用的方法如下：
lngResult = fCreateShellLink("..\..\Desktop", "记事本捷径", " c:\windows\notepad.exe","")
128、如何用 VB 呼叫出在【查找：所有文件】中的【浏览资料夹】问话框？
相信大家都使用过 Windows 95/98 的【开始】【查找】【文件或资料夹...】功能，当然【查找】的功能不一定要从【开始】开始，在 Windows 的很多地方，例如【资源管理器】或【我的电脑】...等，都可以按下滑鼠右键来使用【查找】的功能。
在【查找：所有文件】问话框中，在【名称及位置】页中，有一个【浏览】的按钮，按下后会出现一个大家似曾相识的问话框，叫作【浏览资料夹】问话框，在这个问话框中，您可以看到电脑中所有的磁盘及资料夹，您知道在 VB中要如何呼叫它吗？
'请在声明区中加入以下声明：
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260
Private Declare Function SHBrowseForFolder Lib "shell32" _
(lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
'在 Form 中放一个 CommandButton，并加入以下程序：
Private Sub Command1_Click()
Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo
szTitle = "请选择要开始搜寻的资料夹" '<-- 此标题可根据 要自行更改
With tBrowseInfo
.hWndOwner = Me.hWnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
MsgBox sBuffer
End If
End Sub
'好了，执行您的程序，按下按钮看看结果吧！
129、让您的文字框有 Undo / Redo 的功能
很多软件都有提供 Undo / Redo 的功能，Microsoft 的产品都可以提供多次 Undo 反悔，功能更强大！
在 VB 的程序中，我们也可以提供这样的功能！不过只能 Undo / Redo 一次
'在声明区中加入以下声明：
'32位元
'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 EM_UNDO = &HC7
'16位元
Private Declare Function SendMessage Lib "User" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
Const WM_USER = &H400
Const EM_UNDO = WM_USER + 23
'在程序中使用的方式如下： ( Undo Text1 中的输入 )
Private Sub Command1_Click()
Dim UndoResult As Long
UndoResult = SendMessage(Text1.hwnd, EM_UNDO, 0, 0)
'传回值 UndoResult = -1 表示 Undo 不成功
End Sub
'使用以上的方法，第一次是 Undo ，第二次就等于是 Redo
130、如何使点矩阵印表机一次只印一行
VB 有提供一个 Printer 物件来帮我们做列印，但是，当我们使用点矩阵印表机列印时，若希望每次只列印一行资料后，印表机不要自动跳页，继续等待列印！这时候往往造成很多人的困扰，因为：若不使用 NewPage 和 EndDoc 方法就不会立刻印出，但是用了又会跳页。
这时候，我们就不能再使用 Printer 物件，然而我们可以用以前在 Dos 时代使用的方法如下：
Open "PRN" For Output As #1
Print #1,"列印内容"
但是有一点必须注意的是：上面这个方式绝对可以单行列印英文，但是若你想印中英文, 你的印表机必须有内建中文字体才行！
131、Printer 物件如何控制打印机跳页至指定的地方?
在网站上有人提出这样的问题：
用 VB6 写一打印程序,打印机是点矩阵的,而纸张为公司特别定做的,所以当用 EndDoc 方法打印时,无法控制打印机跳页至指定的地方(就是可用手撕纸的那一条虚线)
VB 的 Printer 物件提供的 EndDoc 会自动根据我们设定的纸张大小，自动跳到下一页，但是当我们所使用的纸张是特殊大小时 (很多套印的表格都是特殊大小的尺寸)，若要让打印机的跳页正常，并不需更改我们的程序，要更改的是我们机器上该打印机的纸张大小的设定。
1、开启【我的电脑】，开启【打印机】(或由【开始】或【控制面板】开启打印机)。
2、在该点矩阵打印机上按鼠标右键选择【内容】，出现该打印机的【内容】问话框。
3、选择【纸张】页签。
4、纸张大小选择【自订】，会出现【使用者定义大小】问话框。
5、输入纸张的宽度和长度，单位有二种 ( 0.01英寸 / 0.1公 )
用以上的方法设定好后，您就可以不用管纸张大小了，下一次它换页时就会自动跳页至指定的地方。
132、如何在按下 Enter 键之后，自动让 Focus 移到下一个物件？
如果您希望使用者在 TextBox 中按下 Enter 键之后，能够让 Focus 在各个物件之间游移，在 KeyPress 事件中您就必须判断是否有按下 Enter 键，如果有的话，您就必须取消 Enter 键，并送出一个 Tab 键。
在 VB 中，当您送出一个 Tab 键后，游标会依照 TabIndex 的顺序，在各物件之间移动。
若要照 TabIndex 顺序移动，指令为 SendKeys "{tab}"
若要照 TabIndex 反顺序移动，指令为 SendKeys "+{tab}"
其实以上的方法不只适用于 TextBox 物件，很多物件都适用这个原则，但是 CommandButton 就不行了！因为 CommandButton 根本就没有 KeyPress 事件！
以下是一段范例程序：
Sub Text1_KeyPress (KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
133、如何隐藏及显示任务栏？
有时候，我们希望在我们的程序执行中，将任务栏隐藏，让桌面变得比较清爽，等到我们的程序执行完毕之后，再将任务栏显示出来，这时就要用到 SetWindowPos 这个 API 了！
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
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Const SWP_HIDEWINDOW = &H80 '隐藏视窗
Const SWP_SHOWWINDOW = &H40 '显示视窗
'在程序中若要隐藏任务栏
Private Sub Command1_Click()
Dim Thwnd As Long
Thwnd = FindWindow("Shell_traywnd", "")
Call SetWindowPos(Thwnd, 0, 0, 0, 0, 0, SWP_HIDEWINDOW)
End Sub
'在程序中若要再显示任务栏
Private Sub Command2_Click()
Dim Thwnd As Long
Thwnd = FindWindow("Shell_traywnd", "")
Call SetWindowPos(Thwnd, 0, 0, 0, 0, 0, SWP_SHOWWINDOW)
End Sub
134、取得应用程序执行的路径
有时候执行我们的应用程序时，会用到一些和应用程序相关的文件，例如资料库、图档、文字档...等，这些文件我们通常都会放在和应用程序相同的目录或子目录中，于是在我们的应用程序中便有抓取应用程序现行目录的 求，在此我们介绍二种方法：
1、App.Path：返回值自动转为大写。
2、CurDir：返回值为大小写混合。
使用范例如下：
Private Sub Command1_Click()
Text1.text = App.Path
Text2.text = CurDir
End Sub
135、清除 ListBox 及 ComboBox 中重复的项目
当我们要将一大堆资料加入 ListBox 或 ComboBox 时，为了不让 ListBox 或 ComboBox 中的项目重复，有些人会在将新项目加入 ListBox 或 ComboBox 时，就先作项目比对，资料没有重复时，才将资料加入 ListBox 或 ComboBox 中。
但是如果我们将资料统统加入 ListBox 或 ComboBox 之后，再来执行比对动作，不但程序容易维护，而且速度会加快一点点，以下的模组就是做项目比对，以清除 ListBox 或 ComboBox 中重复的项目。
模组中需要传入二个参数，说明如下：
1、控制项名称：可传入 ListBox 或 ComboBox 的名称。
2、是否分别大小写：True 表示要分别大小写，False 则不分大小写。
Sub RemoveDups(lst As Control, comptype As Boolean)
Dim lPos As Long '原始比对项目 index
Dim lCompPos As Long '待比对项目 index
Dim sComp As String '原始比对字串
Dim sComptype As Long '0(binary) / 1(textual) 比对
lPos = 0
If comptype Then sComptype = 0 Else sComptype = 1
Do While lPos < (lst.ListCount - 1)
sComp = lst.List(lPos)
lCompPos = lPos + 1
Do While lCompPos < lst.ListCount
If StrComp(sComp, lst.List(lCompPos), sComptype) = 0 Then
lst.RemoveItem lCompPos
lCompPos = lCompPos - 1
End If
lCompPos = lCompPos + 1
Loop
lPos = lPos + 1
Loop
End Sub
'在程序中使用方式如下：
'要分别大小写
Private Sub Command1_Click()
RemoveDups List1, True
RemoveDups Combo1, True
End Sub
'不分别大小写
Private Sub Command2_Click()
RemoveDups List1, False
RemoveDups Combo1, False
End Sub
136、找出电脑中已经安装的输入法
'在 Form 中加入一个 ListBox，在声明区中加入以下声明：
Private Declare Function GetKeyboardLayoutList Lib "user32" (ByVal nBuff As Long, lpList As Long) As Long
Private Declare Function ImmGetDescription Lib "imm32.dll" Alias "ImmGetDescriptionA" (ByVal HKL As Long, ByVal lpsz As String, ByVal uBufLen As Long) As Long
Private Declare Function ImmIsIME Lib "imm32.dll" (ByVal HKL As Long) As Long
'在 Form_Load 中加入以下程序码：
Private Sub Form_Load()
Dim No As Long, i As Long
Dim hKB(24) As Long, bufflen As Long
Dim buff As String, RetStr As String, RetCount As Long
buff = String(255, 0)
No = GetKeyboardLayoutList(25, hKB(0))
For i = 1 To No
If ImmIsIME(hKB(i - 1)) = 1 Then
bufflen = 255
RetCount = ImmGetDescription(hKB(i - 1), buff, bufflen)
RetStr = Left(buff, RetCount)
List1.AddItem RetStr
Else
RetStr = "English(American)"
List1.AddItem RetStr
End If
Next
End Sub
评论