怎么用VB打开win2003的控制面板中的文字服务和输入语言栏中的语言栏设置框,谢谢!!
怎么用VB打开win2003的控制面板中的文字服务和输入语言栏中的语言栏设置框,谢谢!!
[解决办法]
先添加一个模块,将工程的启动对象设为 sub main,在模块中添加如下代码:
Option Explicit
Private Declare Function LoadLibrary Lib "kernel32.dll " Alias "LoadLibraryA " _
(ByVal lpLibFileName As String) As Long
Public Declare Function FreeLibrary Lib "kernel32.dll " (ByVal hLibModule As Long) As Long
Public Declare Function CreateDialogParam Lib "user32.dll " _
Alias "CreateDialogParamA " ( _
ByVal hInstance As Long, ByVal lpName As Long, _
ByVal hWndParent As Long, ByVal lpDialogFunc As Long, _
ByVal lParamInit As Long) As Long
Public Const SW_SHOW As Long = 5
Public Declare Function ShowWindow Lib "user32.dll " (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Const WM_SYSCOMMAND As Long = &H112
Public Const SC_CLOSE As Long = &HF060&
Public Declare Function EndDialog Lib "user32.dll " (ByVal hDlg As Long, ByVal nResult As Long) As Long
Public Declare Function GetMessage Lib "user32.dll " Alias "GetMessageA " (ByRef lpMsg As MSG, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
Public Declare Function TranslateMessage Lib "user32.dll " (ByRef lpMsg As MSG) As Long
Public Declare Function DispatchMessage Lib "user32.dll " Alias "DispatchMessageA " (ByRef lpMsg As MSG) As Long
Public Declare Sub PostQuitMessage Lib "user32.dll " (ByVal nExitCode As Long)
Public Type POINTAPI
x As Long
y As Long
End Type
Public Type MSG
hwnd As Long
message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
Public Function DialogProc( _
ByVal hwndDlg&, ByVal uMsg&, _
ByVal wParam&, ByVal lParam&) As Long
If uMsg = WM_SYSCOMMAND Then
If wParam = SC_CLOSE Then
Call EndDialog(hwndDlg, 0)
PostQuitMessage 0
DialogProc = 0
End If
End If
End Function
Public Sub Main()
Dim hDlg&
Dim tMsg As MSG
Dim hIns&
hIns = LoadLibrary( "input.dll ")
hDlg = CreateDialogParam(hIns, 511, _
0, AddressOf DialogProc, 0)
FreeLibrary hIns
ShowWindow hDlg, SW_SHOW
While GetMessage(tMsg, 0, 0, 0)
Call TranslateMessage(tMsg)
Call DispatchMessage(tMsg)
Wend
End Sub
运行程序(最好将程序编译后再测试)
[解决办法]
嘿,转了一圈回来了....看来现在就咱俩最活跃啊:)
我的思路是模拟鼠标点击.......
Option Explicit
Private Declare Function FindWindow Lib "user32.dll " Alias "FindWindowA " (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindow Lib "user32.dll " (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowText Lib "user32.dll " Alias "GetWindowTextA " (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function PostMessage Lib "user32.dll " Alias "PostMessageA " (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Sub Sleep Lib "kernel32.dll " (ByVal dwMilliseconds As Long)
Private Const GW_CHILD As Long = 5
Private Const GW_HWNDFIRST As Long = 0
Private Const GW_HWNDNEXT As Long = 2
Private Const WM_LBUTTONDOWN As Long = &H201
Private Const WM_LBUTTONUP As Long = &H202
Dim tHwnd As Long
Private Sub TestClick()
Dim I As Long, J As Long
I = Shell( "RunDll32.exe shell32.dll,Control_RunDLL C:\WINDOWS\system32\input.dll ")
If I = 0 Then
MsgBox "error! "
Exit Sub
End If
I = 0
Do
J = FindWindow(vbNullString, "文字服务和输入语言 ")
DoEvents
Sleep 20
I = I + 1
If I > 15 Then Exit Sub '超时3秒
If J <> 0 Then
Debug.Print J
Exit Do
End If
Loop
Call GetHwnd(J)
Debug.Print tHwnd
If tHwnd = 0 Then Exit Sub
PostMessage tHwnd, WM_LBUTTONDOWN, 1, 0
Sleep 50
PostMessage tHwnd, WM_LBUTTONUP, 1, 0
End Sub
Private Sub GetHwnd(hWndParent As Long)
Dim hWndChild As Long
Dim tmpStr As String * 255, tmpJ As String
Dim I As Long
hWndChild = GetWindow(hWndParent, GW_CHILD Or GW_HWNDFIRST)
Do While hWndChild <> 0
I = GetWindowText(hWndChild, tmpStr, 256)
tmpJ = Mid(tmpStr, 1, I)
If InStr(1, tmpJ, "语言栏 ", vbTextCompare) > 0 Then
tHwnd = hWndChild
Exit Do
End If
GetHwnd hWndChild '递归一下
hWndChild = GetWindow(hWndChild, GW_HWNDNEXT)
Loop
End Sub
调用:
Call TestClick