PDA

View Full Version : شبیه سازی کلیک برای یک پنجره



subsub
پنج شنبه 19 بهمن 1385, 14:57 عصر
سلام
چطوری می تونم کلیک کردن رو برای یه پنجره شبیه سازی کنم.
یعنی کاری کنم مثل اینکه کاربر یه مختصات خاصی از یه پنجره رو کلیک کرده.

mRizvandi
پنج شنبه 19 بهمن 1385, 16:59 عصر
سلام
ببخشید چون الان در مسافرتم و دسترسی به کامپیوترم ندارم فقط می گم که می تونی از تابع SendMessage استفاده کنی. داخل msdnسورس هم هست

S_VB.max
پنج شنبه 19 بهمن 1385, 19:43 عصر
Private Declare Sub mouse_event Lib "user32.dll" (ByVal dwFlags As Long, ByVal dx

As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4
Const MOUSEEVENTF_RIGHTDOWN = &H8
Const MOUSEEVENTF_RIGHTUP = &H10

'************************************************* ***
'* Do a left mouse click on current position
'************************************************* ***

Private Sub Command1_Click()
Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)

Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
End Sub


البته می تونی توی یک برنامه دیگر (غیر از برنامه خودت )مثل Notepad این شبیه سازی را انجام بدی که در این صورت باید از تابع SendMessage استفاده کنی

S_VB.max
پنج شنبه 19 بهمن 1385, 20:01 عصر
این کد شبیه سازی را توی برنامه Notepad انجام می ده



Private lhWndNotepad As Long

Private Const WM_SETTEXT = &HC
Private Const BM_CLICK = &HF5
Private Const WM_CLOSE = &H10
Private Const WM_COMMAND = &H111
'Private Const WM_LBUTTONUP = &H202
Private Const BN_CLICKED = 0

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
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
'sendmessage declared with lParam ByVal
Private Declare Function SendMessage2 Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
Private 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
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function lSetFocus Lib "user32" Alias "SetFocus" (ByVal hwnd As Long) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long

Private Sub ClickMenu(lMenu As Long, lItem As Long)

Dim lSubMenu As Long
Dim lMenuItem As Long

'This is a bit more interesting

lMenu = GetMenu(lhWndNotepad)
lSubMenu = GetSubMenu(lMenu, lMenu)
lMenuItem = GetMenuItemID(lSubMenu, lItem)

Call PostMessage(lhWndNotepad, WM_COMMAND, lMenuItem, 0)
'sendmessage would hang app until file is selected in open form but
'postmessage is asynchronous which is better in this case
End Sub
Private Function GetWindowHandle(ps_WindowTitle As String) As Long
GetWindowHandle = FindWindow(vbNullString, ps_WindowTitle)
End Function

Private Sub StartNotePad()
Call Shell("notepad", vbNormalFocus) 'you'll need notepad.exe on your PC for this to work
DoEvents
Do While lhWndNotepad = 0
lhWndNotepad = GetWindowHandle("Untitled - Notepad")
Loop
End Sub

Private Sub CloseNotePad()
Call SendMessage(lhWndNotepad, WM_CLOSE, 0, 0)
End Sub

Private Sub cmdStart_Click()
Simulate
End Sub

Private Sub Form_Load()
StartNotePad
Show
SetFocus
End Sub
Private Sub SetNotePadInForeground()
SetForegroundWindow lhWndNotepad
End Sub
Private Sub Form_Unload(Cancel As Integer)
CloseNotePad
End Sub

Private Sub Simulate()
Dim hMsgBox As Long
Dim hTextBox As Long

Dim hComboBox As Long
Dim hComboBox2 As Long
'activate notepad
SetNotePadInForeground
'open file menu
SendKeys "%F"
Wait
'simulate down key
SendKeys "{Down}"
Wait
ClickMenu 0, 1
'wait until the dialog appears
Do While hMsgBox = 0 Or lCount > 5000
lCount = lCount + 1
hMsgBox = FindWindow("#32770", "Open")
DoEvents
Loop

If hMsgBox = 0 Then Stop
Wait
'find ComboBoxEx32
hComboBox = FindWindowEx(hMsgBox, 0, "ComboBoxEx32", "")
'find the combo box within that
hComboBox2 = FindWindowEx(hComboBox, 0, "ComboBox", "")
'find the textbox within that...
hTextBox = FindWindowEx(hComboBox2, 0, "Edit", "")
If hTextBox = 0 Then Stop
'set the textbox's value to the app path
'note we use SendMessage2, which has lParam declared ByVal
SendMessage2 hTextBox, WM_SETTEXT, 0, App.Path & Chr$(0)
'simulate clicking the open button
ClickOpen hMsgBox
Wait
'set the textbox's value to readme.txt
Debug.Print SendMessage2(hTextBox, WM_SETTEXT, 0, "readme.txt" & Chr$(0))
Wait
'simulate clicking...
ClickOpen hMsgBox
End Sub
Private Sub Wait()
DoEvents
'Sleep 500
End Sub
Private Sub ClickOpen(hMsgBox As Long)
Dim hButtonOpen As Long
Dim hComboBox As Long
hButtonOpen = FindWindowEx(hMsgBox, 0, "Button", "&Open")
hComboBox = FindWindowEx(hMsgBox, 0, "ComboBox", "")
If hButtonOpen = 0 Then Stop
SendMessage hButtonOpen, BM_CLICK, 0, 0
End Sub

subsub
جمعه 25 اسفند 1385, 11:54 صبح
این کد شبیه سازی را توی برنامه Notepad انجام می ده

دستت درد نکنه. ولی بهتره بگی برای شبیه سازی کلیک کردن پارامترهای رو برای تابع SendMessage چی وارد کنم.
چون من حدود 3 ماهی هست که ویژوال کار نکردم کمی تو کدهایی که نوشته بودی گیج شدم.:ناراحت: