dotNETportal.cz

Caute

Znova sa na vas obraciam.Po dlhom patrany na internete mi nic ine neostava len vas znova poprosit.Chcel som si skusit postavit program na meranie teploty s SMT 160 cez Game portalebo Com port , Lpt port.Su hotove programy ale tie ma nenasmeruju.Staci mi odporucit knizku alebo niejaky priklad.

Toto som nasiel v knihe Elektronika s podporou pc.Ja by som potreboval viac senzorou tak 4 taskze asi by mi vyhovoval senzor DS1820

Deklarace

Declare Function OPENCOM Lib "Port" (ByVal A$) As Integer
Declare Sub CLOSECOM Lib "Port" ()
Declare Sub SENDBYTE Lib "Port" (ByVal b%)
Declare Function READBYTE Lib "Port" () As Integer
Declare Sub DTR Lib "Port" (ByVal b%)
Declare Sub RTS Lib "Port" (ByVal b%)
Declare Sub TXD Lib "Port" (ByVal b%)
Declare Function CTS Lib "Port" () As Integer
Declare Function DSR Lib "Port" () As Integer
Declare Function RI Lib "Port" () As Integer
Declare Function DCD Lib "Port" () As Integer
Declare Sub DELAY Lib "Port" (ByVal b%)
Declare Sub TIMEINIT Lib "Port" ()
Declare Sub TIMEINITUS Lib "Port" ()
Declare Function TIMEREAD Lib "Port" () As Long
Declare Function TIMEREADUS Lib "Port" () As Long
Declare Sub DELAYUS Lib "Port" (ByVal l As Long)
Declare Sub REALTIME Lib "Port" (ByVal i As Boolean)

Program

Private Sub Form_Load()
 i = OPENCOM("COM2,1200,N,8,1")
 If i = 0 Then
    i = OPENCOM("COM1,1200,N,8,1")
    Option1.Value = True
 End If
 If i = 0 Then MsgBox ("COM Interface Error")
 TXD 0
 RTS 0
 DTR 0
 Counter1 = 0
 Timer1.Interval = 2000
End Sub

Private Sub Form_Unload(Cancel As Integer)
  CLOSECOM
End Sub

Private Sub Option1_Click()
 i = OPENCOM("COM1,1200,N,8,1")
 If i = 0 Then MsgBox ("COM1 not available")
End Sub

Private Sub Option2_Click()
 i = OPENCOM("COM2,1200,N,8,1")
 If i = 0 Then MsgBox ("COM2 not available")
End Sub

Private Sub Timer1_Timer()
  DTR 1
  REALTIME (True)
  TIMEINITUS
  While (DSR() = 0) And (TIMEREADUS() < 1500000)
  Wend
  T = TIMEREADUS()
  T = T * 1.0000000001
  R = 2200 + 7800 * (T - 76300) / (294600 - 76300)
  REALTIME (False)
  R = Int(R)
  Temp = 1 / (Log(R / 10000) / 4300 + 1 / 298) - 273
  Temp = Int(Temp * 10) / 10
  Label1.Caption = Str$(Temp) + "°C"
  'Temp = 32 + (Temp / 100 * 180)
  'Temp = Int(Temp * 10) / 10
  'Label1.Caption = Str$(Temp) + " F"
  DTR 0
End Sub
-

Krásné a funkční senzory teploty a dalších veličin jsou na www.papouch.com Mrkněte tam. Stáhněte si visual studio 2010 a zkuste to ve visual basic.NET. Čidla komunikují jejich jednoduchým protokolem Spinel. Vše je na stránkách polopaticky popsáno. Funguje to skvěle. Dnes už nemá cenu dělat něco v "šestce"

Ja som nasiel na internete toto.Je k tomu treba aj hw s pic

Option Explicit
Dim datatemp(1000) As Single
Dim num As Integer
Private Sub Form_Load()
    MSComm1.Settings = "9600,n,8,1"     
    MSComm1.CommPort = 1
    MSComm1.InputLen = 0
    MSComm1.InputMode = comInputModeBinary 
    MSComm1.InBufferSize = 16          
    MSComm1.InBufferCount = 0
    MSComm1.OutBufferSize = 16
    MSComm1.OutBufferCount = 0
    MSComm1.RThreshold = 1           
    MSComm1.SThreshold = 1
    MSComm1.PortOpen = True
    
    Call tabinit
End Sub
Private Sub cmdstart_click()
    Timer1.Enabled = True
End Sub
Private Sub cmdstop_click()
    Timer1.Enabled = False
End Sub
Private Sub cmdend_click()
    End
End Sub
Private Sub timer1_timer()
    Dim outstring As String
    outstring = "ST"
    MSComm1.Output = outstring
End Sub
Private Sub MSComm1_OnComm()
    Dim i As Integer
    Dim Inbyte() As Byte
    Dim buffer, startbyte As String
    Dim data1, data2 As String
    Dim data As Single
    '***********************************
    If num > 199 Then Call renew
    Select Case MSComm1.CommEvent
        Case comEvReceive
            Inbyte = MSComm1.Input
            For i = LBound(Inbyte) To UBound(Inbyte)
                buffer = buffer + Hex(Inbyte(i)) + Chr(32)
            Next i
        Case Else
    End Select
    tempText.Text = buffer
    startbyte = Mid(buffer, 1, 2)
    If startbyte = "23" Then
        data1 = Mid(buffer, 4, 1)
        If Len(Trim(buffer)) = 6 Then        
            data2 = Mid(buffer, 6, 1)
        Else: data2 = Mid(buffer, 6, 2)
        End If    
        data = Val(data1) * 16 + Val("&H" & data2) / 16
        tempText.Text = Str(data)
    End If                                 
    '************************************
    datatemp(num) = data
    If datatemp(num) <> 0 Then
        Grid.Col = 1: Grid.Row = num + 1
        Grid.Text = Str(datatemp(num))
        num = num + 1
        Call cal
        Call draw
   End If
End Sub
Sub cal()
    Dim sum, aver, min, max As Single
    Dim i As Integer
    sum = 0
    max = datatemp(0): min = max
    For i = 0 To num - 1
        If datatemp(i) >= max Then max = datatemp(i)
        If datatemp(i) <= min Then min = datatemp(i)
        sum = sum + datatemp(i)
    Next i
    aver = sum / num
    maxText.Text = Format$(max, "0.0")
    minText.Text = Format$(min, "0.0")
    averText.Text = Format$(aver, "0.0")
End Sub
Private Sub draw()             
    Dim i As Integer
    Dim X1, X2, Y1, Y2 As Integer
    Pic1.Cls
    Pic1.DrawWidth = 1
    Pic1.BackColor = QBColor(15)
    Pic1.Scale (0, 50)-(200, 0)  
    For i = 1 To num - 1
        X1 = (i - 1): Y1 = datatemp(i - 1)
        X2 = i: Y2 = datatemp(i)
        Pic1.Line (X1, Y1)-(X2, Y2), QBColor(0)
    Next i
End Sub
Private Sub tabinit()       
    Dim i As Integer
    Grid.Cols = 2
    Grid.Rows = 200 + 1
    Grid.ColWidth(0) = 700: Grid.ColWidth(1) = 950
    Grid.Col = 0
    For i = 1 To 200
        Grid.Row = i: Grid.Text = " " + Str$(i) '?
    Next i
    Grid.Row = 0
    Grid.Col = 0: Grid.Text = "ĐňşĹ"
    Grid.Col = 1: Grid.Text = "ζČÖµ"
    Grid.TopRow = 1                             
    Grid.LeftCol = 1
    num = 0
End Sub
Private Sub renew()
    Dim i As Integer
    If num = 0 Then Exit Sub
    tempText.Text = "": averText.Text = ""
    minText.Text = "": maxText.Text = ""
    Grid.Clear
    Pic1.Cls
    For i = 0 To num - 1
        datatemp(i) = 0
    Next i
    num = 0
    Call tabinit
End Sub

http://vbnet.cz/blog-clanek--377-5_hlavn...