دانلود:
این مقاله به شما یک تکنیک زیبا برای ردیابی حرکت ماوس و کنترل آن به صورتی که دوست دارید آموزش می دهد. با استفاده از API تقریبا هر چیزی در برنامه نویسی ویندوز ممکن می شود. در این مقاله شما چند تکنیک متفرقه مانند بدست آوردن دقیق عرض و ارتفاع صفحه بر حسب پیکسل نیز یاد می گیرید. ما از دو تابع API استفاده خواهیم کرد. تابع اول GetCursorPos است که مکان ماوس را بدست می آورد و آن را در lpPoint (تنها آرگومانی که به این تابع فرستاده می شود) قرار می دهد. تعریف آن به این صورت می باشد:
'Get the current cursor position
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
POINTAPI نوع تعریفی خودمان می باشد که شامل دو متغیر X و Y از نوع Long می شود. این نوع برای نگهداری مختصات X و Y نشانگر ماوس استفاده می شود:
Private Type POINTAPI
X As Long
Y As Long
End Type
تابع بعدی SetCursorPos است که مختصات X و Y نشانگر ماوس را با استفاده از دو آرگومانی که به آن فرستاده می شود تنظیم می کند.
'Set the current cursor position
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
حالا که کار ما با API تمام شده، بهتر است به قسمت GUI بپردازیم. ابتدا دو دکمه به نام های cmdStart و cmdStop اضافه کنید، سپس یک جعبه ی متنی به نام txtMultiplier و یک تایمر به نام tmrTimer به فرم خود اضافه کنید. ما باید یک متغیر برای نگهداری آخرین مکان نشانگر تعریف کنیم. این متغیر (mLast از نوع POINTAPI) به ما کمک می کند تا جهت حرکت ماوس را پیش بینی کنیم و حرکت آن را در مسیرش زیاد کنیم. هنگام رویداد کلیک cmdStart، ما mLast را با مختصات فعلی نشانگر به روز و tmrTimer را فعال می کنیم. به خاطر داشته باشید که tmrTimer هنگام شروع برنامه باید غیر فعال باشد. همچنین هنگام رویداد کلیک cmdStop تایمر tmrTimer باید غیر فعال شود.
'Holds the last mouse position
Dim mLast As POINTAPI
'Update mLast with the current cursor cordinates and enable tmrTimer
Private Sub cmdStart_Click()
Call GetCursorPos(mLast)
tmrTimer.Enabled = True
End Sub
'Disable tmrTimer
Private Sub cmdStop_Click()
tmrTimer.Enabled = False
End Sub
هنگامی که تایمر فعال شود، در هر رویداد تایمر ما باید تفاوت مکان حاضر ماوس را با آخرین مکانش که در mLast ذخیره شده است بررسی کنیم. با تکثیر این تفاوت ما حرکت ماوس را انتقال می دهیم و حاصل را به عنوان مکان فعلی نشانگر تنظیم می کنیم. اما قبل از انجام این کار ما باید مراقب باشیم که نشانگر ماوس را به بیرون از مختصات صفحه نفرستیم. برای این اخطار ما باید عرض و ارتفاع دقیق صفحه را داشته باشیم. به دو تابع نمونه ی زیر برای دریافت عرض و ارتفاع صفحه توجه کنید:
'Obtain screen width in pixels
Private Function ScreenWidth()
ScreenWidth = ScaleX(Screen.Width, vbTwips, vbPixels)
End Function
'Obtain screen height in pixels
Private Function ScreenHeight()
ScreenHeight = ScaleY(Screen.Height, vbTwips, vbPixels)
End Function
اکنون همه چیز برای عملیات شتاب ما آماده است. این رویداد تایمر tmrTimer می باشد:
'The main part of acceleration
Private Sub tmrTimer_Timer()
On Error Resume Next
Dim Current As POINTAPI
Call GetCursorPos(Current)
Current.X = Current.X + (Current.X - mLast.X) * txt.Text
Current.Y = Current.Y + (Current.Y - mLast.Y) * txt.Text
If Current.X < 0 Then Current.X = 0
If Current.Y < 0 Then Current.Y = 0
If Current.X > ScreenWidth Then Current.X = ScreenWidth - 1
If Current.Y > ScreenHeight Then Current.Y = ScreenHeight - 1
Call SetCursorPos(Current.X, Current.Y)
mLast.X = Current.X
mLast.Y = Current.Y
End Sub
شما می توانید پروژه ی نمونه شتاب دهنده ی ماوس - 5.89 KB را دانلود کنید یا از کد زیر برای کپی و پیست مستقیم در برنامه تان استفاده کنید:
'Get the current cursor position
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'Set the current cursor position
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
'Holds the last mouse position
Dim mLast As POINTAPI
'Update mLast with the current cursor cordinates and enable tmrTimer
Private Sub cmdStart_Click()
Call GetCursorPos(mLast)
tmrTimer.Enabled = True
End Sub
'Disable tmrTimer
Private Sub cmdStop_Click()
tmrTimer.Enabled = False
End Sub
'The main part of acceleration
Private Sub tmrTimer_Timer()
On Error Resume Next
Dim Current As POINTAPI
Call GetCursorPos(Current)
Current.X = Current.X + (Current.X - mLast.X) * txt.Text
Current.Y = Current.Y + (Current.Y - mLast.Y) * txt.Text
If Current.X < 0 Then Current.X = 0
If Current.Y < 0 Then Current.Y = 0
If Current.X > ScreenWidth Then Current.X = ScreenWidth - 1
If Current.Y > ScreenHeight Then Current.Y = ScreenHeight - 1
Call SetCursorPos(Current.X, Current.Y)
mLast.X = Current.X
mLast.Y = Current.Y
End Sub
'Obtain screen width in pixels
Private Function ScreenWidth()
ScreenWidth = ScaleX(Screen.Width, vbTwips, vbPixels)
End Function
'Obtain screen height in pixels
Private Function ScreenHeight()
ScreenHeight = ScaleY(Screen.Height, vbTwips, vbPixels)
End Function
<!-- start: postbit_signature -->
شتاب دادن حرکت ماوس
