Tim_Timer
Private Sub Tim_Timer()
FondBas.Panels(1).Text = TcpServerStates(TcpServer(0).State)
Inc CompteurSecondes
If CompteurSecondes >= 60 Then
CompteurSecondes = 0
If EcouterLeSiteEdf Then RaffrEdfSite
End If
If MonID.ComputerName <> « MrdDomoGiada » Then
TempActuelle = « 12.5 »: LblVal(0).Caption = TempActuelle
ConsigneTemp = « 11.0 »: LblVal(1).Caption = ConsigneTemp
ForcageCons = « 99.9 »: LblVal(2).Caption = ForcageCons
MonHeureTsx = Now: Me.Caption = MonApp.Titre & » [Heure TSX: » & MonHeureTsx & « ] »
For i = 0 To 11
ConsignesTemperature(i) = Format$(i, « 00.0 »)
LblVal(i + 3).Caption = ConsignesTemperature(i)
Next i
Exit Sub
End If
Dim MaCategorie As String
Dim MonAction As String, GChange As Boolean
Grp.Read
TempActuelle = « ??? »
ConsigneTemp = « ??? »
ForcageCons = « ??? »
MonHeureTsx = « ??? »
If Grp.GetQuality(MonAdresseHoroTsx) = 192 Then
MesValeursHoroTsx = Grp.GetValue(MonAdresseHoroTsx)
MonHeureTsx = TsxHoroToString(MesValeursHoroTsx)
Me.Caption = MonApp.Titre & » [Heure TSX: » & MonHeureTsx & « ] »
End If
If Grp.GetQuality(MonAdresseTemperature) = 192 Then
MesValeursTemperature = Grp.GetValue(MonAdresseTemperature)
TempActuelle = Format$(MesValeursTemperature(0) / 10, « 0.0 »)
ConsigneTemp = Format$(MesValeursTemperature(2) / 10, « 0.0 »)
LblVal(0).Caption = TempActuelle
LblVal(1).Caption = ConsigneTemp
End If
If Grp.GetQuality(MonAdresseConsignesTemperature) = 192 Then
MesValeursConsignesTemperature = Grp.GetValue(MonAdresseConsignesTemperature)
For i = 0 To 11
ConsignesTemperature(i) = Format$(MesValeursConsignesTemperature(i) / 10, « 0.0 »)
LblVal(i + 3).Caption = ConsignesTemperature(i)
Next i
End If
If Grp.GetQuality(MonAdresseForcageTemperature) = 192 Then
MesValeursForcageTemperature = Grp.GetValue(MonAdresseForcageTemperature)
ForcageCons = Format$(MesValeursForcageTemperature / 10, « 0.0 »)
LblVal(2).Caption = ForcageCons
End If
If Grp.GetQuality(MonAdresseRecopieSortiesTsx_MW60) = 192 Then
MesValeursRecopieSortiesTsx_MW60 = Grp.GetValue(MonAdresseRecopieSortiesTsx_MW60)
Dim CouleurJour As Integer
If LireBit(MesValeursRecopieSortiesTsx_MW60, 9) Then CouleurJour = 1
If LireBit(MesValeursRecopieSortiesTsx_MW60, 10) Then CouleurJour = 2
If LireBit(MesValeursRecopieSortiesTsx_MW60, 11) Then CouleurJour = 3
Dim CouleurDemain As Integer
If LireBit(MesValeursRecopieSortiesTsx_MW60, 6) Then CouleurDemain = 1
If LireBit(MesValeursRecopieSortiesTsx_MW60, 7) Then CouleurDemain = 2
If LireBit(MesValeursRecopieSortiesTsx_MW60, 8) Then CouleurDemain = 3
Dim Hc As Boolean, Hp As Boolean
Hc = LireBit(MesValeursRecopieSortiesTsx_MW60, 12)
Hp = Not Hc
Lbl(3).FontBold = Hp And CouleurJour = 1
Lbl(4).FontBold = CouleurJour = 1 And CouleurDemain = 1
Lbl(5).FontBold = CouleurJour = 1 And CouleurDemain = 2
Lbl(6).FontBold = CouleurJour = 1 And CouleurDemain = 3
For i = 3 To 6
If Lbl(i).FontBold Then
Lbl(i).BackColor = MrdBleu
If Hp And i = 3 Then
Lbl(i).ForeColor = MrdVertFoncé
ElseIf Hc And i <> 3 Then
Lbl(i).ForeColor = MrdVertFoncé
Else
Lbl(i).ForeColor = MrdRouge
End If
Else
Lbl(i).BackColor = 16777152
Lbl(i).ForeColor = MrdNoir
End If
LblVal(i).BackColor = Lbl(i).BackColor
LblVal(i).ForeColor = Lbl(i).ForeColor
Next i
Lbl(7).FontBold = Hp And CouleurJour = 2
Lbl(8).FontBold = CouleurJour = 2 And CouleurDemain = 1
Lbl(9).FontBold = CouleurJour = 2 And CouleurDemain = 2
Lbl(10).FontBold = CouleurJour = 2 And CouleurDemain = 3
For i = 7 To 10
If Lbl(i).FontBold Then
Lbl(i).BackColor = MrdBlanc
If Hp And i = 7 Then
Lbl(i).ForeColor = MrdVertFoncé
ElseIf Hc And i <> 7 Then
Lbl(i).ForeColor = MrdVertFoncé
Else
Lbl(i).ForeColor = MrdRouge
End If
Else
Lbl(i).BackColor = 14737632
Lbl(i).ForeColor = MrdNoir
End If
LblVal(i).BackColor = Lbl(i).BackColor
LblVal(i).ForeColor = Lbl(i).ForeColor
Next i
Lbl(11).FontBold = Hp And CouleurJour = 3
Lbl(12).FontBold = CouleurJour = 3 And CouleurDemain = 1
Lbl(13).FontBold = CouleurJour = 3 And CouleurDemain = 2
Lbl(14).FontBold = CouleurJour = 3 And CouleurDemain = 3
For i = 11 To 14
If Lbl(i).FontBold Then
Lbl(i).BackColor = MrdRouge
If Hp And i = 7 Then
Lbl(i).ForeColor = MrdVertFoncé
ElseIf Hc And i <> 7 Then
Lbl(i).ForeColor = MrdVertFoncé
Else
Lbl(i).ForeColor = MrdNoir
End If
Else
Lbl(i).BackColor = 12632319
Lbl(i).ForeColor = MrdNoir
End If
LblVal(i).BackColor = Lbl(i).BackColor
LblVal(i).ForeColor = Lbl(i).ForeColor
Next i
End If
If Grp.GetQuality(MonAdresseMasqueSortiesTsx_MW61) = 192 Then
MesValeursMasqueSortiesTsx_MW61 = Grp.GetValue(MonAdresseMasqueSortiesTsx_MW61)
End If
If Grp.GetQuality(MonAdresseSiteEdf) = 192 Then
MesValeursSiteEdf = Grp.GetValue(MonAdresseSiteEdf)
ChkEcouterSiteEdf.Value = Abs(LireBit(MesValeursSiteEdf, 0))
End If
For i = 3 To 14
Toto = Split(Lbl(i).ToolTipText)
PicDifferent(i).Visible = Val(Toto(1)) <> Val(LblVal(i).Caption)
Next i
End Sub
RaffrEdfSite
Sub RaffrEdfSite()
Dim EdfSite As String
Dim CouleurAujourdHui As Integer, CouleurDemain As Integer
Dim NbJoursBleusRestants As Integer, NbJoursBlancsRestants As Integer, NbJoursRougesRestants As Integer
EdfSite = « https://particulier.edf.fr/bin/edf_rc/servlets/ejptemponew?TypeAlerte=TEMPO&Date_a_remonter= » & Format(Now, « yyyy-mm-dd »)
TxtWeb.Text = Inet.OpenURL(EdfSite)
TxtWeb.Text = Replace(TxtWeb.Text, « {« , « »)
TxtWeb.Text = Replace(TxtWeb.Text, « } », « »)
TxtWeb.Text = Replace(TxtWeb.Text, Chr(34), « »)
If Trim(TxtWeb.Text) = « » Then Exit Sub
Err.Clear: On Error Resume Next
Toto = Split(TxtWeb.Text, « , »)
If IsArray(Toto) Then
riri = Split(Toto(0), « : »)
fifi = Split(Toto(1), « : »)
Else
Exit Sub
End If
If Error$ <> « » Then
MsgBox « Le site renvoit une merde: » & vbCrLf & TxtWeb.Text & vbCrLf & « Désolé… »
On Error GoTo 0
Exit Sub
End If
On Error GoTo 0
‘Affectation de la couleur d’Aujourd’hui
If InStr(LCase(fifi(2)), « bleu ») > 0 Then
ShaAujourdhui.BackColor = MrdBleu
CouleurAujourdHui = 1
ElseIf InStr(LCase(fifi(2)), « blanc ») Then
ShaAujourdhui.BackColor = MrdBlanc
CouleurAujourdHui = 2
ElseIf InStr(LCase(fifi(2)), « rouge ») Then
ShaAujourdhui.BackColor = MrdRouge
CouleurAujourdHui = 3
Else
ShaAujourdhui.BackColor = MrdGrisClair
CouleurAujourdHui = 4
End If
‘Affectation de la couleur de Demain
If InStr(LCase(riri(2)), « bleu ») Then
ShaDemain.BackColor = MrdBleu
CouleurDemain = 1
ElseIf InStr(LCase(riri(2)), « blanc ») Then
ShaDemain.BackColor = MrdBlanc
CouleurDemain = 2
ElseIf InStr(LCase(riri(2)), « rouge ») Then
ShaDemain.BackColor = MrdRouge
CouleurDemain = 3
Else
ShaDemain.BackColor = MrdGrisClair
CouleurDemain = 4
End If
‘Recherche des nombres de jours restants
EdfSite = « https://particulier.edf.fr/bin/edf_rc/servlets/ejptempodaysnew?TypeAlerte=TEMPO »
TxtWeb.Text = Inet.OpenURL(EdfSite)
TxtWeb.Text = Replace(TxtWeb.Text, « {« , « »)
TxtWeb.Text = Replace(TxtWeb.Text, « } », « »)
TxtWeb.Text = Replace(TxtWeb.Text, Chr(34), « »)
Toto = Split(TxtWeb.Text, « , »)
If IsArray(Toto) Then
riri = Split(Toto(0), « : »)
fifi = Split(Toto(1), « : »)
loulou = Split(Toto(2), « : »)
Else
Exit Sub
End If
NbJoursBleusRestants = Val(loulou(1))
LblVal(15).Caption = Trim(NbJoursBleusRestants)
PicGraphBleu.Cls
PicGraphBleu.Line (0, 0)-(PicGraphBleu.Width, NbJoursBleusRestants), MrdBleu, BF
NbJoursBlancsRestants = Val(riri(1))
LblVal(16).Caption = Trim(NbJoursBlancsRestants)
PicGraphBlanc.Cls
PicGraphBlanc.Line (0, 0)-(PicGraphBlanc.Width, NbJoursBlancsRestants), MrdBlanc, BF
NbJoursRougesRestants = Val(fifi(1))
LblVal(17).Caption = Trim(NbJoursRougesRestants)
PicGraphRouge.Cls
PicGraphRouge.Line (0, 0)-(PicGraphRouge.Width, NbJoursRougesRestants), MrdRouge, BF
If QuelPc <> PcDomo Then Exit Sub
If Not EcouterLeSiteEdf Then Exit Sub
If time < « 06:05:00 » Then Exit Sub
If time > « 23:55:00 » Then Exit Sub
Dim MonMot As Integer
Grp.Read
If Grp.GetQuality(MonAdresseRecopieSortiesTsx_MW60) = 192 Then
MonMot = Grp.GetValue(MonAdresseRecopieSortiesTsx_MW60)
EcrireBit MonMot, 6, False
EcrireBit MonMot, 7, False
EcrireBit MonMot, 8, False
EcrireBit MonMot, 9, False
EcrireBit MonMot, 10, False
EcrireBit MonMot, 11, False
If CouleurAujourdHui = 1 Then
EcrireBit MonMot, 9, True
ElseIf CouleurAujourdHui = 2 Then
EcrireBit MonMot, 10, True
ElseIf CouleurAujourdHui = 3 Then
EcrireBit MonMot, 11, True
End If
If CouleurDemain = 1 Then
EcrireBit MonMot, 6, True
ElseIf CouleurDemain = 2 Then
EcrireBit MonMot, 7, True
ElseIf CouleurDemain = 3 Then
EcrireBit MonMot, 8, True
End If
Grp.Write MonAdresseRecopieSortiesTsx_MW60, (MonMot)
End If
End Sub