使用未安装的字体
使用未安装的字体 98-6-19
声明：
Declare Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFileName As String) As Long
Declare Function RemoveFontResource Lib "gdi32" Alias "RemoveFontResourceA" (ByVal lpFileName As String) As Long
增加字体：
Dim lResult As Long
lResult = AddFontResource("c:\myApp\myFont.ttf")
删除字体：
Dim lResult As Long
lResult = RemoveFontResource("c:\myApp\myFont.ttf")

锁住数据库中的表
锁住数据库中的表 98-8-02
把表达式 True=False 放到表的 ValidationRule 属性就能锁上。 HardLockTable  实现了该功能。

声明
Public MyDB As Database
Dim Dummy As Integer

函数
Function HardLockTable (ByVal whichAction As String,  ByVal aTable As String) As Integer
On Error GoTo HardLockTableError
HardLockTable = True
Select Case whichAction
Case "Lock"
MyDB.TableDefs(aTable).ValidationRule = "True=False"
MyDB.TableDefs(aTable).ValidationText =  "This table locked via " &   "ValidationRule on " & Now
Case "UnLock"
MyDB.TableDefs(aTable).ValidationRule = ""
MyDB.TableDefs(aTable).ValidationText = ""
Case "TestThenUnLock"
If MyDB.TableDefs(aTable).ValidationRule = "True=False" Then
MyDB.TableDefs(aTable).ValidationRule = ""
MyDB.TableDefs(aTable).ValidationText = ""
End If
End Select
HardLockTableErrorExit:
'subFlushDBEngine
'optional, see next suggestion
Exit Function
HardLockTableError:
HardLockTable = False
MsgBox Error$ & " error " & "in HardLockTable trying " & "to " & whichAction & " " & aTable
Resume HardLockTableErrorExit
End Function

使用例子
'上锁
Dummy = HardLockTable("Lock", "TestTable")
' 开锁
Dummy = HardLockTable("UnLock", "TestTable")

添加记录到文档菜单
添加记录到文档菜单 98-6-05
最近用过的文件会自动出现在文档菜单中，只要用很少的代码，在你的程序中也可实现这样的功能：
声明：
Public Const SHARD_PATH = &H2&
Public Declare Function SHAddToRecentDocs Lib "shell32.dll" (ByVal dwFlags As Long, ByVal dwData As String) As Long
函数：
Public Sub AddRecent(strFile As String)
Dim lRetVal As Long
If strFile = "" Then
lRetVal = SHAddToRecentDocs(SHARD_PATH, vbNullString)
Else
lRetVal = SHAddToRecentDocs(SHARD_PATH, strFile)
End If
End Sub
例子：
AddRecent "C:\myfile.txt"
AddRecent "" '清除文档菜单

透明的窗口
004 透明的窗口 98-7-04
声明：
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Const WS_EX_TRANSPARENT = &H20&
Const GWL_EXSTYLE = (-20)
使用：
retval = SetWindowLong(Form2.hwnd, GWL_EXSTYLE, WS_EX_TRANSPARENT)
透明效果是出来啦，如果移动的话，屏幕会变乱。

突破 SendKeys 的限制
突破 SendKeys 的限制 98-8-22
SendKeys 不能实现一些特殊的键， 如 Alt+PrintScr 。 不过使用 API ，可以改变这样的状况。
声明：
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal  bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
使用：
' 一个抓屏的例子
Const VK_SNAPSHOT As Byte = &H2C
' 把应用窗口图象放到剪贴板：
Call keybd_event(VK_SNAPSHOT, 0, 0, 0)
'  把整个屏幕抓到剪贴板：
Call keybd_event(VK_SNAPSHOT, 1, 0, 0)
可以用该方法抓 AVI 图象。

退出并关闭 Windows
退出并关闭 Windows 98-6-06
声明：
Global Const EWX_LOGOFF = 0
Global Const EWX_REBOOT = 2
Global Const EWX_SHUTDOWN = 1
Declare Function ExitWindows Lib "User32" Alias "ExitWindowsEx" (ByVal dwOptions As Long, ByVal dwReserved As Long) As Long
使用：
lresult = ExitWindowsEx(EWX_SHUTDOWN, 0&) '关闭计算机
lresult = ExitWindowsEx(EWX_REBOOT, 0&) '重新启动计算机

拖动无系统标准标题栏的窗口
大家知道，在VB中可以通过设置Form的属性，制作无系统标题栏的窗口。可是，由于失去了系统标题栏，如何使用鼠标拖动窗口便成了一个棘手的问题。其实，借助API函数ReleaseCapture和SendMessage，这个问题便可迎刃而解了。

　　首先，在module文件中加入下列声明语句：

　　Declare Sub ReleaseCapture Lib"User"()

　　Declare Function SendMessage Lib"User"(ByVal hWnd _

As Integer，ByVal wMsg As Integer，ByVal wParam As Integer，_lParam As Any)As Long

　　Public Const WM_SYSCOMMAND=&H112

　　Public Const SC_MOVE=&HF010

　　Public Const HTCAPTION=2

　　然后，在Form的MouseDown事件中加入下列代码：

　　ReleaseCapture

　　Ret&=SendMessage(Me．hWnd，WM_SYSCOMMAND，_SC_MOVE+HTCAPTION，0)

　　……

　　程序运行后，只要当光标落在Form区域时按住鼠标左键，便可以拖动窗口了。在一些要求生动活泼的界面的程序设计中，开发者常常希望自制风格独特的标题栏，以满足整个界面的要求。通过这个方法，就可以使自制的标题栏达到乱真的地步。不过，用作自制标题栏的控件，必须具有MouseDown事件以摆放上述代码。

系统菜单上的图标
系统菜单上的图标
在 Windows 95 的系统工具栏（“开始”按钮的工具栏）上加上自己的图标似乎是一件很时髦的事。在 VB5 中，我们可以用比较简单的方法地实现这一技术：VB5 的企业版及专业版的 CD-ROM 上其实提供了许多有关 VB 的一些很有用的东西。我们现在讨论的问题的解决方法也在此列。打开你的 CD-ROM，在 \TOOLS\UNSUPPRT\SYSTRAY 这个目录里就提供了一个 ActiveX 控件的源代码。此控件的目的就是在系统菜单上加上自己的图标。你可以把它编译成一个 OCX 供调用或直接在程序里面包含此模块。

系统启动时自动运行
问题：
   如何在注册表Run键中加入相应条目？

回应：
  现举例回答此问题：
   现有一应用程序如：C:\ProgramFiles\Myapp.EXE, 要想在 WIN95 启动时自动运行，
   可加入如下代码：

   '窗体通用声明

Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long

Const REG_SZ = 1
Const HKEY_LOCAL_MACHINE= &H80000002

'通用过程

Sub SetMyValue(hKey As Long, strPath As String, strValue As String, strData As String)

Dim keyHandle&
Dim lResult As Long
lResult = RegCreateKey(hKey, strPath, keyHandle&)
lResult = RegSetValueEx(keyHandle&, strValue, 0, REG_SZ, ByVal strData, Len(strData))
lResult = RegCloseKey(keyHandle&)
End Sub

'调用方法

Private Sub Command1_Click()

SetMyValue HKEY_LOCAL_MACHINE,"SoftWare\Microsoft\Windows\CurrentVersion\Run","我的程序","C:\Program Files\Myapp.exe"

End Sub
                                  - 易传志

显示 Combo 的下拉条
显示 Combo 的下拉条 98-8-11
声明：
Public Declare Function SendMessageLong Lib  "user32" Alias "SendMessageA" (ByVal  hwnd As Long,  ByVal wMsg As Long,  ByVal wParam As Long,  ByVal  lParam As Long) As Long
Public Const CB_SHOWDROPDOWN = &H14F  
使用：
'程序控制显示下拉条
r = SendMessageLong(Combo1.hWnd, CB_SHOWDROPDOWN, True, 0)
'程序控制隐藏下拉条
r = SendMessageLong(Combo1.hWnd, CB_SHOWDROPDOWN, False, 0)