آموزش .برنامه نویسی.نرم افزار های داغ

Private Const UsePollingMethod As Boolean = True
Private Const UseEventMethod As Boolean = False
‘نکته مهم اينست که تنها يکی از دو ثابت فوق بايستی True باشد .
Private bRunning As Boolean
‘اين متغير برای polling استفاده می شود
Private DX As DirectX8
Private DI As DirectInput8
‘تعريف شی اصلی DirectX و شی DirectInput
Private DIDevice As DirectInputDevice8
Private DIState As DIKEYBOARDSTATE
‘اين دو شی برای دسترسی به دستگاه ورودی ( کيبرد ) استفاده می شوند
Private KeyState(0 To 255) As Boolean
‘آرايه ای برای تشخيص فشرده شدن کليد
Private Const BufferSize As Long = 10
‘ سايز بافر نگهدارنده event ها . در روش event-based اين مقدار برابر يک و در روش polling برابر 10 تا 20 است ( بسته به سرعت حلقه بازی )
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)x
‘ تابع Sleep برای متوقف کردن حلقه polling در صورت بالا بودن نرخ ورودی

Me.Show
Dim I As Long
Dim DevProp As DIPROPLONG
Dim DevInfo As DirectInputDeviceInstance8
Dim pBuffer(0 To BufferSize) As DIDEVICEOBJECTDATA
If UsePollingMethod And UseEventMethod Then
MsgBox "You must select only one of the constants before running"x
Unload Me
End
End If

If UsePollingMethod Then txtOutput.Text = "Using Polling Method" & vbCrLf
If UseEventMethod Then txtOutput.Text = "Using Event Based Method" & vbCrLf

‘مقداردهی اوليه روش انتخاب شده
Set DX = New DirectX8
Set DI = DX.DirectInputCreate
Set DIDevice = DI.CreateDevice("GUID_SysKeyboard")x

DIDevice.SetCommonDataFormat DIFORMAT_KEYBOARD
DIDevice.SetCooperativeLevel frmMain.hWnd, DISCL_BACKGROUND Or ISCL_NONEXCLUSIVE

‘برپاسازی بافر
DevProp.lHow = DIPH_DEVICE
DevProp.lData = BufferSize
DIDevice.SetProperty DIPROP_BUFFERSIZE, DevProp

‘ به دايرکت ايکس می گوئيم که می خواهيم از دستگاه ورودی استفاده کنيم
DIDevice.Acquire

‘استخراج اطلاعاتی در مورد دستگاه ورودی
Set DevInfo = DIDevice.GetDeviceInfo()x
txtOutput.Text = txtOutput.Text & "Product Name: " & DevInfo.GetProductName & vbCrLf
txtOutput.Text = txtOutput.Text & "Device Type: " & DevInfo.GetDevType & vbCrLf
txtOutput.Text = txtOutput.Text & "GUID: " & DevInfo.GetGuidInstance & vbCrLf


‘در صورتی که بخواهيم به برنامه خاتمه بدهيم کدهای زير را می نويسيم
DIDevice.Unacquire
Set DIDevice = Nothing
Set DI = Nothing
Set DX = Nothing
Unload Me
End

If Not Err.Number Then bRunning = True

Do While bRunning

‘دريافت اطلاعات شامل خواندن وضعيت کيبرد ، خواندن اطلاعات بافر و سپس خطا
DIDevice.GetDeviceStateKeyboard DIState
DIDevice.GetDeviceData pBuffer, DIGDD_DEFAULT
If Err.Number = DI_BUFFEROVERFLOW Then
Msgbox(“BUFFER OVERFLOW (Compensating)...")x
GoTo ENDOFLOOP:
End If
‘بررسی فشرده شدن کليدها
For I = 0 To 255
If DIState.Key(I) = 128 And (Not KeyState(I) = True) Then
txtOutput.Text = txtOutput.Text & "{ DOWN } " & KeyNames(CInt(I))& vbCrLf
txtOutput.SelStart = Len(txtOutput.Text)x
KeyState(I) = True
End If
Next I

‘بررسی رها شدن کليد
For I = 0 To BufferSize
If KeyState(pBuffer(I).lOfs) = True And pBuffer(I).lData = 0 Then
KeyState(pBuffer(I).lOfs) = False
txtOutput.Text = txtOutput.Text & "{ UP } " & KeyNames(CInt(pBuffer(I).lOfs)) & vbCrLf
txtOutput.SelStart = Len(txtOutput.Text)x
End If
Next I

Sleep (50)x
DoEvents
ENDOFLOOP:
Loop

Function KeyNames(iNum As Integer) As String

Dim aKeys(0 To 255) As String

aKeys(1) = "DIK_ESCAPE"
aKeys(2) = "DIK_1 On main keyboard"x
aKeys(3) = "DIK_2 On main keyboard"x
aKeys(4) = "DIK_3 On main keyboard"x
aKeys(5) = "DIK_4 On main keyboard"x
aKeys(6) = "DIK_5 On main keyboard"x
aKeys(7) = "DIK_6 On main keyboard"x
aKeys(8) = "DIK_7 On main keyboard"x
aKeys(9) = "DIK_8 On main keyboard"x
aKeys(10) = "DIK_9 On main keyboard"x
aKeys(11) = "DIK_0 On main keyboard"x
aKeys(12) = "DIK_MINUS On main keyboard"x
aKeys(13) = "DIK_EQUALS On main keyboard"x
aKeys(14) = "DIK_BACK BACKSPACE"x
aKeys(15) = "DIK_TAB"x
aKeys(16) = "DIK_Q"x
aKeys(17) = "DIK_W"x
aKeys(18) = "DIK_E"x
aKeys(19) = "DIK_R"x
aKeys(20) = "DIK_T"x
.
.
.
KeyNames = aKeys(iNum)x

End Function

=======================

موضوع : کنترل کيبرد با روش Event-Based

مقداردهی اوليه و مفاهيم اصلی در روش Event-Based مشابه روش Polling است و تنها بايستی ساختار بخش جمع آوری داده و حلقه پردازشی را تغيير دهيم . مراحل کار با روش Event-Based بصورت زير می باشد :

۱ - تعاريف و مقداردهی اوليه : در بخش تعاريف دو تعريف جديد بصورت زير داريم :

Dim hEvent As Long
Implements DirectXEvent8

hEvent يک پارامتر هندل برای يک می باشد .
نکته : زمانی که کليدی فشرده يا رها می شود ، DirectX اين امر با فراخوانی تابعی به اسم DirectXEvent8_DXCallback به برنامه شما اطلاع می دهد . ( اين نوع توابع را Call Back Function گويند ) . اين تابع به برنامه شما می گويد که يک رويداد اتفق افتاده است و بايستی بافرها را چک کند .

تنها تغييری که در بخش مقداردهی اوليه نياز است ، برپاسازی يک event می باشد :

If UseEventMethod Then
hEvent = DX.CreateEvent(frmMain)x
DIDevice.SetEventNotification hEvent
End If

در انتهای برنامه نيز کد زير را برای از بين بردن event اضافه کنيد :

If hEvent <> 0 Then DX.DestroyEvent hEvent

۲ - استفاده از event : برای اين بخش کدهايي را در داخل تابع DirectXEvent8_DXCallback می نويسيم :

Private Sub DirectXEvent8_DXCallback(ByVal eventid As Long)x
'متغيرهای موردنياز
Dim I As Long
Dim pBuffer(0 To BufferSize) As DIDEVICEOBJECTDATA
If eventid = hEvent Then
If DIDevice Is Nothing Then Exit Sub
'درصورت رخ دادن event داده را از کيبرد می گيريم
DIDevice.GetDeviceStateKeyboard DIState
DIDevice.GetDeviceData pBuffer, DIGDD_DEFAULT
'چک کردن تمام کليدها برای اينکه متوجه شويم چه اتفاقی افتاده است
For I = 0 To 255
'عدد ۱۲۸ نشان دهنده key_down event است .
If DIState.Key(I) = 128 Then
If pBuffer(0).lData = 128 Then
txtOutput.Text = txtOutput.Text & "{ DOWN } " & KeyNames(CInt(I)) & vbCrLf
End If
End If
'کد فوق برای بررسی فشرده شدن يک کليد بود . کد زير رها شدن کليد را بررسی می کند
If (pBuffer(0).lData = 0 And pBuffer(0).lOfs = I) Then
txtOutput.Text = txtOutput.Text & "{ UP }" & KeyNames(CInt(I)) & vbCrLf
End If

txtOutput.SelStart = Len(txtOutput.Text)x
Next I
End If
End Sub

=====================

موضوع : کنترل ماوس با DirectX Input

مقدمه :

برای استفاده از ماوس در برنامه های مالتی مديا و بازيها همانند کی برد می توانيم از امکانات دايرکت ايکس استفاده کنيم . روش کنترل ماوس توسط DirectX Input بسيار ساده بوده و مشابه کنترل کيبرد می باشد بنابراين درصورتی که دو درس گذشته را نخوانده اين پيشنهاد می کنم ابتدا آنها را مطالعه کنيد .

برپاسازی Device :

علاوه بر متغيرهايي که در بخش کنترل کيبرد تعريف شد بايستی متغيرهای جديد زير را نيز در ابتدای برنامه تان تعريف کنيد :

Private Const mSpeed As Single = 2
Private Const BufferSize As Long = 10
Private mPosition As Point

mSpeed مقدار سرعت حرکت کرسر ماوس را مشخص می کند .
BufferSize سايز بافر DI می باشد .
mPosition موقعيت جاری کرسر ماوس را نشان می دهد .

در مرحله بعدی بايستی مقداردهي های اوليه لازم را انجام دهيد :

Set DIDevice = DI.CreateDevice("guid_SysMouse")x
Call DIDevice.SetCommonDataFormat(DIFORMAT_MOUSE)x
Call DIDevice.SetCooperativeLevel(frmMain.hWnd, DISCL_FOREGROUND Or DISCL_EXCLUSIVE)x

تفاوت عمده کدهای فوق با کدهای مقداردهی اوليه در بخش کی برد آنست که cooperativelevel تغيير کرده است . در اينجا گفته شده که ما می خواهيم از ماوس بصورت انحصاری در برنامه استفاده کنيم . اين حالت برای برنامه های window-base مناسب نيست و بهترست از آن در بازيهايي که بصورت full screan هستند استفاده کنيد .

خواندن ورودی از ماوس :

در اين بخش می توانيد هم از روش polling و هم event-based استفاده کنيد . نکته مهمی که در اينجا وجود دارد آنست که Direct Input فقط حرکت داده شدن ماوس و کليک شدن يک دکمه را به شما اطلاع می دهد و برای تشخيص حالتهای double click و single click خودتان بايستی کد بنويسيد برای مثال اگر فاصله زمانی بين دو کليک کمتر از ۴۰ ميلی ثانيه باشد آنگاه اين يک double click بوده است .
کد زير حرکت داده شدن ماوس و کليک يکی از سه دکمه آنرا اطلاع می دهد :

Dim DevData(1 To BufferSize) As DIDEVICEOBJECTDATA
Dim nEvents As Long
Dim I As Long
nEvents = DIDevice.GetDeviceData(DevData, DIGDD_DEFAULT)x
For I = 1 To nEvents
Select Case DevData(I).lOfs
Case DIMOFS_X
mPosition.x = mPosition.x + (DevData(I).lData * mSpeed)x
If mPosition.x < 0 Then mPosition.x = 0
If mPosition.x > frmMain.ScaleWidth Then mPosition.x = frmMain.ScaleWidth
imgCursor.Top = mPosition.y
imgCursor.Left = mPosition.x
lablel(1).Caption = "Mouse Coordinates: [" & mPosition.x & ", " & mPosition.y & "]"x
Case DIMOFS_Y
mPosition.y = mPosition.y + (DevData(I).lData * mSpeed)x
If mPosition.y < 0 Then mPosition.y = 0
If mPosition.y > frmMain.ScaleHeight Then mPosition.y = frmMain.ScaleHeight
imgCursor.Top = mPosition.y
imgCursor.Left = mPosition.x
lablel(1).Caption = "Mouse Coordinates: [" & mPosition.x & ", " & mPosition.y & "]"x
Case DIMOFS_BUTTON0
label(2).Caption = "Button 0 State: " & IIf(DevData(I).lData = 0, "Up", "Down")x
Case DIMOFS_BUTTON1
label(3).Caption = "Button 1 State: " & IIf(DevData(I).lData = 0, "Up", "Down")x
Case DIMOFS_BUTTON2
label(4).Caption = "Button 2 State: " & IIf(DevData(I).lData = 0, "Up", "Down")x
Case DIMOFS_BUTTON3
label(5).Caption = "Button 3 State: " & IIf(DevData(I).lData = 0, "Up", "Down")x
End Select
Next I

برای استفاده از کد فوق در روش Polling ، بايستی آنرا در يک حلقه Do while-Loop قرار دهيد .
برای استفاده از کد فوق در روش Event-Based ، بايستی آنرا درون روتين DirectXEvent8_DXCallback قرار دهيد .