VB使用API的例子

 1. 如何消除textbox中按下回車時的beep聲？
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
End If
End Sub
*****************************************************************************
2.Textbox獲得焦點時自動選中。
Private Sub Text1_GotFocus()
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End Sub
*****************************************************************************
3.屏蔽textbox控件自身的右鍵菜單，並顯示自己的菜單。
方法一：
Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y _
As Single)
If Button = 2 Then
Text1.Enabled = False
Text1.Enabled = True
PopupMenu mymenu
End If
End Sub

方法二：回調函數
module：
Option Explicit
Public OldWindowProc As Long ' 保存默認的窗口函數的地址
Public Const WM_CONTEXTMENU = &H7B ' 當右擊文本框時，產生這條消息
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd _
As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd _ As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal _ lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Function SubClass_WndMessage(ByVal hWnd As Long, ByVal Msg As Long, ByVal wp _
As Long, ByVal lp As Long) As Long
' 如果消息不是WM_CONTEXTMENU，就調用默認的窗口函數處理
If Msg <> WM_CONTEXTMENU Then
SubClass_WndMessage = CallWindowProc(OldWindowProc, hWnd, Msg, wp, lp)
Exit Function
End If
SubClass_WndMessage = True
End Function
窗體中：
Private Const GWL_WNDPROC = (-4)
Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y _
As Single)
If Button = 1 Then Exit Sub
OldWindowProc = GetWindowLong(Text1.hWnd, GWL_WNDPROC) ' 取得窗口函數的地址
' 用SubClass_WndMessage代替窗口函數處理消息
Call SetWindowLong(Text1.hWnd, GWL_WNDPROC, AddressOf SubClass_WndMessage)
End Sub
Private Sub Text1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then Exit Sub
' 恢復窗口的默認函數
Call SetWindowLong(Text1.hWnd, GWL_WNDPROC, OldWindowProc)
PopupMenu mymenu
End Sub
*****************************************************************************
4. 設置TEXTBOX爲只讀屬性
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
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd _ As Long, ByVal nIndex As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const EM_SETREADONLY = &HCF
Private Sub Command1_Click()
Dim l As Long
If (GetWindowLong(Text1.hwnd, GWL_STYLE) And &H800) Then
Text1.Text = "This is a read/write text box." '文本窗口是隻讀窗口,設置爲可讀寫窗口
l = SendMessage(Text1.hwnd, EM_SETREADONLY, False, vbNull)
Text1.BackColor = RGB(255, 255, 255) '將背景設置爲白色
Command1.Caption = "Read&Write"
Else
Text1.Text = "This is a readonly text box." '文本窗口是可讀寫窗口,設置爲只讀窗口
l = SendMessage(Text1.hwnd, EM_SETREADONLY, True, vbNull)
Text1.BackColor = vbInactiveBorder '將背景設置爲灰色
Command1.Caption = "&ReadOnly"
End If
End Sub
*****************************************************************************
5. 利用API函數MessageBox代替MSGBOX函數可以使得Timer控件正常工作

Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As _ Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Private Sub Command1_Click()
MsgBox "時鐘變的無效了"
End Sub
Private Sub Command2_Click()
MessageBox Me.hwnd, "時鐘正常運行", "hehe", 0
End Sub
Private Sub Timer1_Timer()
Static i As Integer
i = i + 1
Text1.Text = i
End Sub
*****************************************************************************
6. 窗口置頂
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
Public Sub SetOnTop(ByVal IsOnTop As Integer)
Dim rtn As Long
If IsOnTop = 1 Then
rtn = SetWindowPos(Form1.hwnd, -1, 0, 0, 0, 0, 3)
Else
rtn = SetWindowPos(Form1.hwnd, -2, 0, 0, 0, 0, 3)
End If
End Sub
Private Sub Command1_Click()
SetOnTop 1 '將窗口置於最上面
End Sub
Private Sub Command2_Click()
SetOnTop 0
End Sub
*****************************************************************************
7.只容許運行一個程序實例（利用互斥體）

選擇啓動對象爲sub main()
module:
Public Declare Function CreateMutex Lib "kernel32" Alias "CreateMutexA" _ (lpMutexAttributes As SECURITY_ATTRIBUTES, ByVal bInitialOwner As Long, ByVal lpName _
As String) As Long
Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Public Const ERROR_ALREADY_EXISTS = 183&
Private Sub Main()
Dim sa As SECURITY_ATTRIBUTES
sa.bInheritHandle = 1
sa.lpSecurityDescriptor = 0
sa.nLength = Len(sa)
Debug.Print CreateMutex(sa, 1, App.Title) '這一行可千萬不能刪除啊
Debug.Print Err.LastDllError
If (Err.LastDllError = ERROR_ALREADY_EXISTS) Then
MsgBox "More than one instance"
Else
Form1.Show
End If
End Sub
*****************************************************************************
8.窗體標題欄閃爍
Option Explicit
Private Declare Function FlashWindow Lib "user32" (ByVal hwnd As Long, ByVal bInvert _
As Long) As Long
Private Sub tmrFlash_Timer()
Static mFlash As Boolean
FlashWindow hwnd, Not mFlash
End Sub
*****************************************************************************
8. 拷屏

方法一：利用模擬鍵盤
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, _ ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Const theScreen = 1
Const theForm = 0
Private Sub Command1_Click()
Call keybd_event(vbKeySnapshot, theForm, 0, 0) '若theForm改成theScreen則Copy整個Screen
DoEvents
Picture1.Picture = Clipboard.GetData(vbCFBitmap)
End Sub
*****************************************************************************
9. 爲程序註冊熱鍵

方法一：修改註冊表
Private Declare Function RegisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id _
As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Private Declare Function UnregisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id _
As Long) As Long
Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As Msg, _
ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal _
wRemoveMsg As Long) As Long
Private Declare Function WaitMessage Lib "user32" () As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type Msg
hWnd As Long
Message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
' 聲明常數
Private Const MOD_ALT = &H1
Private Const MOD_CONTROL = &H2
Private Const MOD_SHIFT = &H4
Private Const PM_REMOVE = &H1
Private Const WM_HOTKEY = &H312
Private HotKey_Fg As Boolean
Private Sub Form_Load()
Dim Message As Msg
'註冊 Ctrl+Y 爲熱鍵
RegisterHotKey Me.hWnd, &HBFFF&, MOD_CONTROL, vbKeyY
'RegisterHotKey Me.hWnd, &HBFF2&, MOD_CONTROL, vbKeyU
Me.Show
Form1.Hide
'等待處理消息
HotKey_Fg = False
Do While Not HotKey_Fg
'等待消息
WaitMessage
'檢查是否熱鍵被按下
If PeekMessage(Message, Me.hWnd, WM_HOTKEY, WM_HOTKEY, PM_REMOVE) Then
Form1.Show 1
End If
'轉讓控制權,允許操作系統處理其他事件
DoEvents
Loop
End Sub
Private Sub Form_Unload(Cancel As Integer)
HotKey_Fg = True
'撤銷熱鍵的註冊
Call UnregisterHotKey(Me.hWnd, &HBFFF&)
End Sub

方法二：SendMessage
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
Private Const WM_SETHOTKEY = &H32
Private Const HOTKEYF_SHIFT = &H1
Private Const HOTKEYF_ALT = &H4
Private Sub Form_Load()
Dim l As Long
Dim wHotkey As Long
wHotkey = (HOTKEYF_ALT) * (2 ^ 8) + 65 '定義ALT+A爲熱鍵
l = SendMessage(Me.hwnd, WM_SETHOTKEY, wHotkey, 0)
End Sub