Attribute VB_Name = "Module1"

' rev PF 03-01-2019
' modif pour usage RSCOM.DLL
' modif pour envoi de la table


Option Explicit                         'force explicit variable declaration
Declare Function OPENCOM Lib "C:\WINDOWS\RSCOM.dll" (ByVal OpenString$) As Integer                 'ouvre le port
Attribute OPENCOM.VB_ProcData.VB_Invoke_Func = " \n14"
Declare Sub CLOSECOM Lib "C:\WINDOWS\RSCOM.dll" ()                                                 'fermer le port com
Attribute CLOSECOM.VB_ProcData.VB_Invoke_Func = " \n14"
Declare Sub CLEARBUFFER Lib "C:\WINDOWS\RSCOM.dll" ()                                'Nettoye le buffer en entrée
Attribute CLEARBUFFER.VB_ProcData.VB_Invoke_Func = " \n14"
Declare Function INBUFFER Lib "C:\WINDOWS\RSCOM.dll" () As Integer                   'Nombre de caractère dans le buffer d'entré
Attribute INBUFFER.VB_ProcData.VB_Invoke_Func = " \n14"
Declare Function OUTBUFFER Lib "C:\WINDOWS\RSCOM.dll" () As Integer                  'Nombre de caractère dans le buffer de sortie ?
Attribute OUTBUFFER.VB_ProcData.VB_Invoke_Func = " \n14"
Declare Sub BUFFERSIZE Lib "C:\WINDOWS\RSCOM.dll" (ByVal b%)                         'Change la taille du buffer Taille du buffer
Attribute BUFFERSIZE.VB_ProcData.VB_Invoke_Func = " \n14"
Declare Sub DELAY Lib "C:\WINDOWS\RSCOM.dll" (ByVal ms As Double)                   'delai en micro seconde // duree d'un bit
Attribute DELAY.VB_ProcData.VB_Invoke_Func = " \n14"
Declare Function INPUTS Lib "C:\WINDOWS\RSCOM.dll" () As Integer                          '?
Attribute INPUTS.VB_ProcData.VB_Invoke_Func = " \n14"
Declare Sub REALTIME Lib "C:\WINDOWS\RSCOM.dll" ()                                        '?
Attribute REALTIME.VB_ProcData.VB_Invoke_Func = " \n14"
Declare Function READSTRING Lib "C:\WINDOWS\RSCOM.dll" () As String                       'Relire une chaine
Attribute READSTRING.VB_ProcData.VB_Invoke_Func = " \n14"
Declare Function READBYTE Lib "C:\WINDOWS\RSCOM.dll" () As Integer                        'Lire un caratère
Attribute READBYTE.VB_ProcData.VB_Invoke_Func = " \n14"
Declare Sub NORMALTIME Lib "C:\WINDOWS\RSCOM.dll" ()
Attribute NORMALTIME.VB_ProcData.VB_Invoke_Func = " \n14"
Declare Sub SENDBYTE Lib "C:\WINDOWS\RSCOM.dll" (ByVal Dat%)                  'Envoyer un caratère
Attribute SENDBYTE.VB_ProcData.VB_Invoke_Func = " \n14"
Declare Sub SendString Lib "C:\WINDOWS\RSCOM.dll" Alias "SENDSTRING" (ByVal Dat$) 'Envoyer une chaine
Attribute SendString.VB_ProcData.VB_Invoke_Func = " \n14"
Declare Sub TIMEINIT Lib "C:\WINDOWS\RSCOM.dll" ()                                  'Reinit le temps
Attribute TIMEINIT.VB_ProcData.VB_Invoke_Func = " \n14"
Declare Sub TIMEOUTS Lib "C:\WINDOWS\RSCOM.dll" (ByVal b%)                   'depassement du temps ?
Attribute TIMEOUTS.VB_ProcData.VB_Invoke_Func = " \n14"
Declare Function TIMEREAD Lib "C:\WINDOWS\RSCOM.dll" () As Double                   'donne le temps d'ouverture du port ?
Attribute TIMEREAD.VB_ProcData.VB_Invoke_Func = " \n14"

Private Const Sheet1 As String = "Progr.de chauffe"
Private Const MaxFrameLength As Byte = 128
Dim s1 As Variant


Global ComPort As String
Dim i, J, k, k1, k2 As Integer
Dim A$, b$, C$, D$, E$, R$
Dim m As Integer
Dim L1 As Long
Dim Poids(24) As Long
Dim Table(32) As Long
Dim File$
Const Version = "04-01-2019"


Dim ShiftArray(15) As Integer




Public Function shl(ByVal Value As Integer, ByVal Shift As Integer) As Integer
Attribute shl.VB_ProcData.VB_Invoke_Func = " \n14"
    shl = Value
    If Shift > 0 Then
        Dim i As Byte
        Dim m As Long
        For i = 1 To Shift
            m = shl And &H4000
            shl = (shl And &H3FFF) * 2
            If m <> 0 Then
                shl = shl Or &H8000
            End If
        Next i
    End If
End Function




' VBRAY terminal simule la trame EDF Info via
' 18LF46K22_EDFinfo_BT_2019.tsc"



Sub Programmation()
Attribute Programmation.VB_Description = "Macro enregistrée le 17/12/2018 par PF"
Attribute Programmation.VB_ProcData.VB_Invoke_Func = " \n14"
'
' Macro1 Macro
' Macro enregistrée le 17/12/2018 par PF
'
'Debug.Print "shiftarray"
'For i = 0 To 14
' 1, 2, 4, 8, 16, 32, 64, 128, 256, 512, 1024, 2048, 4096, 8192, 16384
'ShiftArray(i) = 2 ^ i
'Debug.Print ShiftArray(i)
'Next i

A$ = "Version " + Version + Chr$(13) + "Traitement du Tableau de " + Chr$(13) _
+ "programmation CHAUFFAGES" + Chr$(13) + "mouline...." + Chr$(13) _
+ "..et crée la ligne Fichier en B21" + Chr$(13) + " à envoyer au PIC"
'Sheets("Progr.de chauffe").Select
'Set s1 = ThisWorkbook.Sheets(Sheet1)
Set s1 = Feuil11
s1.Activate
MsgBox (A$)
File$ = Chr$(2) + "CHAUFF;"
ComPort = "COM3:19200,N,8,1"
 s1.Button2_Envoi_UART.Enabled = False
s1.TextBox1.Text = "COM3:19200,N,8,1"




'Range("L102C4:L102C27").Select
'  A$ = "AO"
' For i = 0 To 23
'   b$ = Trim$(Str$(i + 10)) ' debut à AAF10
'   Poids(i) = 2 ^ i
'   L1 = Poids(i)
'   C$ = A$ + b$
'   Range(C$).Select
'   ActiveCell.Value = L1
' Next i
'
k = 0
m = 0
For i = 0 To 23
   L1 = 0
   ' 5 rangées à traiter
   For J = 0 To 4
     'colonne
     b$ = "1" + Trim$(Str$(7 - J)) ' debut à B17
     ' rangee
     A$ = Chr$(66 + i) ' lettre B à ...
     C$ = A$ + b$
     Debug.Print C$
     Range(C$).Select
     D$ = ActiveCell.Value
    'Poids Rangée
    Select Case (D$)
    Case "M"
         L1 = L1 + 256
     Case "C"
         ' on fait rien
     Case "H"
          L1 = L1 + shl(2, J * 2)
     Case "A"
          L1 = L1 + shl(1, J * 2)
     Case "E"
          L1 = L1 + shl(3, J * 2)
    End Select
  Next J
  
  Debug.Print Str$(i); " L1="; L1;
  Table(m) = L1
  A$ = "AA" + Trim$(Str$(m + 10))
  Range(A$).Select
  E$ = Trim$(Str$(L1))
  If L1 < 100 Then E$ = "0" + E$
  If L1 < 10 Then E$ = "0" + E$
  ActiveCell = E$
  File$ = File$ + E$ + ";"
  m = m + 1
 Next i
 

' reformatte Binaire sur 9 bits (utiles)
'utiliser DECBIN(Nombre,Nb bits)
'au lieu de  Dec2Bin(value,taille); qui ne marche que pour 8 bits


 
  File$ = Chr$(2) + File$ + Chr$(3) + Chr$(13)
  Range("B21").Select
  ActiveCell = File$
  
 ' transpose la colonne sous le tableau
 Range("AA10:AA33").Select
    Selection.Copy
    Range("B19").Select
    Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
        , Transpose:=True
    ActiveWindow.SmallScroll ToRight:=2
    Range("A21").Select
    
 s1.Button2_Envoi_UART.Enabled = True
End Sub


Sub recupere()
Attribute recupere.VB_ProcData.VB_Invoke_Func = " \n14"
   Range("T21").Select
    k1 = ActiveCell.Value
    L2 = Poids(k1)
     Range("R20").Select
     L2 = ActiveCell.Value
     K3 = k2 And L2
     Range("T23").Select
     ActiveCell = K3
     
End Sub


Sub SendData(ComPort)
Attribute SendData.VB_ProcData.VB_Invoke_Func = " \n14"
  Dim EnvoiString As String, ErrorString As String
  Dim succ As Integer, i, J, dummy As Integer
  Dim b$
  Dim cx As Byte
  Dim k, l, n As Integer
  
  
  Set s1 = Feuil11
  s1.Activate    'activate data sheet
  Range("B21").Select
  EnvoiString = ActiveCell.Value
  'Debug.Print "  "; EnvoiString
  succ = 0
  succ = OPENCOM(ComPort)     'open serial communication port (DTR=1, RTS=0)
  
If (succ = 0) Then
    dummy = MsgBox("RS232 connection failed: " & ComPort, vbCritical, "RSCOM.dll")

  Else
    'TIMEOUTS 1500
    'TIMEINIT
    n = OUTBUFFER
     'reset time
    k = 1
    l = Len(EnvoiString)
    Do
    cx = Asc(Mid$(EnvoiString, k, 1))
    Debug.Print cx
    SENDBYTE cx
    DoEvents
    k = k + 1
    Loop Until k > l
      '************** End Outer Loop *************
    CLOSECOM
    dummy = MsgBox("Fin d'envoi" + Chr$(13) + Str$(l) + " bytes", vbOK, "")
     
 End If   ' succes=0
    ' s1.Button2_Envoi_UART.Enabled = False
End Sub