Favorilerine Ekle | Giriş Sayfan Yap | Tavsiye Et

 

Kurs Tanıtım Sayfası | Süper Üye Kimdir? | Menü Tasarımı Konulu Örnek Ders
Kod İndir| Hazır Kodlar | Makaleler| İpuçları | VB .NET Kursu | Dersler | Forum | Alt Bölümler | Servisler
    Merhaba Misafir
    anasayfa » visual basic ipuçları » usb port hid aygıtlar için vb6 örneği
Üye Girişi
Kullanıcı Adı:  
Şifre : 
Kaydet ?
Siteden tam olarak faydalanabilmek için üye olmalısınız.
Unuttuğunuz şifrenizi öğrenebilmek için kayıt sırasında verdiğiniz Hatırlatma Cevabı'nı bilmeniz gereklidir.
Şifre hatırlatma işlevini sadece 3 defa kullanma hakkınız vardır.
Kullanıcı adını ve şifresini unutan üyelere email ile yardım verilmez.

Aktivasyon Gelmedi mi?Aktivasyon mesajınız email adresinize gelmedi mi?
Buraya tıklayarak bir kez daha aktivasyon mesajı gönderilmesini sağlayabilirsiniz.
Lütfen email hesabınızın BULK ve SPAM klasörlerini de kontrol ediniz.
Rastgele Makale

Ekran Kartı Versiyon Numarası

Yazar: sparow

Webmasterlar
Sitenize Ekleyin!
Sitenizde "Son Eklenen 10 Visual Basic Yazısı"'nı göstermek ve içeriğini zenginleştirmek için buraya tıklayınız.

Vbasicmaster.com'a link verin!
Aşağıdaki minik banneri sitenize eklemek için tıklayın!

Üye Sayısı:
Ziyaretçiler nerede?
Yayın № : 12275
Yayın Tar:11.04.2013
Yazar : d.nacikaya
Hit :2362

Bu Yazarın Yazıları Sadece bu yazarın ipucu göster
Bu Yazıyı Tavsiye Et

Merhabalar, usb hid aygıtlar için (röle cihaz kontrolü sensör okuma vb) örnek bir usb bağlantı örneğidir. VB6 ile derlenip çalıştırılabilir.
Hem fare ile hemde programdaki butonlar ile kontrol sağlayabilir.
Usb bağlantısı ve klavye kontrolü için mcHIDInterface.bas ve module1.bas modulleri kullanılmıştır.
Buton ile kontrol ve ve text box'a veri almak için güzel bir örnek koddur. Ayrıca usb hid aygıtlar için bağlantı örneği olarak kullanılabilir. Kodlar arasında açıklamalar ekledim. 1-24 arası değerler ile kontrol sağlanabilmektedir. 4 adet label ve progress bar ilede giriş gözlemlenebilmektedir. Kolaygelsin. Modülleri aşağıdaki linkten indirebilirsiniz...

http://www.mediafire.com/?3u6amoq833m161n

' üretici ve ürün numaraları, her usb aygıt bu numaralara sahip olmalıdır.
Private Const VendorID = 4444
Private Const ProductID = 5555

' okuma yazma buffer'ları
Private Const BufferInSize = 8
Private Const BufferOutSize = 8
Dim BufferIn(0 To BufferInSize) As Byte
Dim BufferOut(0 To BufferOutSize) As Byte

'butonlar için momentry ve toogle çalışma seçimleri (mouseup mousedown ile)

'görüldüğü gibi 4 nolu buffer ile röle cihaz kontrolünü sağlıyabiliyoruz...

Private Sub Command10_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

Command10.BackColor = vbRed
BufferOut(4) = 9
hidWriteEx VendorID, ProductID, BufferOut(0)

End Sub

Private Sub Command10_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Button = 1 Then
Command10.BackColor = vbYellow
BufferOut(4) = 25
End If
hidWriteEx VendorID, ProductID, BufferOut(0)
End Sub

Private Sub Command11_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

Command11.BackColor = vbRed
BufferOut(4) = 10
hidWriteEx VendorID, ProductID, BufferOut(0)

End Sub

Private Sub Command11_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Button = 1 Then
Command11.BackColor = vbYellow
BufferOut(4) = 26
End If
hidWriteEx VendorID, ProductID, BufferOut(0)

End Sub

Private Sub Command12_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

Command12.BackColor = vbRed
BufferOut(4) = 11
hidWriteEx VendorID, ProductID, BufferOut(0)

End Sub

Private Sub Command12_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Button = 1 Then
Command12.BackColor = vbYellow
BufferOut(4) = 27
End If
hidWriteEx VendorID, ProductID, BufferOut(0)

End Sub

Private Sub Command13_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

Command13.BackColor = vbRed
BufferOut(4) = 12
hidWriteEx VendorID, ProductID, BufferOut(0)

End Sub

Private Sub Command13_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Button = 1 Then
Command13.BackColor = vbYellow
BufferOut(4) = 28
End If
hidWriteEx VendorID, ProductID, BufferOut(0)

End Sub

Private Sub Command14_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

Command14.BackColor = vbRed
BufferOut(4) = 13
hidWriteEx VendorID, ProductID, BufferOut(0)

End Sub

Private Sub Command14_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Button = 1 Then
Command14.BackColor = vbYellow
BufferOut(4) = 29
End If
hidWriteEx VendorID, ProductID, BufferOut(0)

End Sub

Private Sub Command15_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

Command15.BackColor = vbRed
BufferOut(4) = 14
hidWriteEx VendorID, ProductID, BufferOut(0)

End Sub

Private Sub Command15_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Button = 1 Then
Command15.BackColor = vbYellow
BufferOut(4) = 30
End If
hidWriteEx VendorID, ProductID, BufferOut(0)

End Sub

Private Sub Command16_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

Command16.BackColor = vbRed
BufferOut(4) = 15
hidWriteEx VendorID, ProductID, BufferOut(0)

End Sub

Private Sub Command16_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Button = 1 Then
Command16.BackColor = vbYellow
BufferOut(4) = 31
End If
hidWriteEx VendorID, ProductID, BufferOut(0)

End Sub

Private Sub Command17_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

Command17.BackColor = vbRed
BufferOut(4) = 16
hidWriteEx VendorID, ProductID, BufferOut(0)

End Sub

Private Sub Command17_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Button = 1 Then
Command17.BackColor = vbYellow
BufferOut(4) = 32
End If
hidWriteEx VendorID, ProductID, BufferOut(0)

End Sub

'Buradan sonra butonumuza aktif ise kırmızı pasif ise sarı renk verebiliyoruz.

Private Sub Command2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Text2.Text = Text2.Text + 1
If Text2.Text = 1 Then Command2.BackColor = vbRed
If Text2.Text = 1 Then BufferOut(4) = 1
If Text2.Text = 2 Then Command2.BackColor = vbYellow
If Text2.Text = 2 Then BufferOut(4) = 17
If Text2.Text = 2 Then Text2.Text = 0
'ÜST SATIRDAKİ TEXT2.TEXT=0 I TEXT3 YAPARSAK TEXTBOX SAYAÇ OLUYOR.
hidWriteEx VendorID, ProductID, BufferOut(0)
End Sub

Private Sub Command3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

Text3.Text = Text3.Text + 1
If Text3.Text = 1 Then Command3.BackColor = vbRed
If Text3.Text = 1 Then BufferOut(4) = 2
If Text3.Text = 2 Then Command3.BackColor = vbYellow
If Text3.Text = 2 Then BufferOut(4) = 18
If Text3.Text = 2 Then Text3.Text = 0
hidWriteEx VendorID, ProductID, BufferOut(0)

End Sub

Private Sub Command4_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Text4.Text = Text4.Text + 1
If Text4.Text = 1 Then Command4.BackColor = vbRed
If Text4.Text = 1 Then BufferOut(4) = 3
If Text4.Text = 2 Then Command4.BackColor = vbYellow
If Text4.Text = 2 Then BufferOut(4) = 19
If Text4.Text = 2 Then Text4.Text = 0
hidWriteEx VendorID, ProductID, BufferOut(0)
End Sub

Private Sub Command5_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Text5.Text = Text5.Text + 1
If Text5.Text = 1 Then Command5.BackColor = vbRed
If Text5.Text = 1 Then BufferOut(4) = 4
If Text5.Text = 2 Then Command5.BackColor = vbYellow
If Text5.Text = 2 Then BufferOut(4) = 20
If Text5.Text = 2 Then Text5.Text = 0
hidWriteEx VendorID, ProductID, BufferOut(0)
End Sub

Private Sub Command6_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Text6.Text = Text6.Text + 1
If Text6.Text = 1 Then Command6.BackColor = vbRed
If Text6.Text = 1 Then BufferOut(4) = 5
If Text6.Text = 2 Then Command6.BackColor = vbYellow
If Text6.Text = 2 Then BufferOut(4) = 21
If Text6.Text = 2 Then Text6.Text = 0
hidWriteEx VendorID, ProductID, BufferOut(0)
End Sub

Private Sub Command7_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Text7.Text = Text7.Text + 1
If Text7.Text = 1 Then Command7.BackColor = vbRed
If Text7.Text = 1 Then BufferOut(4) = 6
If Text7.Text = 2 Then Command7.BackColor = vbYellow
If Text7.Text = 2 Then BufferOut(4) = 22
If Text7.Text = 2 Then Text7.Text = 0
hidWriteEx VendorID, ProductID, BufferOut(0)
End Sub

Private Sub Command8_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Text8.Text = Text8.Text + 1
If Text8.Text = 1 Then Command8.BackColor = vbRed
If Text8.Text = 1 Then BufferOut(4) = 7
If Text8.Text = 2 Then Command8.BackColor = vbYellow
If Text8.Text = 2 Then BufferOut(4) = 23
If Text8.Text = 2 Then Text8.Text = 0
hidWriteEx VendorID, ProductID, BufferOut(0)
End Sub

Private Sub Command9_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Text9.Text = Text9.Text + 1
If Text9.Text = 1 Then Command9.BackColor = vbRed
If Text9.Text = 1 Then BufferOut(4) = 8
If Text9.Text = 2 Then Command9.BackColor = vbYellow
If Text9.Text = 2 Then BufferOut(4) = 24
If Text9.Text = 2 Then Text9.Text = 0
hidWriteEx VendorID, ProductID, BufferOut(0)
End Sub

' ****************************************************************
' form yüklendiğinde usb hid aygıt ile bağlan...
'*****************************************************************

'usb hid aygıt ile bağlantı formu aktif hale getirir.

Private Sub Form_Load()

App.Title = Me.Caption

ConnectToHID (Me.hwnd)

End Sub

'*****************************************************************
' usb hid aygıt ile bağlantı kesildiğinde formu yüklemöeyi durdurur.
'*****************************************************************
Private Sub Form_Unload(Cancel As Integer)
DisconnectFromHID
End Sub

'*****************************************************************
' eğer vendor ve product noları eşleşen bir hid aygıt bağlanır ise bunları yükleyiver...
'*****************************************************************
Public Sub OnPlugged(ByVal pHandle As Long)
If hidGetVendorID(pHandle) = VendorID And hidGetProductID(pHandle) = ProductID Then
' ** ilave kodlarınızı buraya ekleyebilirsiniz.**

Image1.Visible = True
Label1.Visible = True
Frame1.Enabled = True
Frame2.Enabled = True
Frame4.Enabled = True
Label6 = KeyAscii
End If
End Sub

'*****************************************************************
' hid aygıt pc usb portundan çıkarılır ise forma bunları yükleme...
'*****************************************************************
Public Sub OnUnplugged(ByVal pHandle As Long)
If hidGetVendorID(pHandle) = VendorID And hidGetProductID(pHandle) = ProductID Then
' ** ilave kodlarınızı buraya ekleyebilirsiniz.**

Image1.Visible = False
Label1.Visible = False
Frame1.Enabled = False
Frame2.Enabled = False
Frame4.Enabled = False
End If
End Sub

'*****************************************************************
' vendor ve product id doğrulaması...
'*****************************************************************
Public Sub OnChanged()
Dim DeviceHandle As Long
DeviceHandle = hidGetHandle(VendorID, ProductID)
hidSetReadNotify DeviceHandle, True
End Sub

'*****************************************************************
' okunan bufferlar, görüldüğü gibi 1-2-3-5 bufferin leri ile analog girişler (sensör vb.) okunuyor...
' 4 nolu buffer röle cihaz kontrolü için ayrıldı...
'*****************************************************************
Public Sub OnRead(ByVal pHandle As Long)

If hidRead(pHandle, BufferIn(0)) Then
' ** ilave kodlarınızı buraya ekleyebilirsiniz. **
Label3.Caption = BufferIn(1)
Label4.Caption = BufferIn(2)
Label7.Caption = BufferIn(3)
'Label8.Caption = BufferIn(5)

ProgressBar1.Value = BufferIn(1) + 1
ProgressBar2.Value = BufferIn(2) + 1
ProgressBar3.Value = BufferIn(3) + 1
ProgressBar4.Value = BufferIn(5) + 1

End If
End Sub

'*****************************************************************
' datanın nasıl yazıldığını buradan görebilirsiniz...
'*****************************************************************
Public Sub WriteSomeData()
BufferOut(0) = 0 ' ilk kimlik bilgisi bu buffer ile alınır.
BufferOut(1) = 1 ' ilk data bu bufer ile alınır.

hidWriteEx VendorID, ProductID, BufferOut(0)
End Sub

'text1 ile mikrodenetleyiciye 255 değerine kadar veri gönderimi...

Private Sub Text1_Change()
If Val(Text1.Text) > 255 Then Text1.Text = ""
End Sub
Private Sub Text1_GotFocus()
SeciliTxBox
End Sub
Sub SeciliTxBox()
Screen.ActiveControl.SelStart = 0
Screen.ActiveControl.SelLength = Len(Screen.ActiveControl.Text)
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 8 Then Exit Sub
If IsNumeric(Chr(KeyAscii)) = False Then KeyAscii = 0
End Sub
' sedaelektronik.com 2012




Bu sayfa için henüz yorum eklenmemiş.

© Hakan Ersöz 2000-2013| Üyelik Sözleşmesi | | Ödeme Bildirimi
Sitemizden yenilikleri hemen öğrenin, pop upları engelleyin, chat yapın... ToolBarımızı indirin:
Vasicmaster Toolbar'ı indirin