ENVOIS D'UNE COTE VIA RS 232

Private Sub Send(impulsion As Integer)
Dim MSB As Byte, LSB As Byte, CHKSUM As Byte
Dim tmp, heure, I
Dim vdist As Integer, vdimmin As Integer
Dim recu, tmpstr As String
    
tmp = 0
vdist = dist / 10
vdimmin = dimmin

impulsion = (impulsion * 10) - vdimmin
impulsion = Int((200 / vdist) * impulsion)

'Decoupage de l'impulsion car > a 255
MSB = Int(impulsion / 256)
LSB = Int(impulsion - (MSB * 256))

If LSB = 0 Then
    LSB = LSB + 1
End If

CHKSUM = MSB + LSB

'Pour eviter un Checksum erronné
While CHKSUM > 255
  CHKSUM = CHKSUM - 256
Wend

'debug de verification
'MsgBox "MSB : " & MSB
'MsgBox "LSB : " & LSB
'MsgBox "Check Sum : " & CHKSUM

'J'effectue ici nu petite boucle d'envoi x10, car timeout non codé
Do While tmp <> 10

'Interdiction des interuptions sur le port
    Comm1.RThreshold = 0

'Le caractere "D" symbolise le debut de la trame
    Comm1.Output = "D"
    Comm1.Output = Chr(MSB)
    Comm1.Output = Chr(LSB)
    Comm1.Output = Chr(CHKSUM)
    
    tmp = tmp + 1
    I = 0
    Effectue = ""

'Attente d'une reponse (p'tite bidouille)
    Do While I < 500
      Effectue = Comm1.Input
      If Effectue <> "" Then Exit Do
      I = I + 1
    Loop
'Remise en marche des interruptions sur le port
    Comm1.RThreshold = 1

    If Effectue = "O" Then Exit Sub
Loop

'si 10 envois ont été tentés sans réponse reçue : y'a un prob
If tmp = 10 Then
    MsgBox "Un problème empêche la transmission.", vbCritical, "Delai d'attente dépassé !"
    Exit Sub
End If
End Sub