如何过滤键盘录入
如何过滤键盘录入
在 VB 的应用得到以前就处理键盘动作， 实现对键盘的全面控制， 可过滤任意的键。 下面的例子过滤了 CTRL+C 键， 并把该键模拟为在 Command1 上单击。

Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long

Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Public Const WH_KEYBOARD = 2
Public Const KBH_MASK = &H20000000
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202

Global hHook As Long

'KeyboardProc 在 VB 应用动作前发生
Public Function KeyboardProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If nCode >= 0 Then
'处理你希望过滤的键
If wParam = Asc("C") And (lParam And KBH_MASK) <> 0 Then
If (lParam And &HC0000000) = 0 Then
'模拟在Command1 中单击
Form1.Command1.SetFocus
Call PostMessage(Form1.Command1.hwnd, WM_LBUTTONDOWN, 0, &H20002)
Call PostMessage(Form1.Command1.hwnd, WM_LBUTTONUP, 0, &H20002)
KeyboardProc = 1
Exit Function
End If
End If
End If
KeyboardProc = CallNextHookEx(hHook, nCode, wParam, lParam)
End Function

Private Sub Form_Load()
'将 KeyboardProc 连接到中断上
hHook = SetWindowsHookEx(WH_KEYBOARD, AddressOf KeyboardProc, 0&, App.ThreadID)
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call UnhookWindowsHookEx(hHook)
End Sub

闰年测试
005 闰年测试
Function IsLeap(sYear As String) As Integer
   If IsDate("02/29/" & sYear) Then
       IsLeap = True
   Else
       IsLeap = False
   End If
End Function

设定鼠标位置
设定鼠标位置
声明：
Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
例子：
ret = SetCursorPos( X, Y) '(X,Y)为坐标，单位为 Pixel(像素)

设置计算机名称
设置计算机名称 98-8-11
声明：
Declare Function SetComputerName Lib "kernel32"  Alias "SetComputerNameA" (ByVal lpComputerName As  String) As Long
使用：
NewName = "Hello World"
SetComputerName  NewName

生成不同的8 位口令
Function GenPass() As String
i = 0
UseChar = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
word = ""
Randomize
For i = 1 To 8
word = word + Mid(UseChar, Len(UseChar) * Rnd + 1, 1)
Next i
GenPass = word
End Function

使窗口保持在最前面
使窗口保持在最前面
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 Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2

public sub SetFormOnTop(myForm as object)
SetWindowPos myForm.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE
end sub

使用 IIF 和 SWITCH 以精减代码
使用 IIF 和 SWITCH 以精减代码
在很多地方你都可以使用一个更紧凑的 IIf  函数来代替 If...Else...Endif 的结构：
例：返回两个值中较大的一个
maxValue = IIf(first >= second, first, second)
Switch 则是一个很少使用的函数，可是在很多方面它都提供比 If...ElesIf 结构更好的
例：判断 "x" 是正、负还是 null?
Print Switch(x<0,"负",x>0,"正", True, "Null")

使用 WIN95 的选择目录对话框
使用 WIN95 的选择目录对话框 98-7-05
声明：
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

Private Const BIF_RETURNONLYFSDIRS = 1
Private Const MAX_PATH = 260

Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" _
(ByVal lpString1 As String, ByVal lpString2 As String) As Long
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
函数：
Public Function BrowseForFolder(hWndOwner As Long, sPrompt As String) As String

Dim iNull As Integer
Dim lpIDList As Long
Dim lResult As Long
Dim sPath As String
Dim udtBI As BrowseInfo

With udtBI
.hWndOwner = hWndOwner
.lpszTitle = lstrcat(sPrompt, "")
.ulFlags = BIF_RETURNONLYFSDIRS
End With

lpIDList = SHBrowseForFolder(udtBI)
If lpIDList Then
sPath = String$(MAX_PATH, 0)
lResult = SHGetPathFromIDList(lpIDList, sPath)
Call CoTaskMemFree(lpIDList)
iNull = InStr(sPath, vbNullChar)
If iNull Then
sPath = Left$(sPath, iNull - 1)
End If
End If

BrowseForFolder = sPath

End Function

使用Win95的动画光标

                         使用Win95的动画光标

                              谭    翁

----在Windows 95系统中具有一个Windows 3.x所不具备的特性――支持动画的光标文件。你
可以在Windows 95目录中的Cursors子目录下看到这些动画的光标文件，它们均具有扩展名
*.ANI。在程序中使用相应的动画光标能够极大地改善程序的外观，本文介绍了如何在你的
Visual Basic应用程序中使用Windows 95所附带的动画光标文件。

使用动画光标文件

----要在Visual Basic的应用程序中使用Windows 95所附带的动画光标，你需要使用下列
Windows 应用程序编程接口（API）函数：

    LoadCursorFormFile，用于从磁盘上载入光标文件；
    ClipeCursor，用于将光标限制在一个固定的矩形区域内；
    GetWindowRect，用于获取该矩形区域，在下面的样例程序中就是程序主窗体的本身；
    SetClassLong，用于设置和提取窗口类的数据，以使光标被显示在窗体上；
    GetClassLong函数，在退出应用程序之前，需要将应用程序的缺省光标设置回程序执行
    以前的光标，所以需要在程序运行时首先对以前的光标状态进行备份，这项工作由该函
    数来完成；
    DestroyCursor，在正确显示了光标之后，需要使用该函数来取消载入的光标。

样例程序

----下面的样例程序将在窗体区域内显示出C:\WIN95\CURSORS目录下的APPSTART.ANI动画光
标文件，如果你的Windows 95路径不同的话，你需要修改样例程序以正确显示出动画光标。

 1.在Visual Basic中开始一个新的工程，采用缺省的方法建立Form1。
 2.在Form1上创建一个命令按钮控件，采用缺省的方法建立Command1。将它的Caption属性
    设置为“显示动画光标”。
 3.在Form1上创建第二个命令按钮控件，采用缺省的方法建立Command2。将它的Caption属
    性设置为“恢复缺省光标”。
 4.创建一个新的模块，采用缺省的方法建立Module1.Bas。将如下的声明，类型和常量语
    句添加到Module1.Bas的通用声明部分中：

    Option Explicit
    Type RECT
            Left As Long
            Top As Long
            Right As Long
            Bottom As Long
    End Type
    Public Const GCL_HCURSOR = (-12)
    Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long
    Declare Function DestroyCursor Lib "user32" (ByVal hCursor As Long) As Long
    Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA"
     (ByVal lpFileName As String) As Long
    Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long,
     lpRect As RECT) As Long
    Declare Function SetClassLong Lib "user32" Alias "SetClassLongA"
     (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Declare Function GetClassLong Lib "user32" Alias "GetClassLongA"
     (ByVal hwnd As Long, ByVal nIndex As Long) As Long

    注意上面的声明语句需要书写在一行内。

 5.将如下的语句添加到Form1的通用声明部分中：

    Option Explicit
    Dim mhBaseCursor As Long
    Dim mhAniCursor As Long

 6.将如下的代码添加到Form1的Form_Load事件中：

    Private Sub Form_Load()
        Dim lResult As Long
        
        mhBaseCursor = GetClassLong((Me.hwnd), GCL_HCURSOR)
    End Sub

 7.将如下的代码添加到Command1的单击事件中：

    Private Sub Command1_Click()
        Dim lResult As Long
        Dim RT_FormArea As RECT
        
        mhAniCursor = LoadCursorFromFile("c:\win95\cursors\appstart.ani")
        
        lResult = SetClassLong((Me.hwnd), GCL_HCURSOR, mhAniCursor)
        
        lResult = GetWindowRect((Me.hwnd), RT_FormArea)
        
        lResult = ClipCursor(RT_FormArea)
    End Sub

 8.将如下的代码添加到Command2的单击事件中：

    Private Sub Command2_Click()
        Dim lResult As Long
        Dim RT_ScreenArea As RECT
        
        RT_ScreenArea.Top = 0
        RT_ScreenArea.Left = 0
        RT_ScreenArea.Bottom = Screen.Height \ Screen.TwipsPerPixelX
        RT_ScreenArea.Right = Screen.Width \ Screen.TwipsPerPixelY
        lResult = ClipCursor(RT_ScreenArea)
        lResult = SetClassLong((Me.hwnd), GCL_HCURSOR, mhBaseCursor)
        lResult = DestroyCursor(mhAniCursor)
    End Sub

    ----通过按下F5键来运行该程序，单击“显示动画光标”命令按钮，则在窗体的范围内
    光标变成为APPSTART.ANI光标，并且光标被限制在窗体的范围内。单击“恢复缺省光
    标”命令按钮，则窗体中的光标被恢复为缺省的光标。注意，在退出该样例程序之前，
    需要单击“恢复缺省光标”命令按钮，否则将不能在系统中正确进行其它操作。

                   中国计算机世界出版服务公司版权所有

使用数组做属性
使用数组做属性
定义一个 variant 类型的属性，即可用它来做数组。
下面定义了一个 CArray 类。

Private m_MyArray As Variant

Public Property Get MyArray() As Variant
MyArray = m_MyArray
End Property

Public Property Let MyArray(a As Variant)
   m_MyArray = a
End Property

可用以下的方法使用：

Private m_Array As CArray
Private mArr(3) As String

Private Sub Form_Load()
   Set m_Array = New CArray
   mArr(1) = "One"
   mArr(2) = "Two"
   mArr(3) = "Three"
   m_Array.MyArray = mArr()
   '或者
   'm_Array.MyArray = Array("One", "Two", "Three")
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim i As Integer
   For i = 1 To UBound(m_Array.MyArray)
       MsgBox m_Array.MyArray(i)
   Next
End Sub