Bienvenue aux nouveaux arrivants sur FantasPic !
- Pensez à lire les règles durant votre visite, il n'y en a pas beaucoup, mais encore faut-il les respecter .
- N’hésitez pas à faire des remarques et/ou suggestions sur le Forum, dans le but de l'améliorer et de rendre vos prochaines visites plus agréables.
- Vous pouvez regarder votre "panneau de l'utilisateur" afin de configurer vos préférences.
- Un passage par "l'utilisation du forum" est recommandé pour connaître les fonctionnalités du forum.
--- L’équipe FantasPic ---
- Pensez à lire les règles durant votre visite, il n'y en a pas beaucoup, mais encore faut-il les respecter .
- N’hésitez pas à faire des remarques et/ou suggestions sur le Forum, dans le but de l'améliorer et de rendre vos prochaines visites plus agréables.
- Vous pouvez regarder votre "panneau de l'utilisateur" afin de configurer vos préférences.
- Un passage par "l'utilisation du forum" est recommandé pour connaître les fonctionnalités du forum.
--- L’équipe FantasPic ---
Détection lever et coucher du soleil journalier
Détection lever et coucher du soleil journalier.
Principe :
Un PIC calcule l’heure de lever et coucher du soleil en hh:mm pour la date du jour et la position locale (Latitude et Longitude).
Quand l’évènement lever est détecté la sortie RA0 est activée pendant 1 mn.
Quand l’évènement coucher est détecté la sortie RA1 est activée pendant 1 mn.
Matériel :
Un PIC 18F2520 programmé en MikroBasic
RTC DS3231 en liaison I2C avec le PIC.
Un module HC-06 pour la mise à jour de la RTC avec une appli Android et liaison Bluetooth.
Un écran LCD 2x16 pour la visualisation (facultatif).
Les branchements :
Exemple pour le 06/09/2019, lever à 06:54 et coucher à 20:03
Le code :
Le module Sun Calc :
Source de ce module : Forum Mikroe.
L'appli smart phone:
Utilisation :
Le code App Inventor et le fichier Apk pour le smart phone.
Principe :
Un PIC calcule l’heure de lever et coucher du soleil en hh:mm pour la date du jour et la position locale (Latitude et Longitude).
Quand l’évènement lever est détecté la sortie RA0 est activée pendant 1 mn.
Quand l’évènement coucher est détecté la sortie RA1 est activée pendant 1 mn.
Matériel :
Un PIC 18F2520 programmé en MikroBasic
RTC DS3231 en liaison I2C avec le PIC.
Un module HC-06 pour la mise à jour de la RTC avec une appli Android et liaison Bluetooth.
Un écran LCD 2x16 pour la visualisation (facultatif).
Les branchements :
Exemple pour le 06/09/2019, lever à 06:54 et coucher à 20:03
Le code :
Code : Tout sélectionner
program SunRiseSunSet
'Fonctionnalité :
'Activation RA0 au lever du soleil pendant 1 minute.
'Activation RA1 au coucher du soleil pendant 1 minute.
'Maj RTC DS3231 par appli Android SetRtcBt.Apk en Bluetooth avec module HC-06.
'PIC 18F2520, Osc: 8MHz
Include "SunCalc_Library"
dim Delim as string[2]
SbRise,SbSet as string[6]
Rec as string[16]
TrRec as byte
Sj,Sm,Sh,Sn,Sx,Sa,Snj,_Yh11,_Yb11, Ver as byte
seconds, minutes, hours, _day, _month, year, Yb,Yh, _Yh, _Yb,Njs as byte
dim Soft_I2C_Scl as sbit at RC3_bit
Soft_I2C_Sda as sbit at RC4_bit
Soft_I2C_Scl_Direction as sbit at TRISC3_bit
Soft_I2C_Sda_Direction as sbit at TRISC4_bit
'Lcd module connections
dim LCD_RS as sbit at RB4_bit
LCD_EN as sbit at RB5_bit
LCD_D4 as sbit at RB0_bit
LCD_D5 as sbit at RB1_bit
LCD_D6 as sbit at RB2_bit
LCD_D7 as sbit at RB3_bit
LCD_RS_Direction as sbit at TRISB4_bit
LCD_EN_Direction as sbit at TRISB5_bit
LCD_D4_Direction as sbit at TRISB0_bit
LCD_D5_Direction as sbit at TRISB1_bit
LCD_D6_Direction as sbit at TRISB2_bit
LCD_D7_Direction as sbit at TRISB3_bit
'_______________________________________________________________________________
Sub procedure interrupt 'Interruption RCIF quand trame maj RTC reçue
if PIR1.RCIF = 1 then
if (UART1_Data_Ready() <> 0) then
UART1_READ_TEXT(Rec , Delim, 255)
TrRec = 1
end if
PIR1.RCIF = 0
end if
end sub
'_______________________________________________________________________________
sub procedure SetRtc()
Lcd_Cmd(_LCD_CLEAR)
'Decode trame de mise à jour reçue
' A utiliser pour simulation
'====Simu=================================
' Sj = Dec2Bcd(15) 'Simu jour
' Sm = Dec2Bcd(2) 'Simu mois
' Sh = Dec2Bcd(10) 'Simu heure
' Sn = Dec2Bcd(10) 'Simu minute
' Sx = Dec2Bcd(30) 'Simu seconde
' Snj= Dec2Bcd(7) 'Simu N° jour
' _Yb11= Dec2Bcd(20) 'Simu DU an
'====Normal================================
Sj = Dec2Bcd(Strtoword(Rec[0]+Rec[1])) 'Jour
Sm = Dec2Bcd(Strtoword(Rec[3]+Rec[4])) 'Mois
Sh = Dec2Bcd(Strtoword(Rec[9]+Rec[10])) 'Heure
Sn = Dec2Bcd(Strtoword(Rec[12]+Rec[13])) 'Minute
Sx= Dec2Bcd(Strtoword("00")) 'Seconde
Snj=Dec2Bcd(Strtoword(" "+Rec[16])) 'N° jour
_Yb11= Dec2Bcd(Strtoword(Rec[6]+Rec[7])) 'An DU adr $11
'======================================
_Yh11= Dec2Bcd(Strtoword("20")) 'An MC adr $10
Delay_ms(100)
I2C1_Start() ' Start
I2C1_wr(0xD0) ' Addresse écriture RTC
I2C1_wr(0) ' Start addresse 0
I2C1_wr(Sx) ' Write Ss à l'adresse 2 contenant les secondes
I2C1_wr(Sn) ' Write Sn à l'adresse 3 contenant les minutes
I2C1_wr(Sh) ' Write Sh à l'adresse 4 contenant les heures
I2C1_wr(Snj) ' Write N° jour
I2C1_wr(Sj) ' Write Sj à l'adresse 5 contenant les Jour
I2C1_wr(Sm) ' Write Sm à l'adresse 6 contenant les mois
I2C1_wr(_Yb11) ' Write An (dizaine unité)
I2C1_wr($90) '
I2C1_Stop() ' stop signal
delay_ms(500)
end sub
'_______________________________________________________________________________
sub procedure Lecture_Date_Heure()
I2C1_Start() ' Issue start signal
I2C1_Wr(0xD0) ' Addresse RTC
I2C1_wr(0) ' Start à l'adresse 0
I2C1_Start() ' start
I2C1_wr(0xD1) ' Addresse de lecture
seconds = I2C1_Rd(1) ' Read seconde byte
minutes = I2C1_Rd(1) ' Read minute byte
hours = I2C1_Rd(1) ' Read heure byte
Njs = I2C1_Rd(1) ' Read N° jour byte
_day = I2C1_Rd(1) ' Read jour
_month = I2C1_Rd(1) ' Read N° jour/mois byte}
Yb = I2C1_Rd(0) ' Read dizaine unité an byte
'Yh =_Yh11 ' An Millier centaine
Yh = 32 ' 32 = $20
I2C1_Stop() ' Issue stop signal}
end sub
'_______________________________________________________________________________
sub procedure Formatage_Date_Heure()
seconds = ((seconds and 0x70) >> 4)*10 + (seconds and 0x0F)
minutes = ((minutes and 0xF0) >> 4)*10 + (minutes and 0x0F)
hours = ((hours and 0x30) >> 4)*10 + (hours and 0x0F)
Njs = Njs and $07 _day = ((_day and 0x30) >> 4)*10 + (_day and 0x0F)
_month = ((_month and 0x10) >> 4)*10 + (_month and 0x0F)
_Yh = ((Yh and 0xF0)>> 4)*10 + (Yh and 0x0F )
_Yb = ((Yb and 0xF0)>> 4)*10 + (Yb and 0x0F )
'Heure d'été
if _Day > 24 then
if hours = 2 then
if _month = 3 then
if Njs = 0 then 'A adapter suivant la source (0 pour Android)
I2C1_Stop()
I2C1_Start()
I2C1_wr(0xD0)
I2C1_wr(2)
I2C1_wr(3) 'A 2 heure il est 3 heure
I2C1_Stop()
end if
end if
end if
end if
'Heure d'hiver
if _Day > 24 then
if hours = 3 then
if _month = 10 then
if Njs = 0 then 'A adapter suivant la source (0 pour Android)
setbit(portA,3)
I2C1_Stop()
I2C1_Start()
I2C1_wr(0xD0)
I2C1_wr(2)
I2C1_wr(2) 'A 3 heure il est 2 heure
I2C1_Stop()
end if
end if
end if
end if
end sub
'_______________________________________________________________________________
sub procedure Affiche_Date_Heure()
Lcd_Chr(1, 1, (_day / 10) + 48) 'Jour dizaine
Lcd_Chr(1, 2, (_day mod 10) + 48) 'Jour unité
Lcd_Out(1,3,"/")
Lcd_Chr(1,4, (_month / 10) + 48) 'Mois dizaine
Lcd_Chr(1,5, (_month mod 10) + 48) 'Mois unité
Lcd_Out(1,6,"/")
Lcd_Chr(1,7, (_Yh / 10) + 48) 'Année millier
Lcd_Chr(1,8, (_Yh mod 10) + 48) 'Année centaine
Lcd_Chr(1,9, (_Yb / 10) + 48) 'Année dizaine
Lcd_Chr(1,10, (_Yb mod 10) + 48) 'Année unité
Lcd_Chr(2, 1, (hours / 10) + 48) 'Heure dizaine
Lcd_Chr(2, 2, (hours mod 10) + 48)'Heure unité
Lcd_Out(2,3,":")
Lcd_Chr(2,4, (minutes / 10) + 48) 'Minute dizaine
Lcd_Chr(2,5, (minutes mod 10) + 48) 'Minute unité
Lcd_Out(2,6,":")
Lcd_Chr(2,7, (seconds / 10) + 48) 'Seconde dizaine
Lcd_Chr(2,8, (seconds mod 10) + 48) 'Seconde unité
' Lcd_Chr(2,12, (Njs mod 10) + 48) 'N° jour
end sub
'_______________________________________________________________________________
Sub Procedure ConfigureLocalData
SC_in_LatDeg = 48 'Nord +; Sud -
SC_in_LatMin = 4
SC_in_LatSec = 24
SC_in_LatSec100 = 59
SC_in_LonDeg = 7
SC_in_LonMin = 31
SC_in_LonSec = 54
SC_in_LonSec100 = 90
SC_in_GMToffset = 0 'Ouest -; Est +
SC_in_Latitude = GetLocalLatitude(SC_in_LatDeg, SC_in_LatMin, SC_in_LatSec, SC_in_LatSec100)
SC_in_Longitude = GetLocalLongitude(SC_in_LonDeg, SC_in_LonMin, SC_in_LonSec, SC_in_LonSec100)
SC_in_dst_SMonth = 3 ' Mois départ heure été.
SC_in_dst_EMonth = 10 ' Mois départ heure hiver.
end Sub
'_______________________________________________________________________________
main:
ConfigureLocalData()
Uart1_Init(9600) 'Init Usart
Delay_ms(200)
I2C1_Init(100000) 'Init Soft I2C
INTCON.PEIE = 1 'Perif interupt enable = true
PIE1.RCIE = 1
INTCON.GIE = 1 'Global interupt enable = true
Adcon1 = $0F 'Configure AN pins as digital I/ 'ConfigureLocalData
TRISA = 0
PORTA = 0
TrRec = 0 'Raz Trame reçu
Delim =""+"D"+chr(13) 'Délimiteur trame recu
Lcd_Init() 'Init Lcd
Lcd_Cmd(_LCD_CLEAR) 'Clear Lcd display
Lcd_Cmd(_LCD_CURSOR_OFF) 'cursor off
LCD_OUT(1,2,"SUNRISE_SUNSET")
delay_ms(3000)
Lcd_Cmd(_LCD_CLEAR)
while true
'Lecture RTC, formatage et affichage date time______________________________
if TrRec = 0 then 'Si pas de mise à jour RTC
Lecture_Date_Heure() 'Lecture dans RTC
Formatage_Date_Heure() 'Formatage date et heure
Affiche_Date_Heure() 'Affiche date heure
delay_ms(200)
SC_in_ThisYear = integer(_Yb)+2000
SC_in_ThisMonth = integer(_month)
SC_in_ThisDay = integer(_Day)
end if
'Set Rtc si trame de mise à jour reçue_______________________________________
if TrRec = 1 then
SetRtc()
TrRec = 0
end if
'_______________________________________________________________________________
GetMoreCalendarData(SC_in_ThisYear, '216
SC_in_ThisMonth, 'N° mois
SC_in_ThisDay, 'N° jour
SC_out_IsLeapYear, 'An bisextile = 255 else 0
SC_out_DayOfYear, 'Jour de l'année
SC_out_StrDayOfWeek, 'Jour 3 car string
SC_out_IntDayOfWeek, 'Dimanche = 1
SC_out_DaylightSavingTime)
'_______________________________________________________________________________
GetLocalSunRiseTime (SC_in_Latitude,
SC_in_Longitude,
SC_in_ThisYear,
SC_in_ThisMonth,
SC_in_ThisDay,
SC_in_GMToffset,
SC_out_StrBuffer,
SC_out_RiseTime_Hours,
SC_out_RiseTime_Minutes)
SbRise = SC_out_StrBuffer
LCD_OUT(1,12,SbRise)
Action sur la sortie RA0 pendant 1 minute
if Hours = SC_out_RiseTime_Hours then
if Minutes = SC_out_RiseTime_Minutes then
SetBit(PORTA,0) 'Evènement lever du soleil pendant 1 minute
end if
end if
if Hours <> SC_out_RiseTime_Hours then ClearBit(PORTA,0) end if
if Minutes <> SC_out_RiseTime_Minutes then ClearBit(PORTA,0) end if
'_______________________________________________________________________________
GetLocalSunSetTime (SC_in_Latitude,
SC_in_Longitude,
SC_in_ThisYear,
SC_in_ThisMonth,
SC_in_ThisDay,
SC_in_GMToffset,
SC_out_StrBuffer,
SC_out_SetTime_Hours,
SC_out_SetTime_Minutes)
SbSet = SC_out_StrBuffer
LCD_OUT(2,12,SbSet)
'Action sur la sortie RA1 pendant 1 minute
if Hours = SC_out_SetTime_Hours then
if Minutes = SC_out_SetTime_Minutes then
SetBit(PORTA,1) 'Evènement coucher du soleil pendant 1 minute
end if
end if
if Hours <> SC_out_SetTime_Hours then ClearBit(PORTA,1) end if
if Minutes <> SC_out_SetTime_Minutes then ClearBit(PORTA,1) end if
'_______________________________________________________________________________
delay_ms(500)
wend
end.
Le module Sun Calc :
Source de ce module : Forum Mikroe.
Code : Tout sélectionner
module SunCalc_Library
' Source forum Mikroelektronika.
'+-------------------------------------+
'+ input parameters for local latitude +
'+ SC_in_LatDeg --> North +; South -; +
'+-------------------------------------+
Dim SC_in_LatDeg as Integer
Dim SC_in_LatMin As Integer
Dim SC_in_LatSec As Integer
Dim SC_in_LatSec100 As Integer
Dim SC_in_Latitude as float
'+--------------------------------------+
'+ input parameters for local longitude +
'+ SC_in_LonDeg --> West +; East -; +
'+--------------------------------------+
Dim SC_in_LonDeg As Integer
Dim SC_in_LonMin As Integer
Dim SC_in_LonSec As Integer
Dim SC_in_LonSec100 As Integer
Dim SC_in_Longitude as float
'+------------------------------------------------+
'+ input parameter for Greenwich Mean Time offset +
'+ SC_in_GMToffset --> West -; East +; +
'+------------------------------------------------+
Dim SC_in_GMToffset as integer
'+---------------------------------+
'+ input parameters for today date +
'+---------------------------------+
Dim SC_in_ThisDay As Integer
Dim SC_in_ThisMonth As Integer
Dim SC_in_ThisYear As Integer
'+--------------------------------------------------+
'+ input parameters for Daylight Saving Time period +
'+ For Europe starting period --> march +
'+ For Europe ending period ----> october +
'+--------------------------------------------------+
Dim SC_in_dst_SMonth as integer
Dim SC_in_dst_EMonth as integer
'===============================================================================
' SC_ (SunCalc) GLOBAL OUTPUT VARIABLES
'===============================================================================
'+---------------------------------+
'+ Output values for SunRise event +
'+---------------------------------+
Dim SC_out_RiseTime_Hours as byte
Dim SC_out_RiseTime_Minutes as byte
'+--------------------------------+
'+ Output values for SunSet event +
'+--------------------------------+
Dim SC_out_SetTime_Hours as byte
Dim SC_out_SetTime_Minutes as byte
'+-----------------------------------+
'+ Output values for Noon time event +
'+-----------------------------------+
Dim SC_out_NoonTime_Hours as byte
Dim SC_out_NoonTime_Minutes as byte
'+---------------------------------------------+
'+ String output for SunRise, NoonTime, SunSet +
'+ showing hh:mm +
'+---------------------------------------------+
Dim SC_out_StrBuffer as string[5]
'+----------------------------------------+
'+ Output value for numerical day of year +
'+ indicating 1..365 +
'+----------------------------------------+
Dim SC_out_DayOfYear as integer
'+-------------------------------------+
'+ String output value for day of week +
'+ 1=monday...7=sunday +
'+-------------------------------------+
Dim SC_out_StrDayOfWeek as string[3]
'+------------------------------+
'+ Output value for day of week +
'+ 1=monday...7=sunday +
'+------------------------------+
Dim SC_out_IntDayOfWeek as integer
'+-----------------------------------+
'+ Output value for leap year result +
'+ yes=true; no=false +
'+-----------------------------------+
Dim SC_out_IsLeapYear as byte
'+-----------------------------------------------------+
'+ Output value for Daylight Saving Time period result +
'+ yes=true; no=false +
'+-----------------------------------------------------+
Dim SC_out_DaylightSavingTime as byte
'+----------------------------------------+
'+ Output values for Daylight Saving Time +
'+ starting date +
'+----------------------------------------+
Dim SC_out_DST_StartDay as integer
Dim SC_out_DST_StartMonth as integer
Dim SC_out_DST_StartYear as integer
'+----------------------------------------+
'+ Output values for Daylight Saving Time +
'+ ending date +
'+----------------------------------------+
Dim SC_out_DST_EndDay as integer
Dim SC_out_DST_EndMonth as integer
Dim SC_out_DST_EndYear as integer
'===============================================================================
'06/09/2019 Ajout pour être compatible avec la nouvelle version de Mikrobasic
Sub Function GetLocalLatitude(Dim SC_in_LatDeg As Integer,
Dim SC_in_LatMin As Integer,
Dim SC_in_LatSec As Integer,
Dim SC_in_LatSec100 As Integer) As float
Sub Function GetLocalLongitude(Dim SC_in_LonDeg As Integer,
Dim SC_in_LonMin As Integer,
Dim SC_in_LonSec As Integer,
Dim SC_in_LonSec100 As Integer) as Float
Sub Procedure GetMoreCalendarData(Dim mYear As Integer,
Dim mMonth As Integer,
Dim mDay As Integer,
Dim Byref mIsLeapYear as byte,
Dim Byref DayOfYear as integer,
Dim Byref StrDayOfWeek as string[3],
Dim Byref IntDayOfWeek as integer,
Dim Byref SC_out_DaylightSavingTime as byte)
Sub Procedure GetLocalSunSetTime(Dim SC_in_Latitude as Float,
Dim SC_in_Longitude as Float,
Dim mYear As Integer,
Dim mMonth As Integer,
Dim mDay As Integer,
Dim SC_in_GMToffset as integer,
Dim ByRef StrOut as string[5],
Dim ByRef ThoursOut as byte,
Dim Byref TminutesOut as byte)
Sub Procedure GetLocalSunRiseTime(Dim SC_in_Latitude as Float,
Dim SC_in_Longitude as Float,
Dim mYear As Integer,
Dim mMonth As Integer,
Dim mDay As Integer,
Dim SC_in_GMToffset as integer,
Dim ByRef StrOut as string[5],
Dim ByRef ThoursOut as byte,
Dim Byref TminutesOut as byte)
Sub Procedure GetLocalNoonTime(Dim SC_in_Longitude as Float,
Dim mYear As Integer,
Dim mMonth As Integer,
Dim mDay As Integer,
Dim SC_in_GMToffset as integer,
Dim ByRef StrOut as string[5],
Dim ByRef ThoursOut as byte,
Dim Byref TminutesOut as byte)
'Fin ajout
'===============================================================================
implements
'//****************************************************************************/
'//* Name: GetLocalLatitude */
'//* Type: Function */
'//* Purpose: */
'//* Arguments: */
'//* */
'//****************************************************************************/
Sub Function GetLocalLatitude(Dim SC_in_LatDeg As Integer,
Dim SC_in_LatMin As Integer,
Dim SC_in_LatSec As Integer,
Dim SC_in_LatSec100 As Integer) As float
Dim w As float
Dim p As float
p = float(SC_in_LatSec) + float(SC_in_LatSec100) / 100.0
If SC_in_LatDeg > 0 Then
w = float(SC_in_LatDeg) / 1.0
w = w + float(SC_in_LatMin) / 60.0
w = w + p / 3600.0
Else
w = float(SC_in_LatDeg) / 1.0
w = w - float(SC_in_LatMin) / 60.0
w = w - p / 3600.0
End If
If w < -89.0 Then
w = -89.0
End If
If w > 89.0 Then
w = 89.0
End If
Result = w
End sub
'//****************************************************************************/
'//* Name: GetSC_in_Longitude */
'//* Type: Function */
'//* Purpose: */
'//* Arguments: */
'//* */
'//****************************************************************************/
Sub Function GetLocalLongitude(Dim SC_in_LonDeg As Integer,
Dim SC_in_LonMin As Integer,
Dim SC_in_LonSec As Integer,
Dim SC_in_LonSec100 As Integer) as Float
Dim w as Float
Dim p as Float
p = float(SC_in_LonSec) + float(SC_in_LonSec100) / 100.0
If SC_in_LonDeg > 0 Then
w = float(SC_in_LonDeg) / 1.0
w = w + float(SC_in_LonMin) / 60.0
w = w + p / 3600.0
Else
w = float(SC_in_LonDeg) / 1.0
w = w - float(SC_in_LonMin) / 60.0
w = w - p / 3600.0
End If
Result = w
End Sub
'//****************************************************************************/
'//* Name: isLeapYear */
'//* Type: Function */
'//* Purpose: */
'//* Arguments: */
'//* */
'//****************************************************************************/
Sub Function isLeapYear(Dim yr As Integer) As byte
If ((yr Mod 4 = 0) And (yr Mod 100 <> 0)) Or (yr Mod 400 = 0) Then
Result = True
Else
Result = False
End If
End Sub
'=====================================================================
' Convert radian angle to degrees
'=====================================================================
Sub Function RadToDeg(Dim RadAngle as Float) as Float
Result = (180.0 * RadAngle / 3.14159265358979)
End Sub
'=====================================================================
' Convert degree angle to radians
'=====================================================================
Sub Function DegToRad(Dim DegAngle as Float) as Float
Result = (DegAngle * 3.14159265358979 / 180.0)
End Sub
'//****************************************************************************/
'//* Name: calcDayOfYear */
'//* Type: Function */
'//* Purpose: Finds numerical day-of-year from mn, day and lp year info */
'//* Arguments: */
'//* month: January = 1 */
'//* day : 1 - 31 */
'//* lpyr : 1 if leap year, 0 if not */
'//* Return value: */
'//* The numerical day of year */
'//****************************************************************************/
Sub Function calcDayOfYear(Dim mMonth As Integer,
Dim mday As Integer,
Dim lpyr As byte) As integer
Dim k As Integer
If lpyr = True Then
k = 1
Else
k = 2
End If
Result = integer(floor((275.0 * float(mMonth)) / 9.0) -
float(k) * floor((float(mMonth) + 9.0) /
12.0) + float(mday) - 30.0)
End Sub
'//***********************************************************************/
'//* Name: calcDayOfWeek */
'//* Type: Function */
'//* Purpose: Derives weekday from Julian Day */
'//* Arguments: */
'//* juld : Julian Day */
'//* Return value: */
'//* String containing name of weekday */
'//***********************************************************************/
Sub Procedure calcDayOfWeek(Dim JulD as Float,
Dim ByRef StrDayOfWeek as string[3],
Dim Byref IntDayOfWeek as integer)
Dim a1,a2 as float
Dim ba as float
Dim bc as integer
StrDayOfWeek = " "
IntDayOfWeek = 0
a1 = JulD + 1.5
a2 = a1 / 7.0
ba = a1 - floor(a2) * 7.0
bc = integer(ba)
Select Case bc
Case 0
StrDayOfWeek = "Dim"
Case 1
StrDayOfWeek = "Lun"
Case 2
StrDayOfWeek = "Mar"
Case 3
StrDayOfWeek = "Mer"
Case 4
StrDayOfWeek = "Jeu"
Case 5
StrDayOfWeek = "Ven"
Case 6
StrDayOfWeek = "Sam"
End Select
if bc > 0 then
IntDayOfWeek = bc
else
IntDayOfWeek = 7
end if
End Sub
'//*** [1] ***************************************************************/
'//* Name: calcJD */
'//* Type: Function */
'//* Purpose: Julian day from calendar day */
'//* Arguments: */
'//* year : 4 digit year */
'//* month: January = 1 */
'//* day : 1 - 31 */
'//* Return value: */
'//* The Julian day corresponding to the date */
'//* Note: */
'//* Number is returned for start of day. Fractional days should be */
'//* added later. */
'//***********************************************************************/
Sub Function CalcJD(dim aYear As Integer,
dim aMonth As Integer,
dim aDay As Integer) As float
Dim cMonth As integer
Dim cYear As integer
Dim cDay As integer
Dim A As integer
Dim B As integer
If aMonth <= 2 Then
cYear = aYear - 1
cMonth = aMonth + 12
Else
cYear = aYear
cMonth = aMonth
End If
cDay = aDay
A = floor(cYear / 100.0)
B = 2.0 - A + floor(A / 4.0)
Result = floor(365.25 * (cYear + 4716)) +
floor(30.6001 * (cMonth + 1)) +
cDay + B - 1524.5
End Sub
'//*** [2] **************************************************************/
'//* Name: calcTimeJulianCent */
'//* Type: Function */
'//* Purpose: convert Julian Day to centuries since J2000.0. */
'//* Arguments: */
'//* jd : the Julian Day to convert */
'//* Return value: */
'//* the value corresponding to the Julian Day */
'//**********************************************************************/
Sub Function CalcTimeJulianCent(Dim JD as Float) as Float
Result = (JD - 2451545.0) / 36525.0
End Sub
'//**********************************************************************/
'//* Name: calcJDFromJulianCent */
'//* Type: Function */
'//* Purpose: convert centuries since J2000.0 to Julian Day. */
'//* Arguments: */
'//* t : number of Julian centuries since J2000.0 */
'//* Return value: */
'//* the Julian Day corresponding to the t value */
'//**********************************************************************/
Sub Function CalcJDFromJulianCent(Dim t as Float) as Float
Result = t * 36525.0 + 2451545.0
End Sub
'//**********************************************************************/
'//* Name: calGeomMeanLongSun */
'//* Type: Function */
'//* Purpose: calculate the Geometric Mean SC_in_Longitude of the Sun */
'//* Arguments: */
'//* t : number of Julian centuries since J2000.0 */
'//* Return value: */
'//* the Geometric Mean SC_in_Longitude of the Sun in degrees */
'//**********************************************************************/
Sub Function CalcGeomMeanLongSun(Dim t as Float) as Float
Dim L0 as Float
L0 = 280.46646 + t * (36000.76983 + 0.0003032 * t)
While (L0 > 360.0)
L0 = L0 - 360.0
Wend
While (L0 < 0.0)
L0 = L0 + 360.0
Wend
Result = L0
End Sub
'//**********************************************************************/
'//* Name: calGeomAnomalySun */
'//* Type: Function */
'//* Purpose: calculate the Geometric Mean Anomaly of the Sun */
'//* Arguments: */
'//* t : number of Julian centuries since J2000.0 */
'//* Return value: */
'//* the Geometric Mean Anomaly of the Sun in degrees */
'//**********************************************************************/
Sub Function CalcGeomMeanAnomalySun(Dim t as Float) as Float
Result = 357.52911 + t * (35999.05029 - 0.0001537 * t)
End Sub
'//**********************************************************************/
'//* Name: calcEccentricityEarthOrbit */
'//* Type: Function */
'//* Purpose: calculate the eccentricity of earth's orbit */
'//* Arguments: */
'//* t : number of Julian centuries since J2000.0 */
'//* Return value: */
'//* the unitless eccentricity */
'//**********************************************************************/
Sub Function CalcEccentricityEarthOrbit(Dim t as Float) as Float
Result = 0.016708634 - t * (0.000042037 + 0.0000001267 * t)
End Sub
'//**********************************************************************/
'//* Name: calcMeanObliquityOfEcliptic */
'//* Type: Function */
'//* Purpose: calculate the mean obliquity of the ecliptic */
'//* Arguments: */
'//* t : number of Julian centuries since J2000.0 */
'//* Return value: */
'//* mean obliquity in degrees */
'//**********************************************************************/
Sub Function CalcMeanObliquityOfEcliptic(Dim t as Float) as Float
Dim seconds as Float
seconds = 21.448 - t * (46.815 + t * (0.00059 - t * (0.001813)))
Result = 23.0 + (26.0 + (seconds / 60.0)) / 60.0
End Sub
'//**********************************************************************/
'//* Name: calcObliquityCorrection */
'//* Type: Function */
'//* Purpose: calculate the corrected obliquity of the ecliptic */
'//* Arguments: */
'//* t : number of Julian centuries since J2000.0 */
'//* Return value: */
'//* corrected obliquity in degrees */
'//**********************************************************************/
Sub Function CalcObliquityCorrection(Dim t as Float) as Float
Dim omega as Float
omega = 125.04 - 1934.136 * t
Result = CalcMeanObliquityOfEcliptic(t) + 0.00256 * Cos(DegToRad(omega))
End Sub
'//**********************************************************************/
'//* Name: calcEquationOfTime */
'//* Type: Function */
'//* Purpose: calculate the difference between true solar time and mean */
'//* solar time */
'//* Arguments: */
'//* t : number of Julian centuries since J2000.0 */
'//* Return value: */
'//* equation of time in minutes of time */
'//**********************************************************************/
Sub Function CalcEquationOfTime(Dim t as Float) as Float
Dim Epsilon as Float
Dim L0 as Float
Dim e as Float
Dim m as Float
Dim y as Float
Dim Sin2l0 as Float
Dim Sinm as Float
Dim Cos2l0 as Float
Dim Sin4l0 as Float
Dim Etime as Float
Epsilon = CalcObliquityCorrection(t)
L0 = CalcGeomMeanLongSun(t)
e = CalcEccentricityEarthOrbit(t)
m = CalcGeomMeanAnomalySun(t)
y = Tan(DegToRad(Epsilon) / 2.0)
y = y * y
Sin2l0 = Sin(2.0 * DegToRad(L0))
Sinm = Sin(DegToRad(m))
Cos2l0 = Cos(2.0 * DegToRad(L0))
Sin4l0 = Sin(4.0 * DegToRad(L0))
Etime = y * Sin2l0 - 2.0 * e * Sinm +
4.0 * e * y * Sinm *
Cos2l0 - 0.5 * y * y *
Sin4l0 - 1.25 * e * e *
Sin(2.0 * DegToRad(m))
Result = RadToDeg(Etime) * 4.0
End Sub
'//**********************************************************************/
'//* Name: calcSolNoonUTC */
'//* Type: Function */
'//* Purpose: calculate the Universal Coordinated Time (UTC) of solar */
'//* noon for the given day at the given location on earth */
'//* Arguments: */
'//* t : number of Julian centuries since J2000.0 */
'//* SC_in_Longitude : SC_in_Longitude of observer in degrees */
'//* Return value: */
'//* time in minutes from zero Z */
'//**********************************************************************/
Sub Function CalcSolNoonUTC(Dim t as Float,
Dim SC_in_Longitude as Float) as Float
Dim tnoon as Float
Dim eqTime as Float
Dim solNoonUTC as Float
Dim NewT as Float
tnoon = CalcTimeJulianCent(CalcJDFromJulianCent(t) + SC_in_Longitude / 360.0)
eqTime = CalcEquationOfTime(tnoon)
solNoonUTC = 720.0 + (SC_in_Longitude * 4.0) - eqTime '// min
NewT = CalcTimeJulianCent(CalcJDFromJulianCent(t) -
0.5 + solNoonUTC / 1440.0)
eqTime = CalcEquationOfTime(NewT)
solNoonUTC = 720.0 + (SC_in_Longitude * 4.0) - eqTime ' // min
Result = solNoonUTC
End Sub
'//**********************************************************************/
'//* Name: calcSunEqOfCenter */
'//* Type: Function */
'//* Purpose: calculate the equation of center for the sun */
'//* Arguments: */
'//* t : number of Julian centuries since J2000.0 */
'//* Return value: */
'//* in degrees */
'//**********************************************************************/
Sub Function CalcSunEqOfCenter(Dim t as Float) as Float
Dim mRad as Float
Dim Sin1m as Float
Dim Sin2m as Float
Dim Sin3m as Float
Dim C as Float
mRad = DegToRad(CalcGeomMeanAnomalySun(t))
Sin1m = Sin(mRad)
Sin2m = Sin(mRad + mRad)
Sin3m = Sin(mRad + mRad + mRad)
C = Sin1m * (1.914602 - t * (0.004817 + 0.000014 * t)) +
Sin2m * (0.019993 - 0.000101 * t) + Sin3m * 0.000289
Result = C ' in degrees
End Sub
'//**********************************************************************/
'//* Name: calcSunTrueLong */
'//* Type: Function */
'//* Purpose: calculate the true SC_in_Longitude of the sun */
'//* Arguments: */
'//* t : number of Julian centuries since J2000.0 */
'//* Return value: */
'//* sun's true SC_in_Longitude in degrees */
'//**********************************************************************/
Sub Function CalcSunTrueLong(Dim t as Float) as Float
Result = CalcGeomMeanLongSun(t) + CalcSunEqOfCenter(t)
End Sub
'//**********************************************************************/
'//* Name: calcSunTrueAnomaly */
'//* Type: Function */
'//* Purpose: calculate the true anamoly of the sun */
'//* Arguments: */
'//* t : number of Julian centuries since J2000.0 */
'//* Return value: */
'//* sun's true anamoly in degrees */
'//**********************************************************************/
Sub Function CalcSunTrueAnomaly(Dim t as Float) as Float
Result = CalcGeomMeanAnomalySun(t) + CalcSunEqOfCenter(t)
End Sub
'//**********************************************************************/
'//* Name: calcSunRadVector */
'//* Type: Function */
'//* Purpose: calculate the distance to the sun in AU */
'//* Arguments: */
'//* t : number of Julian centuries since J2000.0 */
'//* Return value: */
'//* sun radius vector in AUs */
'//**********************************************************************/
Sub Function CalcSunRadVector(Dim t as Float) as Float
Dim v as Float
Dim ee as Float
v = CalcSunTrueAnomaly(t)
ee = CalcEccentricityEarthOrbit(t)
Result = (1.000001018 * (1.0 - ee * ee)) / (1.0 + ee * Cos(DegToRad(v)))
End Sub
'//**********************************************************************/
'//* Name: calcSunApparentLong */
'//* Type: Function */
'//* Purpose: calculate the apparent SC_in_Longitude of the sun */
'//* Arguments: */
'//* t : number of Julian centuries since J2000.0 */
'//* Return value: */
'//* sun's apparent SC_in_Longitude in degrees */
'//**********************************************************************/
Sub Function CalcSunApparentLong(Dim t as Float) as Float
Result = CalcSunTrueLong(t) - 0.00569 -
0.00478 * Sin(DegToRad(125.04 - 1934.136 * t))
End Sub
'//**********************************************************************/
'//* Name: calcSunRtAscension */
'//* Type: Function */
'//* Purpose: calculate the right ascension of the sun */
'//* Arguments: */
'//* t : number of Julian centuries since J2000.0 */
'//* Return value: */
'//* sun's right ascension in degrees */
'//**********************************************************************/
Sub Function CalcSunRtAscension(Dim t as Float) as Float
Dim e as Float
Dim lambda as Float
Dim tananum as Float
Dim tanadenom as Float
e = CalcObliquityCorrection(t)
lambda = CalcSunApparentLong(t)
tananum = (Cos(DegToRad(e)) * Sin(DegToRad(lambda)))
tanadenom = (Cos(DegToRad(lambda)))
Result = RadToDeg(Atan2(tananum, tanadenom))
End Sub
'//**********************************************************************/
'//* Name: calcSunDeclination */
'//* Type: Function */
'//* Purpose: calculate the declination of the sun */
'//* Arguments: */
'//* t : number of Julian centuries since J2000.0 */
'//* Return value: */
'//* sun's declination in degrees */
'//**********************************************************************/
Sub Function CalcSunDeclination(Dim t as Float) as Float
Dim e as Float
Dim lambda as Float
Dim sint as Float
e = CalcObliquityCorrection(t)
lambda = CalcSunApparentLong(t)
sint = Sin(DegToRad(e)) * Sin(DegToRad(lambda))
Result = RadToDeg(Asin(sint))
End Sub
'//**********************************************************************/
'//* Name: calcHourAngleSunrise */
'//* Type: Function */
'//* Purpose: calculate the hour angle of the sun at sunrise for the */
'//* SC_in_Latitude */
'//* Arguments: */
'//* lat : SC_in_Latitude of observer in degrees */
'//* solarDec : declination angle of sun in degrees */
'//* Return value: */
'//* hour angle of sunrise in radians */
'//**********************************************************************/
Sub Function CalcHourAngleSunrise(Dim lat as Float,
Dim SolarDec as Float) as Float
Dim latrad as Float
Dim sdrad as Float
Dim HAarg as Float
latrad = DegToRad(lat)
sdrad = DegToRad(SolarDec)
HAarg = (Cos(DegToRad(90.833)) / (Cos(latrad) * Cos(sdrad)) -
Tan(latrad) * Tan(sdrad))
Result = (Acos(Cos(DegToRad(90.833)) / (Cos(latrad) * Cos(sdrad)) -
Tan(latrad) * Tan(sdrad)))
End Sub
'//**********************************************************************/
'//* Name: calcHourAngleSunset */
'//* Type: Function */
'//* Purpose: calculate the hour angle of the sun at sunset for the */
'//* SC_in_Latitude */
'//* Arguments: */
'//* lat : SC_in_Latitude of observer in degrees */
'//* solarDec : declination angle of sun in degrees */
'//* Return value: */
'//* hour angle of sunset in radians */
'//**********************************************************************/
Sub Function CalcHourAngleSunset(Dim lat as Float,
Dim SolarDec as Float) as Float
Dim latrad as Float
Dim sdrad as Float
Dim HAarg as Float
Dim HA as Float
latrad = DegToRad(lat)
sdrad = DegToRad(SolarDec)
HAarg = (Cos(DegToRad(90.833)) / (Cos(latrad) * Cos(sdrad)) -
Tan(latrad) * Tan(sdrad))
HA = (Acos(Cos(DegToRad(90.833)) / (Cos(latrad) * Cos(sdrad)) -
Tan(latrad) * Tan(sdrad)))
Result = -HA
End Sub
'//*** [3] ********************************************************************/
'//* Name: calcSunriseUTC */
'//* Type: Function */
'//* Purpose: calculate the Universal Coordinated Time (UTC) of sunrise */
'//* for the given day at the given location on earth */
'//* Arguments: */
'//* JD : julian day */
'//* SC_in_Latitude : SC_in_Latitude of observer in degrees */
'//* SC_in_Longitude : SC_in_Longitude of observer in degrees */
'//* Return value: */
'//* time in minutes from zero Z */
'//****************************************************************************/
Sub Function CalcSunRiseUTC(Dim JD as Float,
Dim SC_in_Latitude as Float,
Dim SC_in_Longitude as Float) as float
Dim t as Float
Dim noonmin as Float
Dim tnoon as Float
Dim eqTime as Float
Dim SolarDec as Float
Dim HourAngle as Float
Dim Delta as Float
Dim TimeDiff as Float
Dim TimeUTC as Float
Dim NewT as Float
t = CalcTimeJulianCent(JD)
noonmin = CalcSolNoonUTC(t, SC_in_Longitude)
tnoon = CalcTimeJulianCent(JD + noonmin / 1440.0)
eqTime = CalcEquationOfTime(tnoon)
SolarDec = CalcSunDeclination(tnoon)
HourAngle = CalcHourAngleSunrise(SC_in_Latitude, SolarDec)
Delta = SC_in_Longitude - RadToDeg(HourAngle)
TimeDiff = 4.0 * Delta '// in minutes of time
TimeUTC = 720.0 + TimeDiff - eqTime '// in minutes
NewT = CalcTimeJulianCent(CalcJDFromJulianCent(t) + TimeUTC / 1440.0)
eqTime = CalcEquationOfTime(NewT)
SolarDec = CalcSunDeclination(NewT)
HourAngle = CalcHourAngleSunrise(SC_in_Latitude, SolarDec)
Delta = SC_in_Longitude - RadToDeg(HourAngle)
TimeDiff = 4.0 * Delta
TimeUTC = 720.0 + TimeDiff - eqTime '// in minutes
Result = TimeUTC
End Sub
'//**********************************************************************/
'//* Name: calcSunsetUTC */
'//* Type: Function */
'//* Purpose: calculate the Universal Coordinated Time (UTC) of sunset */
'//* for the given day at the given location on earth */
'//* Arguments: */
'//* JD : julian day */
'//* SC_in_Latitude : SC_in_Latitude of observer in degrees */
'//* SC_in_Longitude : SC_in_Longitude of observer in degrees */
'//* Return value: */
'//* time in minutes from zero Z */
'//**********************************************************************/
Sub Function CalcSunSetUTC(Dim JD as Float,
Dim SC_in_Latitude as Float,
Dim SC_in_Longitude as Float) as Float
Dim t as Float
Dim noonmin as Float
Dim tnoon as Float
Dim eqTime as Float
Dim SolarDec as Float
Dim HourAngle as Float
Dim Delta as Float
Dim TimeDiff as Float
Dim TimeUTC as Float
Dim NewT as Float
t = CalcTimeJulianCent(JD)
noonmin = CalcSolNoonUTC(t, SC_in_Longitude)
tnoon = CalcTimeJulianCent(JD + noonmin / 1440.0)
eqTime = CalcEquationOfTime(tnoon)
SolarDec = CalcSunDeclination(tnoon)
HourAngle = CalcHourAngleSunset(SC_in_Latitude, SolarDec)
Delta = SC_in_Longitude - RadToDeg(HourAngle)
TimeDiff = 4.0 * Delta
TimeUTC = 720.0 + TimeDiff - eqTime
NewT = CalcTimeJulianCent(CalcJDFromJulianCent(t) + TimeUTC / 1440.0)
eqTime = CalcEquationOfTime(NewT)
SolarDec = CalcSunDeclination(NewT)
HourAngle = CalcHourAngleSunset(SC_in_Latitude, SolarDec)
Delta = SC_in_Longitude - RadToDeg(HourAngle)
TimeDiff = 4.0 * Delta
TimeUTC = 720.0 + TimeDiff - eqTime '// in minutes
Result = TimeUTC
End Sub
Sub Procedure TimeToString(Dim fTime as Float,
Dim GMT As Integer,
Dim Byref Buffer as string[5],
Dim ByRef ThoursOut as byte,
Dim Byref TminutesOut as byte)
Dim fHour As float
Dim fMin As float
Dim fSec As float
dim sHour as string[17]
dim sMin as string[17]
dim n as byte
dim k as byte
Buffer = " "
fSec = floor((fTime - floor(fTime)) * 60.0)
fSec = fSec + floor(fTime) * 60.0
fHour = floor(fSec / 3600.0)
fMin = floor((fSec / 3600.0 - fHour) * 60.0)
fSec = fSec - fHour * 3600.0 - fMin * 60.0
If fSec >= 30.0 Then
fMin = fMin + 1.0
End If
if SC_out_DaylightSavingTime then
fHour = fHour + float(GMT) + 1.0
else
fHour = fHour + float(GMT)
end if
floatToStr(fHour,sHour)
floatToStr(fMin,sMin)
k = 0
for n = 0 to 17
if sHour[n] = "." then
k = n
end if
next n
if k = 1 then
Buffer[0] = "0"
Buffer[1] = sHour[0]
end if
if k = 2 then
Buffer[0] = sHour[0]
Buffer[1] = sHour[1]
end if
Buffer[2] = ":"
k = 0
for n = 0 to 17
if sMin[n] = "." then
k = n
end if
next n
if k = 1 then
Buffer[3] = "0"
Buffer[4] = sMin[0]
end if
if k = 2 then
Buffer[3] = sMin[0]
Buffer[4] = sMin[1]
end if
ThoursOut = fHour
TminutesOut = fMin
End Sub
'//**********************************************************************/
'//* Name: GetLocalSunRiseTime */
'//* Type: Procedure */
'//* Purpose: calculate the local Sun Rise time */
'//* */
'//* Arguments: */
'//* JD : julian day */
'//* SC_in_Latitude : SC_in_Latitude of observer in degrees */
'//* SC_in_Longitude : SC_in_Longitude of observer in degrees */
'//* Return value: */
'//* time in minutes from zero Z */
'//**********************************************************************/
Sub Procedure GetLocalSunRiseTime(Dim SC_in_Latitude as Float,
Dim SC_in_Longitude as Float,
Dim mYear As Integer,
Dim mMonth As Integer,
Dim mDay As Integer,
Dim SC_in_GMToffset as integer,
Dim ByRef StrOut as string[5],
Dim ByRef ThoursOut as byte,
Dim Byref TminutesOut as byte)
Dim JD as Float
Dim t as Float
Dim RiseTimeGMT as Float
JD = CalcJD(mYear, mMonth, mDay)
t = CalcTimeJulianCent(JD)
' Apparent SunRise GMT time
RiseTimeGMT = CalcSunRiseUTC(JD, SC_in_Latitude, SC_in_Longitude)
TimeToString (RiseTimeGMT, SC_in_GMToffset , StrOut, ThoursOut, TminutesOut)
End Sub
Sub Procedure GetLocalSunSetTime(Dim SC_in_Latitude as Float,
Dim SC_in_Longitude as Float,
Dim mYear As Integer,
Dim mMonth As Integer,
Dim mDay As Integer,
Dim SC_in_GMToffset as integer,
Dim ByRef StrOut as string[5],
Dim ByRef ThoursOut as byte,
Dim Byref TminutesOut as byte)
Dim JD as Float
Dim t as Float
Dim SetTimeGMT as Float
JD = CalcJD(mYear, mMonth, mDay)
t = CalcTimeJulianCent(JD)
' Apparent SunSet GMT time
SetTimeGMT = CalcSunSetUTC(JD, SC_in_Latitude, SC_in_Longitude)
TimeToString (SetTimeGMT, SC_in_GMToffset , StrOut, ThoursOut, TminutesOut)
End Sub
Sub Procedure GetLocalNoonTime(Dim SC_in_Longitude as Float,
Dim mYear As Integer,
Dim mMonth As Integer,
Dim mDay As Integer,
Dim SC_in_GMToffset as integer,
Dim ByRef StrOut as string[5],
Dim ByRef ThoursOut as byte,
Dim Byref TminutesOut as byte)
Dim JD as Float
Dim t as Float
Dim SolNoonGMT as Float
JD = CalcJD(mYear, mMonth, mDay)
t = CalcTimeJulianCent(JD)
' Calculate solar noon for this date
SolNoonGMT = CalcSolNoonUTC(t, SC_in_Longitude)
TimeToString (SolNoonGMT, SC_in_GMToffset , StrOut, ThoursOut, TminutesOut)
End Sub
Sub Procedure GetMoreCalendarData(Dim mYear As Integer,
Dim mMonth As Integer,
Dim mDay As Integer,
Dim Byref mIsLeapYear as byte,
Dim Byref DayOfYear as integer,
Dim Byref StrDayOfWeek as string[3],
Dim Byref IntDayOfWeek as integer,
Dim Byref SC_out_DaylightSavingTime as byte)
Dim Jd as float
Dim i as integer
Dim LastSunday as integer
Dim sTemp as string[3]
Dim iTemp as integer
'+----------------------------------------------+
'+ Leap year calculation +
'+----------------------------------------------+
mIsLeapYear = isLeapYear(mYear)
'+----------------------------------------------+
'+ Numerical day of year calculation +
'+----------------------------------------------+
DayOfYear = calcDayOfYear(mMonth,mDay,mIsLeapYear)
'+----------------------------------------------+
'+ Numerical and string day of week calculation +
'+----------------------------------------------+
jd = CalcJD(mYear,mMonth,mDay)
calcDayOfWeek(jd,StrDayOfWeek,IntDayOfWeek)
'+----------------------------------------------+
'+ Daylight Saving Time (DST) calculation +
'+----------------------------------------------+
' remember to put the right ending day
' for the for-next loop.
'------------------------------------------
for i = 1 to 31 ' march ending day
iTemp = 0
jd = 0
jd = CalcJD(mYear,SC_in_dst_SMonth,i)
calcDayOfWeek(jd,sTemp,iTemp)
if iTemp = 7 then ' Looking for Sunday day
LastSunday = i
end if
next i
SC_out_DST_StartDay = LastSunday
SC_out_DST_StartMonth = SC_in_dst_SMonth
SC_out_DST_StartYear = mYear
' remember to put the right ending day
' for the for-next loop.
'------------------------------------------
for i = 1 to 31 ' october ending day
iTemp = 0
jd = 0
jd = CalcJD(mYear,SC_in_dst_EMonth,i)
calcDayOfWeek(jd,sTemp,iTemp)
if iTemp = 7 then ' Looking for Sunday day
LastSunday = i
end if
next i
SC_out_DST_EndDay = LastSunday
SC_out_DST_EndMonth = SC_in_dst_EMonth
SC_out_DST_EndYear = mYear
SC_out_DaylightSavingTime = false
if (CalcJD(mYear,mMonth,mDay) >=
CalcJD(SC_out_DST_StartYear,
SC_out_DST_StartMonth,
SC_out_DST_StartDay)) then
if (CalcJD(mYear,mMonth,mDay) <=
CalcJD(SC_out_DST_EndYear,
SC_out_DST_EndMonth,
SC_out_DST_EndDay)) then
'-----------------
SC_out_DaylightSavingTime = true
end if
end if
End Sub
'****************************** End Module *************************************
end.
L'appli smart phone:
Utilisation :
Le code App Inventor et le fichier Apk pour le smart phone.
Vous n’avez pas les permissions nécessaires pour voir les fichiers joints à ce message.
Modifié en dernier par pspic le dim. 27 oct. 2019 08:46, modifié 4 fois.
Détection lever et coucher du soleil journalier
Détection lever et coucher du soleil journalier
Détection lever et coucher du soleil journalier
Détection lever et coucher du soleil journalier
Détection lever et coucher du soleil journalier
Détection lever et coucher du soleil journalier
La compilation fonctionne. Peux-tu me dire ce qui n'allait pas?
J'utilise une DS3231, elle a une compensation interne de température et est plus précise que la DS1307.
Je n'ai pas cherché à comprendre ne sachant pas comment tu as crée le projet.
OK pour la RTC qui semble être compatible avec mon code.
Je pense qu'il est souhaitable de créer une nouvelle discussion pour ne pas polluer ce tuto, ceci n'empêche pas de l'améliorer quand c'est nécessaire.
Ce tuto est une base, mais pour une gestion de volets il faudra encore broder autour.
Détection lever et coucher du soleil journalier
Pour Gérard :
Dans la procédure ConfigureLocalData il faut mettre la latitude / longitude pour tes coordonnés locales.
Bonne soirée.
Dans la procédure ConfigureLocalData il faut mettre la latitude / longitude pour tes coordonnés locales.
Code : Tout sélectionner
Sub Procedure ConfigureLocalData
SC_in_LatDeg = 48 'degrés
SC_in_LatMin = 4 'minutes
SC_in_LatSec = 24 'secondes
SC_in_LatSec100 = 59 '1/100 de secondes
SC_in_LonDeg = 7
SC_in_LonMin = 31
SC_in_LonSec = 54
SC_in_LonSec100 = 90
Bonne soirée.
Détection lever et coucher du soleil journalier
Bonjour Gérard,
Ce matin pour un lever à 06:59, la sortie RA0 n'est pas passée à zéro à 07:00 comme prévu.
J'ai donc corrigé ce bug, il faudra donc modifier ton programme, désolé !
Ce matin pour un lever à 06:59, la sortie RA0 n'est pas passée à zéro à 07:00 comme prévu.
J'ai donc corrigé ce bug, il faudra donc modifier ton programme, désolé !
Code : Tout sélectionner
'Action sur la sortie RA0 pendant 1 minute
if Hours = SC_out_RiseTime_Hours then
if Minutes = SC_out_RiseTime_Minutes then
SetBit(PORTA,0) 'Evènement lever du soleil pendant 1 minute
end if
end if
if Hours <> SC_out_RiseTime_Hours then ClearBit(PORTA,0) end if
if Minutes <> SC_out_RiseTime_Minutes then ClearBit(PORTA,0) end if
'Action sur la sortie RA1 pendant 1 minute
if Hours = SC_out_SetTime_Hours then
if Minutes = SC_out_SetTime_Minutes then
SetBit(PORTA,1) 'Evènement coucher du soleil pendant 1 minute
end if
end if
if Hours <> SC_out_SetTime_Hours then ClearBit(PORTA,1) end if
if Minutes <> SC_out_SetTime_Minutes then ClearBit(PORTA,1) end if
Détection lever et coucher du soleil journalier
Retourner vers « Langage BASIC & PASCAL »
Qui est en ligne
Utilisateurs parcourant ce forum : Aucun utilisateur enregistré et 27 invités