الفريق العربي للبرمجةأرشيف المنتديات · 2000 – 2023
نسخة أرشيفية للقراءة فقط — التسجيل والمشاركة مغلقان، والمحتوى محفوظ كما كان.

عايز احرك الماوس

مغلق
بدأه hamata في 1 مايو 2007 · 6 رد · 514 مشاهدة · في لغة Ms Visual Basic 6 وما قبلها من إصدارات
مشاركة: واتساب X فيسبوك تيليجرام
#1 صاحب الموضوع

السلام عليكم

اخواني انا عايز احرك الماوس برمجيا في مكان معين

ويضغط الماوس بمفردة كل ثانية

---------------

يعني عايز الماوس يتحرك ويدوس لوحدة كل ثانية

-------------------

لمن لدية الحل: ارجو ان يصنع لي مثال بسيط ويرفعة...وشكرا مقدما

والسلام عليكم

#2

السلام عليكم و رحمة الله و بركاته

للجزء الأول دالة SetCursorPos :

Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long

X و Y هما الأحداثيان السينى و الصادى لمكان الماوس بالبكسل.

للجزء الثانى :

Private Const MOUSEEVENTF_ABSOLUTE = &H8000
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Declare Function GetMessageExtraInfo Lib "user32" () As Long

Public Sub SendAClick(X As Long, Y As Long)
mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP Or MOUSEEVENTF_ABSOLUTE, X, Y, 0, GetMessageExtraInfo
DoEvents
End Sub

أيضا X و Y لهم نفس المعنى.

و السلام عليكم و رحمة الله و بركاته

#3

اخي ممكن تصمم مثال وترفعة لاني محتاجة بشدة ...ارجو افادتي بسرعة

#4

يعنى هو نسخ الكود و لصقه صعب :blink: ؟

مرفق المثال , بالتوفيق.

Mouse.rar

#5

متشكرين جدا اخي الكريم

#6

التحكم في حركة الماوس :

Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long

Dim P As POINTAPI
Private Sub Form_Load()

	Command1.Caption = "Screen Middle"
	Command2.Caption = "Form Middle"
	'API uses pixels
	Me.ScaleMode = vbPixels
End Sub
Private Sub Command1_Click()
	'Get information about the screen's width
	P.x = GetDeviceCaps(Form1.hdc, 8) / 2
	'Get information about the screen's height
	P.y = GetDeviceCaps(Form1.hdc, 10) / 2
	'Set the mouse cursor to the middle of the screen
	ret& = SetCursorPos(P.x, P.y)
End Sub
Private Sub Command2_Click()
	P.x = 0
	P.y = 0
	'Get information about the form's left and top
	ret& = ClientToScreen&(Form1.hwnd, P)
	P.x = P.x + Me.ScaleWidth / 2
	P.y = P.y + Me.ScaleHeight / 2
	'Set the cursor to the middle of the form
	ret& = SetCursorPos&(P.x, P.y)
End Sub

تحريك الفأرة بالكود :

'This project needs 2 Buttons
Private Type POINTAPI
	x As Long
	y As Long
End Type
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long

Dim P As POINTAPI
Private Sub Form_Load()
	'KPD-Team 1998
	'URL: http://www.allapi.net/
	'E-Mail: KPDTeam@Allapi.net

	Command1.Caption = "Screen Middle"
	Command2.Caption = "Form Middle"
	'API uses pixels
	Me.ScaleMode = vbPixels
End Sub
Private Sub Command1_Click()
	'Get information about the screen's width
	P.x = GetDeviceCaps(Form1.hdc, 8) / 2
	'Get information about the screen's height
	P.y = GetDeviceCaps(Form1.hdc, 10) / 2
	'Set the mouse cursor to the middle of the screen
	ret& = SetCursorPos(P.x, P.y)
End Sub
Private Sub Command2_Click()
	P.x = 0
	P.y = 0
	'Get information about the form's left and top
	ret& = ClientToScreen&(Form1.hwnd, P)
	P.x = P.x + Me.ScaleWidth / 2
	P.y = P.y + Me.ScaleHeight / 2
	'Set the cursor to the middle of the form
	ret& = SetCursorPos&(P.x, P.y)
End Sub

تحريك الماوس برمجياً :

'أضف Command1,Command2 ثم انسخ الكود التالي
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function ClientToScreen Lib "user32" _
(ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Sub mouse_event Lib "user32" _
(ByVal dwFlags As Long, ByVal dx As Long, _
ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Const MOUSEEVENTF_MOVE = &H1 ' mouse move
Private Const MOUSEEVENTF_ABSOLUTE = &H8000 ' absolute move
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Sub Command1_Click()
Const NUM_MOVES = 2000
Dim pt As POINTAPI
Dim cur_x As Long
Dim cur_y As Long
Dim dest_x As Long
Dim dest_y As Long
Dim dx As Long
Dim dy As Long
Dim i As Integer
ScaleMode = vbPixels
GetCursorPos pt
cur_x = pt.X * 65535 / ScaleX(Screen.Width, vbTwips, vbPixels)
cur_y = pt.Y * 65535 / ScaleY(Screen.Height, vbTwips, vbPixels)
'تحديد مكان الماوس الجديد
pt.X = Command2.Width / 2
pt.Y = Command2.Height / 2
ClientToScreen Command2.hwnd, pt
dest_x = pt.X * 65535 / ScaleX(Screen.Width, vbTwips, vbPixels)
dest_y = pt.Y * 65535 / ScaleY(Screen.Height, vbTwips, vbPixels)
' Move the mouse.
dx = (dest_x - cur_x) / NUM_MOVES
dy = (dest_y - cur_y) / NUM_MOVES
For i = 1 To NUM_MOVES - 1
cur_x = cur_x + dx
cur_y = cur_y + dy
mouse_event MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_MOVE, cur_x, cur_y, 0, 0
DoEvents
Next i
End Sub

علاء VB

اقتباس
If A is success in life, then A equals x plus y plus z. Work is x; y is play; and z is keeping your mouth shut

Albert Einstein

مدخل إلى برمجة وتصميم الألعاب : كيف أبدأ ؟

#7

ايه ده كله يا علاء ؟

معظم الأكواد دى الهدف منها حاجات تانية , فليه نعقد الدنيا , راجع المرفق بتاعى.

هذا الموضوع مغلق.

مواضيع مشابهة