Le Soldat Inconnu... Coup de chapeau

Programmation d'applications complexes
Mouillard
Messages : 77
Inscription : mer. 13/sept./2017 14:35
Localisation : Picardie (Somme)

Le Soldat Inconnu... Coup de chapeau

Message par Mouillard »

Bonsoir à tous...

De temps en temps il faut le dire....
Ce code date de 2012....il fonctionne avec PB 5.62
Regardez le travail que cela représente ,la clarté,la pureté et l'élégance , et le fonctionnement de ce code.../// :wink:
Bon moi je sais pas faire d'aussi bon code mais je sais apprécier ce qui est bien fait. :cry:
En 2003 je suivais déjà Le soldat inconnu et Horst Shaffer (pardon pour l'ortographe). :!:
donc je recherchais sur Goo...les codes des ces personnes pré cités, pour moi ils ont été avec d'autres bien sûr,
les précurseurs avec fred de code aussi évolués.
Donc "Coup de châpeau"...
Je sais pas exactement quand a été créé le "Forum"" je ne le connais que depuis peu de temps because:
G changé plusieurs fois de "fournisseur" et que PureBasic n'était accessible qu'avec le "fournisseur de 1e fois....
que mon fils avait à l'époque, enfin bref...
Bien sûr certains d'entre vous connaissent ces personnes et ce code , mais avouez que "Cà c du PureBasic" en pureté...///
De temps en temps beaucoup d'entre vous font du beau code , je l'ajoute ...
Voilà et Bravo à L S I...///

Code : Tout sélectionner

Enumeration 0
   #MoonPhase_None = -1
   #MoonPhase_NewMoon
   #MoonPhase_FirstQuarter
   #MoonPhase_FullMoon
   #MoonPhase_LastQuarter
EndEnumeration
Structure MoonPhase_Structure
   Phase.b
   Date.l
   An.l
   Mois.b
   Jour.b
   Heure.b
   Minute.b
EndStructure
Global NewList MoonPhase.MoonPhase_Structure()

Procedure MoonPhase_Calculation(Year, Month)
   Static MoonPhase_Calculation_Year.l, MoonPhase_Calculation_Month.b
   Protected.l Date, i, ii, Heure, Minute, Mois, An, Jour, JJ
   Protected.d K, T, T2, T3, J, M, MP, F
   
   Debug #PB_Compiler_Procedure
   
   If Year <> MoonPhase_Calculation_Year Or Month <> MoonPhase_Calculation_Month
      MoonPhase_Calculation_Year = Year
      MoonPhase_Calculation_Month = Month
      
      ClearList(MoonPhase())
      
      Repeat
         GetSystemTime_(DateUTC.SYSTEMTIME)
         GetLocalTime_(DateLocale.SYSTEMTIME)
      Until DateUTC\wSecond = DateLocale\wSecond ; Garantit que la lecture de la date s'est effectuée sur la même seconde
      DateUTC_Seconde.q = Date(DateUTC\wYear, DateUTC\wMonth, DateUTC\wDay, DateUTC\wHour, DateUTC\wMinute, DateUTC\wSecond)
      DateLocale_Seconde.q = Date(DateLocale\wYear, DateLocale\wMonth, DateLocale\wDay, DateLocale\wHour, DateLocale\wMinute, DateLocale\wSecond)
      
      DecalageHoraire_Seconde.q = DateLocale_Seconde - DateUTC_Seconde
      
      CompilerIf #PB_Compiler_Debugger
         DecalageHoraire = DecalageHoraire_Seconde / 3600
         If DecalageHoraire > 0
            Debug "Votre fuseau horaire : GMT+" + Str(DecalageHoraire)
         Else
            Debug "Votre fuseau horaire : GMT" + Str(DecalageHoraire)
         EndIf
      CompilerEndIf
      
      Date = Date(Year, Month, 1, 0, 0, 0)
      Date = AddDate(Date, #PB_Date_Month, -1)
      K.d = Year(Date)
      Select Month(Date)
         Case 1
            K + 0.041
         Case 2
            K + 0.126
         Case 3
            K + 0.203
         Case 4
            K + 0.288
         Case 5
            K + 0.370
         Case 6
            K + 0.455
         Case 7
            K + 0.537
         Case 8
            K + 0.622
         Case 9
            K + 0.707
         Case 10
            K + 0.789
         Case 11
            K + 0.874
         Case 12
            K + 0.956
      EndSelect
      K = (K - 1900) * 12.3685
      K = Int(K) - 0.25
      If K < 0
         K - 1
      EndIf
      
      For ii = 0 To 11
         
         K + 0.25
         T.d = K / 1236.85
         T2.d = T * T
         T3.d = T * T2
         J.d = 2415020.75933 + 29.5305888531 * K + 0.0001337 * T2 - 0.000000150 * T3 + 0.00033 * Sin((166.56 + 132.87 * T - 0.009 * T2) * #PI / 180)
         M.d = (359.2242 + 29.10535608 * K - 0.0000333 * T2 - 0.00000347 * T3) * #PI / 180
         M = M - Int(M / (2 * #PI)) * (2 * #PI)
         MP.d = (306.0253 + 385.81691806 * K + 0.0107306 * T2 + 0.00001236 * T3) * #PI / 180
         MP = MP - Int(MP / (2 * #PI)) * (2 * #PI)
         F.d = (21.2964 + 390.67050646 * K - 0.0016528 * T2 - 0.00000239 * T3) * #PI / 180
         F = F - Int(F / (2 * #PI)) * (2 * #PI)
         
         i = ii % 4
         If i = 0 Or i = 2
            J + (0.1734 - 0.000393 * T) * Sin(M)
            J + 0.0021 * Sin(2 * M) - 0.4068 * Sin(MP)
            J + 0.0161 * Sin(2 * MP) - 0.0004 * Sin(3 * MP)
            J + 0.0104 * Sin(2 * F) - 0.0051 * Sin(M + MP)
            J - 0.0074 * Sin(M - MP) + 0.0004 * Sin(2 * F + M)
            J - 0.0004 * Sin(2 * F - M) - 0.0006 * Sin(2 * F + MP)
            J + 0.001 * Sin(2 * F - MP) + 0.0005 * Sin(M + 2 * MP)
         Else
            J + (0.1721 - 0.0004 * T) * Sin(M)
            J + 0.0021 * Sin(2 * M) - 0.6280 * Sin(MP)
            J + 0.0089 * Sin(2 * MP) - 0.0004 * Sin(3 * MP)
            J + 0.0079 * Sin(2 * F) - 0.0119 * Sin(M + MP)
            J - 0.0047 * Sin(M - MP) + 0.0003 * Sin(2 * F + M)
            J - 0.0004 * Sin(2 * F - M) - 0.0006 * Sin(2 * F + MP)
            J + 0.0021 * Sin(2 * F - MP) + 0.0003 * Sin(M + 2 * MP)
            J + 0.0004 * Sin(M - 2 * MP) - 0.0003 * Sin(2 * M + MP)
            If i = 1
               J + 0.0028 - 0.0004 * Cos(M)
               J + 0.0003 * Cos(MP)
            Else
               J - 0.0028 + 0.0004 * Cos(M)
               J - 0.0003 * Cos(MP)
            EndIf
         EndIf
         
         J + 0.5
         JJ = Int(J)
         If JJ >= 2299160.5
            Alpha.d = Int((JJ - 1867216.25) / 36524.25)
            JJ = JJ + 1 + Alpha - Int(Alpha / 4)
         EndIf
         JJ + 1524
         Calcul_An = Int((JJ - 122.1) / 365.25)
         Calcul_Jour = Int(Calcul_An * 365.25)
         Calcul_Mois = Int((JJ - Calcul_Jour) / 30.6001)
         Jour = Int(JJ - Calcul_Jour - Int(Calcul_Mois * 30.6001))
         If Calcul_Mois < 13.5
            Mois = Int(Calcul_Mois - 1)
         Else
            Mois = Int(Calcul_Mois - 13)
         EndIf
         If Mois >= 3
            An = Int(Calcul_An - 4716)
         Else
            An = Int(Calcul_An - 4715)
         EndIf
         J - Int(J)
         Heure = Int(J * 24)
         Minute = Int((J - Heure / 24) * 1440)
         
         CompilerIf #PB_Compiler_Debugger
            Select i
               Case #MoonPhase_NewMoon
                  Debug "Nouvelle lune"
               Case #MoonPhase_FirstQuarter
                  Debug "Premier quartier"
               Case #MoonPhase_FullMoon
                  Debug "Pleine lune"
               Case #MoonPhase_LastQuarter
                  Debug "Dernier quartier"
            EndSelect
            Debug Str(Jour) + "/" + RSet(Str(Mois), 2, "0") + "/" + Str(An) + " à " + Str(Heure) + ":" + RSet(Str(Minute), 2, "0") + " (UTC)"
         CompilerEndIf
         
         AddElement(MoonPhase())
         MoonPhase()\Phase = i
         MoonPhase()\Date = Date(An, Mois, Jour, 0, 0, 0) + (Heure * 3600 + Minute * 60) + DecalageHoraire_Seconde
         MoonPhase()\An = Year(MoonPhase()\Date)
         MoonPhase()\Mois = Month(MoonPhase()\Date)
         MoonPhase()\Jour = Day(MoonPhase()\Date)
         MoonPhase()\Heure = Hour(MoonPhase()\Date)
         MoonPhase()\Minute = Minute(MoonPhase()\Date)
         
         Debug Str(MoonPhase()\Jour) + "/" + RSet(Str(MoonPhase()\Mois), 2, "0") + "/" + Str(MoonPhase()\An) + " à " + Str(MoonPhase()\Heure) + ":" + RSet(Str(MoonPhase()\Minute), 2, "0")
         
      Next
      
   EndIf
EndProcedure

Procedure NextMoonPhase(Year = 0, Month = 0, Day = 0) ; Get the next moon phase after the date in parameters or last result
   If Year And Month And Day
      MoonPhase_Calculation(Year, Month)
      Date = Date(Year, Month, Day, 0, 0, 0)
   ElseIf ListIndex(MoonPhase())
      Year = MoonPhase()\An
      Month = MoonPhase()\Mois
      Day = MoonPhase()\Jour
      MoonPhase_Calculation(Year, Month)
      Date = Date(Year, Month, Day, 0, 0, 0) + (24 * 60 * 60)
   EndIf
   If Date
      ForEach MoonPhase()
         If MoonPhase()\Date > Date
            Date = MoonPhase()\Date
            Break
         EndIf
      Next
   EndIf
   Debug #PB_Compiler_Procedure
   Debug Date
   ProcedureReturn Date
EndProcedure

Procedure GetMoonPhase(Year = 0, Month = 0, Day = 0) ; Get Moon phase of last result or of the date in parameters
   If Year And Month And Day
      MoonPhase_Calculation(Year, Month)
      Phase = #MoonPhase_None
      ForEach MoonPhase()
         If Year = MoonPhase()\An And Month = MoonPhase()\Mois And Day = MoonPhase()\Jour
            Phase = MoonPhase()\Phase
            Break
         EndIf
      Next
   ElseIf ListIndex(MoonPhase())
         Phase = MoonPhase()\Phase
      EndIf
   CompilerIf #PB_Compiler_Debugger
      Debug #PB_Compiler_Procedure
      Select Phase
         Case #MoonPhase_None
            Debug "Ce jour n'est pas un état spécifique de la Lune"
         Case #MoonPhase_NewMoon
            Debug "Nouvelle lune"
         Case #MoonPhase_FirstQuarter
            Debug "Premier quartier"
         Case #MoonPhase_FullMoon
            Debug "Pleine lune"
         Case #MoonPhase_LastQuarter
            Debug "Dernier quartier"
      EndSelect
   CompilerEndIf
   ProcedureReturn Phase
EndProcedure

Procedure GetMoonPhaseYear() ; Get year of moon phase of last result
   An = #MoonPhase_None
   If ListIndex(MoonPhase())
      An = MoonPhase()\An
   EndIf
   Debug #PB_Compiler_Procedure
   Debug An
   ProcedureReturn An
EndProcedure

Procedure GetMoonPhaseMonth() ; Get month of moon phase of last result
   Mois = #MoonPhase_None
   If ListIndex(MoonPhase())
      Mois = MoonPhase()\Mois
   EndIf
   Debug #PB_Compiler_Procedure
   Debug Mois
   ProcedureReturn Mois
EndProcedure

Procedure GetMoonPhaseDay() ; Get day of moon phase of last result
   Jour = #MoonPhase_None
   If ListIndex(MoonPhase())
      Jour = MoonPhase()\Jour
   EndIf
   Debug #PB_Compiler_Procedure
   Debug Jour
   ProcedureReturn Jour
EndProcedure

Procedure GetMoonPhaseHour(Year = 0, Month = 0, Day = 0) ; Get hour of Moon phase of last result or of the date in parameters
   If Year And Month And Day
      MoonPhase_Calculation(Year, Month)
      Heure = #MoonPhase_None
      ForEach MoonPhase()
         If Year = MoonPhase()\An And Month = MoonPhase()\Mois And Day = MoonPhase()\Jour
            Heure = MoonPhase()\Heure
            Break
         EndIf
      Next
   ElseIf ListIndex(MoonPhase())
         Heure = MoonPhase()\Heure
      EndIf
   Debug #PB_Compiler_Procedure
   Debug Heure
   ProcedureReturn Heure
EndProcedure

Procedure GetMoonPhaseMinute(Year = 0, Month = 0, Day = 0) ; Get minute of Moon phase of last result or of the date in parameters
   If Year And Month And Day
      MoonPhase_Calculation(Year, Month)
      Minute = #MoonPhase_None
      ForEach MoonPhase()
         If Year = MoonPhase()\An And Month = MoonPhase()\Mois And Day = MoonPhase()\Jour
            Minute = MoonPhase()\Minute
            Break
         EndIf
      Next
   ElseIf ListIndex(MoonPhase())
         Minute = MoonPhase()\Minute
      EndIf
   Debug #PB_Compiler_Procedure
   Debug Minute
   ProcedureReturn Minute
EndProcedure



; Test du programme

Enumeration
   #ListeMois
   #ListeAn
   #An
   #Mois
EndEnumeration

Procedure RemplirListe(An, Mois)
   
   ; Pour tous les jours du mois
   ClearGadgetItems(#ListeMois)
   Date = Date(An, Mois, 1, 0, 0, 0) ; Premier jour du mois
   While Month(Date) = Mois
      ; Jour
      Jour = Day(Date)
      Jour_Texte.s = RSet(Str(Jour), 2, "0") + "/" + RSet(Str(Mois), 2, "0") + "/" + Str(An)
      ; Calcul de la phase de la Lune
      Phase = GetMoonPhase(An, Mois, Jour)
      Select Phase
         Case #MoonPhase_None
            Phase_Texte.s = ""
         Case #MoonPhase_NewMoon
            Phase_Texte.s = "Nouvelle lune"
         Case #MoonPhase_FirstQuarter
            Phase_Texte.s = "Premier quartier"
         Case #MoonPhase_FullMoon
            Phase_Texte.s = "Pleine lune"
         Case #MoonPhase_LastQuarter
            Phase_Texte.s = "Dernier quartier"
      EndSelect
      ; Calcul de l'heure
      If Phase <> #MoonPhase_None
         Heure = GetMoonPhaseHour(An, Mois, Jour)
         Minute = GetMoonPhaseMinute(An, Mois, Jour)
         Heure_Texte.s = RSet(Str(Heure), 2, "0") + ":" + RSet(Str(Minute), 2, "0")
      Else
         Heure_Texte.s = ""
      EndIf
      ; Affiche dans la liste
      AddGadgetItem(#ListeMois, -1, Jour_Texte + Chr(10) + Heure_Texte + Chr(10) + Phase_Texte)
      ; Ajoute un jour
      Date = AddDate(Date, #PB_Date_Day, 1)
   Wend
   
   
   ; Pour l'année complète
   ClearGadgetItems(#ListeAn)
   Date = Date(An, 1, 1, 0, 0, 0) ; Premier jour de l'année
   Date = NextMoonPhase(An, Mois, 1)
   While Year(Date) = An
      ; Jour
      Mois = GetMoonPhaseMonth()
      Jour = GetMoonPhaseDay()
      Jour_Texte.s = RSet(Str(Jour), 2, "0") + "/" + RSet(Str(Mois), 2, "0") + "/" + Str(An)
      ; Calcul de la phase de la Lune
      Phase = GetMoonPhase()
      Select Phase
         Case #MoonPhase_None
            Phase_Texte.s = ""
         Case #MoonPhase_NewMoon
            Phase_Texte.s = "Nouvelle lune"
         Case #MoonPhase_FirstQuarter
            Phase_Texte.s = "Premier quartier"
         Case #MoonPhase_FullMoon
            Phase_Texte.s = "Pleine lune"
         Case #MoonPhase_LastQuarter
            Phase_Texte.s = "Dernier quartier"
      EndSelect
      ; Calcul de l'heure
      Heure = GetMoonPhaseHour()
      Minute = GetMoonPhaseMinute()
      Heure_Texte.s = RSet(Str(Heure), 2, "0") + ":" + RSet(Str(Minute), 2, "0")
      ; Affiche dans la liste
      AddGadgetItem(#ListeAn, -1, Jour_Texte + Chr(10) + Heure_Texte + Chr(10) + Phase_Texte)
      ; Phase suivante
      Date = NextMoonPhase()
   Wend
   
EndProcedure

; Lecture de la date actuelle
Date = Date()
An = Year(Date)
Mois = Month(Date)

If OpenWindow(0, 0, 0, 600, 600, "Phase de la Lune", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_ScreenCentered) = 0
   End
EndIf
ListIconGadget(#ListeMois, 0, 0, 300, 560, "Jour du mois", 100, #PB_ListIcon_FullRowSelect)
AddGadgetColumn(#ListeMois, 1, "Heure", 50)
AddGadgetColumn(#ListeMois, 2, "Phase de la lune", 120)
ListIconGadget(#ListeAn, 300, 0, 300, 560, "Jour de l'année", 100, #PB_ListIcon_FullRowSelect)
AddGadgetColumn(#ListeAn, 1, "Heure", 50)
   AddGadgetColumn(#ListeAn, 2, "Phase de la lune", 120)
TextGadget(#PB_Any, 0, 560, 300, 16, "Année", #PB_Text_Center)
TextGadget(#PB_Any, 200, 560, 300, 16, "Mois", #PB_Text_Center)
StringGadget(#An, 0, 576, 300, 24, Str(An), #PB_String_Numeric | #ES_CENTER)
StringGadget(#Mois, 300, 576, 300, 24, Str(Mois), #PB_String_Numeric | #ES_CENTER)

RemplirListe(An, Mois)

Repeat
   Event = WaitWindowEvent()
   
   Select Event
      Case #PB_Event_Gadget
         Select EventGadget()
            Case #An, #Mois
               If EventType() = #PB_EventType_Change
                  
                  An = Val(GetGadgetText(#An))
                  Mois = Val(GetGadgetText(#Mois))
                  If An And Mois
                     RemplirListe(An, Mois)
                  EndIf
                  
               EndIf
         EndSelect
   EndSelect
   
Until Event = #PB_Event_CloseWindow
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Re: Le Soldat Inconnu... Coup de chapeau

Message par djes »

C'est gentil pour lui ce petit compliment, j'espère qu'il le verra, il le mérite :)
Avatar de l’utilisateur
Zorro
Messages : 2185
Inscription : mar. 31/mai/2016 9:06

Re: Le Soldat Inconnu... Coup de chapeau

Message par Zorro »

au goulag ? pas sur qu'ils aient internet ... :mrgreen:
Image
Image
Site: http://michel.dobro.free.fr/
Devise :"dis moi ce dont tu as besoin, je t'expliquerai comment t'en passer"
Avatar de l’utilisateur
Kwai chang caine
Messages : 6962
Inscription : sam. 23/sept./2006 18:32
Localisation : Isere

Re: Le Soldat Inconnu... Coup de chapeau

Message par Kwai chang caine »

Il me manque le "militaire" :|
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic
Mouillard
Messages : 77
Inscription : mer. 13/sept./2017 14:35
Localisation : Picardie (Somme)

Re: Le Soldat Inconnu... Coup de chapeau

Message par Mouillard »

Bonjour à tous,
Merci pour lui à vous deux :? :D
Comme dirait "Micoute" : même si ça n'intéresse que 3 personnes, j'suis content quand même...///
Et j'ajoute que même s'il était ""Au goulag" ; il parviendrait à écrire ses codes sur des rochers ou dans des grottes
comme le faisaient les très Anciens..... :idea: :)
Voilà j'dis çà mais j'l dis. :lol:
Avatar de l’utilisateur
Zorro
Messages : 2185
Inscription : mar. 31/mai/2016 9:06

Re: Le Soldat Inconnu... Coup de chapeau

Message par Zorro »

Kwai chang caine a écrit :Il me manque le "militaire" :|
Pourquoi le "militaire" ?? 8O
Image
Image
Site: http://michel.dobro.free.fr/
Devise :"dis moi ce dont tu as besoin, je t'expliquerai comment t'en passer"
Avatar de l’utilisateur
GallyHC
Messages : 1703
Inscription : lun. 17/déc./2007 12:44

Re: Le Soldat Inconnu... Coup de chapeau

Message par GallyHC »

Par simple supposition "Le Soldat Inconnu", donc soldat? Et après sur le forum Anglais, il a été présent jusqu'en fin 2017.

Cordialement,
GallyHC
Configuration : Tower: Windows 10 (Processeur: i7 "x64") (Mémoire: 16Go) (GeForce GTX 760 - 2Go) - PureBasic 5.72 (x86 et x64)
Avatar de l’utilisateur
SPH
Messages : 4721
Inscription : mer. 09/nov./2005 9:53

Re: Le Soldat Inconnu... Coup de chapeau

Message par SPH »

GallyHC a écrit :sur le forum Anglais, il a été présent jusqu'en fin 2017.
tu es sur ? :? 8)
http://HexaScrabble.com/
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Intel Core i7 4770 64 bits - GTX 650 Ti
Version de PB : 6.00 - 64 bits
Avatar de l’utilisateur
GallyHC
Messages : 1703
Inscription : lun. 17/déc./2007 12:44

Re: Le Soldat Inconnu... Coup de chapeau

Message par GallyHC »

http://www.purebasic.fr/english/memberl ... file&u=377

Son profile : "Last visited: Thu Oct 05, 2017 3:07 pm".

Cordialement,
GallyHC
Configuration : Tower: Windows 10 (Processeur: i7 "x64") (Mémoire: 16Go) (GeForce GTX 760 - 2Go) - PureBasic 5.72 (x86 et x64)
Avatar de l’utilisateur
Kwai chang caine
Messages : 6962
Inscription : sam. 23/sept./2006 18:32
Localisation : Isere

Re: Le Soldat Inconnu... Coup de chapeau

Message par Kwai chang caine »

Bien vu Gally :wink:

S'fait vieux le défenseur des opprimés...c'est bientôt un déambulateur qui va remplacer TORNADO :lol:
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic
Avatar de l’utilisateur
Zorro
Messages : 2185
Inscription : mar. 31/mai/2016 9:06

Re: Le Soldat Inconnu... Coup de chapeau

Message par Zorro »

Le soldat inconnu n'est pas militaire
il a fait ses etudes en partie en Haute loire .... , et a travaillé chez Michelin
ensuite il a migré en Pologne (pour Michelin toujours) ou il a rencontré une fille

qu'en au Vrais Soldat inconnu , on ne sait rien de lui .... meme pas sur que ce fut un militaire
Dernière modification par Zorro le mer. 11/avr./2018 0:01, modifié 1 fois.
Image
Image
Site: http://michel.dobro.free.fr/
Devise :"dis moi ce dont tu as besoin, je t'expliquerai comment t'en passer"
Avatar de l’utilisateur
GallyHC
Messages : 1703
Inscription : lun. 17/déc./2007 12:44

Re: Le Soldat Inconnu... Coup de chapeau

Message par GallyHC »

^^ En fait je faisait que te répondre sur le pourquoi KCC a dit "militaire", aucun rapport à l'armée, mais juste a son pseudo en fait.

GallyHC
Configuration : Tower: Windows 10 (Processeur: i7 "x64") (Mémoire: 16Go) (GeForce GTX 760 - 2Go) - PureBasic 5.72 (x86 et x64)
Avatar de l’utilisateur
Zorro
Messages : 2185
Inscription : mar. 31/mai/2016 9:06

Re: Le Soldat Inconnu... Coup de chapeau

Message par Zorro »

Arf ... oui bien sur ... pfff fatigué moi :)
Image
Image
Site: http://michel.dobro.free.fr/
Devise :"dis moi ce dont tu as besoin, je t'expliquerai comment t'en passer"
Avatar de l’utilisateur
Kwai chang caine
Messages : 6962
Inscription : sam. 23/sept./2006 18:32
Localisation : Isere

Re: Le Soldat Inconnu... Coup de chapeau

Message par Kwai chang caine »

Kwai chang caine a écrit :S'fait vieux le défenseur des opprimés...c'est bientôt un déambulateur qui va remplacer TORNADO :lol:
Zorro a écrit :Arf ... oui bien sur ... pfff fatigué moi :)
c'est un peu ce que je disais :lol:
J'ai failli faire une blague sur le vrai, l'arc et tout le toutim, et j'me suis, un jeu de mots à 2 balles... tout le monde va comprendre :D

Partir, sans nous laisser de nouvelle...privant son "bibendum" du forum de ses nombreux "secours"...et pour aller "rouler" sa bosse dans un autre pays... c'est "gonflé" !!
J'espère le relire avant de "crever" :lol:

PS: pour toute explication sur mes textes, prière de contacter mon traducteur officiel GallyHc :mrgreen:
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic
Mouillard
Messages : 77
Inscription : mer. 13/sept./2017 14:35
Localisation : Picardie (Somme)

Re: Le Soldat Inconnu... Coup de chapeau

Message par Mouillard »

Bonne Année 2019 à vous tous... :D
Voilà ce bon code de LSI légèrement modifié, seulement en apparence, et c'est mérité ... 8)
J'ai "glané" ci et là, ces personnes se reconnaîtront...Et merci à ceux là... :wink:
Faut dire que j'habite près de la mer (Manche)Il me sert à : phase lunaire, afin de déterminer: jour des mois, les plus grandes marées des mois, les coups de vent et les dates de pousse des champignons(cèpes de Bordeaux) et à d'autres choses....
Si "kékin" à une :idea: sur un code pour les horaires des marées, sujet trop compliqué pour moi/// :wink:

Code : Tout sélectionner

; Constantes nécessaires a la procedure ListIconGadget_CustomDraw, je c pas qui a fait ce code pratique ...Merci
#NM_CUSTOMDRAW = #NM_FIRST - 12 
#CDDS_ITEM = $10000 
#CDDS_SUBITEM = $20000 
#CDDS_PREPAINT = $1 
#CDDS_ITEMPREPAINT = #CDDS_ITEM | #CDDS_PREPAINT 
#CDDS_SUBITEMPREPAINT = #CDDS_SUBITEM | #CDDS_ITEMPREPAINT 
#CDRF_DODEFAULT = $0 
#CDRF_NEWFONT = $2 
#CDRF_NOTIFYITEMDRAW = $20 
#CDRF_NOTIFYSUBITEMDRAW = $20 


; window callback permettant de personnaliser l'affichage du ListIconGadget
Declare.l ListIconGadget_CustomDraw(WindowID.l, Message.l, wParam.l, lParam.l)
Declare.l ListIconGadget1_CustomDraw(WindowID.l, Message.l, wParam.l, lParam.l)

Enumeration
  #window
  #win
  #MenuPopUp
EndEnumeration
Enumeration
  #font0
  #font1
  #font2
  #Police_4
EndEnumeration

Enumeration 0
   #MoonPhase_None = -1
   #MoonPhase_NewMoon
   #MoonPhase_FirstQuarter
   #MoonPhase_FullMoon 
   #MoonPhase_LastQuarter
   
   #Ma_fen2
    #Ma_fen
  #btfen2
  #Ma_fen3
  #btstop
  #cont
  #cont1
 EndEnumeration
 
 Global flag_opt.b ;1 = Ville 2 = code 3= departement
;color le HEADER
Global AddressCallback 
Global Colour 
;=========================================================================
Global Dim Jour.S(6)
Jour(0) = "Lundi"
Jour(1) = "Mardi"
Jour(2) = "Mercredi"
Jour(3) = "Jeudi"
Jour(4) = "Vendredi"
Jour(5) = "Samedi"
Jour(6) = "Dimanche"
;===========================================================
 
 Structure MoonPhase_Structure
   Phase.b
   Date.l
   An.l
   Mois.b
   Jour.b
   Heure.b
   Minute.b
EndStructure
Global NewList MoonPhase.MoonPhase_Structure()

Procedure MoonPhase_Calculation(Year, Month)
   Static MoonPhase_Calculation_Year.l, MoonPhase_Calculation_Month.b
   Protected.l Date, i, ii, Heure, Minute, Mois, An, Jour, JJ
   Protected.d K, T, T2, T3, J, M, MP, F
   
   Debug #PB_Compiler_Procedure
   
   If Year <> MoonPhase_Calculation_Year Or Month <> MoonPhase_Calculation_Month
      MoonPhase_Calculation_Year = Year
      MoonPhase_Calculation_Month = Month
      
      ClearList(MoonPhase())
      
      Repeat
         GetSystemTime_(DateUTC.SYSTEMTIME)
         GetLocalTime_(DateLocale.SYSTEMTIME)
      Until DateUTC\wSecond = DateLocale\wSecond ; Garantit que la lecture de la date s'est effectuée sur la même seconde
      DateUTC_Seconde.q = Date(DateUTC\wYear, DateUTC\wMonth, DateUTC\wDay, DateUTC\wHour, DateUTC\wMinute, DateUTC\wSecond)
      DateLocale_Seconde.q = Date(DateLocale\wYear, DateLocale\wMonth, DateLocale\wDay, DateLocale\wHour, DateLocale\wMinute, DateLocale\wSecond)
      
      DecalageHoraire_Seconde.q = DateLocale_Seconde - DateUTC_Seconde
      
      CompilerIf #PB_Compiler_Debugger
         DecalageHoraire = DecalageHoraire_Seconde / 3600
         If DecalageHoraire > 0
            Debug "Votre fuseau horaire : GMT+" + Str(DecalageHoraire)
         Else
            Debug "Votre fuseau horaire : GMT" + Str(DecalageHoraire)
         EndIf
      CompilerEndIf
      
      Date = Date(Year, Month, 1, 0, 0, 0)
      Date = AddDate(Date, #PB_Date_Month, -1)
      K.d = Year(Date)
      Select Month(Date)
         Case 1
            K + 0.041
         Case 2
            K + 0.126
         Case 3
            K + 0.203
         Case 4
            K + 0.288
         Case 5
            K + 0.370
         Case 6
            K + 0.455
         Case 7
            K + 0.537
         Case 8
            K + 0.622
         Case 9
            K + 0.707
         Case 10
            K + 0.789
         Case 11
            K + 0.874
         Case 12
            K + 0.956
      EndSelect
      K = (K - 1900) * 12.3685
      K = Int(K) - 0.25
      If K < 0
         K - 1
      EndIf
      
      For ii = 0 To 11
         
         K + 0.25
         T.d = K / 1236.85
         T2.d = T * T
         T3.d = T * T2
         J.d = 2415020.75933 + 29.5305888531 * K + 0.0001337 * T2 - 0.000000150 * T3 + 0.00033 * Sin((166.56 + 132.87 * T - 0.009 * T2) * #PI / 180)
         M.d = (359.2242 + 29.10535608 * K - 0.0000333 * T2 - 0.00000347 * T3) * #PI / 180
         M = M - Int(M / (2 * #PI)) * (2 * #PI)
         MP.d = (306.0253 + 385.81691806 * K + 0.0107306 * T2 + 0.00001236 * T3) * #PI / 180
         MP = MP - Int(MP / (2 * #PI)) * (2 * #PI)
         F.d = (21.2964 + 390.67050646 * K - 0.0016528 * T2 - 0.00000239 * T3) * #PI / 180
         F = F - Int(F / (2 * #PI)) * (2 * #PI)
         
         i = ii % 4
         If i = 0 Or i = 2
            J + (0.1734 - 0.000393 * T) * Sin(M)
            J + 0.0021 * Sin(2 * M) - 0.4068 * Sin(MP)
            J + 0.0161 * Sin(2 * MP) - 0.0004 * Sin(3 * MP)
            J + 0.0104 * Sin(2 * F) - 0.0051 * Sin(M + MP)
            J - 0.0074 * Sin(M - MP) + 0.0004 * Sin(2 * F + M)
            J - 0.0004 * Sin(2 * F - M) - 0.0006 * Sin(2 * F + MP)
            J + 0.001 * Sin(2 * F - MP) + 0.0005 * Sin(M + 2 * MP)
         Else
            J + (0.1721 - 0.0004 * T) * Sin(M)
            J + 0.0021 * Sin(2 * M) - 0.6280 * Sin(MP)
            J + 0.0089 * Sin(2 * MP) - 0.0004 * Sin(3 * MP)
            J + 0.0079 * Sin(2 * F) - 0.0119 * Sin(M + MP)
            J - 0.0047 * Sin(M - MP) + 0.0003 * Sin(2 * F + M)
            J - 0.0004 * Sin(2 * F - M) - 0.0006 * Sin(2 * F + MP)
            J + 0.0021 * Sin(2 * F - MP) + 0.0003 * Sin(M + 2 * MP)
            J + 0.0004 * Sin(M - 2 * MP) - 0.0003 * Sin(2 * M + MP)
            If i = 1
               J + 0.0028 - 0.0004 * Cos(M)
               
               J + 0.0003 * Cos(MP)
            Else
               J - 0.0028 + 0.0004 * Cos(M)
               J - 0.0003 * Cos(MP)
            EndIf
         EndIf
         
         J + 0.5
         JJ = Int(J)
         If JJ >= 2299160.5
            Alpha.d = Int((JJ - 1867216.25) / 36524.25)
            JJ = JJ + 1 + Alpha - Int(Alpha / 4)
         EndIf
         JJ + 1524
         Calcul_An = Int((JJ - 122.1) / 365.25)
         Calcul_Jour = Int(Calcul_An * 365.25)
         Calcul_Mois = Int((JJ - Calcul_Jour) / 30.6001)
         Jour = Int(JJ - Calcul_Jour - Int(Calcul_Mois * 30.6001))
         If Calcul_Mois < 13.5
            Mois = Int(Calcul_Mois - 1)
         Else
            Mois = Int(Calcul_Mois - 13)
         EndIf
         If Mois >= 3
            An = Int(Calcul_An - 4716)
         Else
            An = Int(Calcul_An - 4715)
         EndIf
         J - Int(J)
         Heure = Int(J * 24)
         Minute = Int((J - Heure / 24) * 1440)
         
         CompilerIf #PB_Compiler_Debugger
            Select i
               Case #MoonPhase_NewMoon
                  Debug "Nouvelle lune"
               Case #MoonPhase_FirstQuarter
                  Debug "Premier quartier"
               Case #MoonPhase_FullMoon 
                  Debug "Pleine lune"
               Case #MoonPhase_LastQuarter
                  Debug "Dernier quartier"
            EndSelect
            Debug Str(Jour) + "/" + RSet(Str(Mois), 2, "0") + "/" + Str(An) + " à " + Str(Heure) + ":" + RSet(Str(Minute), 2, "0") + " (UTC)"
         CompilerEndIf
         
         AddElement(MoonPhase())
         MoonPhase()\Phase = i
         MoonPhase()\Date = Date(An, Mois, Jour, 0, 0, 0) + (Heure * 3600 + Minute * 60) + DecalageHoraire_Seconde
         MoonPhase()\An = Year(MoonPhase()\Date)
         MoonPhase()\Mois = Month(MoonPhase()\Date)
         MoonPhase()\Jour = Day(MoonPhase()\Date)
         MoonPhase()\Heure = Hour(MoonPhase()\Date)
         MoonPhase()\Minute = Minute(MoonPhase()\Date)
         
         Debug Str(MoonPhase()\Jour) + "/" + RSet(Str(MoonPhase()\Mois), 2, "0") + "/" + Str(MoonPhase()\An) + " à " + Str(MoonPhase()\Heure) + ":" + RSet(Str(MoonPhase()\Minute), 2, "0")
         
      Next
      
   EndIf
EndProcedure

Procedure NextMoonPhase(Year = 0, Month = 0, Day = 0) ; Get the next moon phase after the date in parameters or last result
   If Year And Month And Day
      MoonPhase_Calculation(Year, Month)
      Date = Date(Year, Month, Day, 0, 0, 0)
   ElseIf ListIndex(MoonPhase())
      Year = MoonPhase()\An
      Month = MoonPhase()\Mois
      Day = MoonPhase()\Jour
      MoonPhase_Calculation(Year, Month)
      Date = Date(Year, Month, Day, 0, 0, 0) + (24 * 60 * 60)
   EndIf
   If Date
      ForEach MoonPhase()
         If MoonPhase()\Date > Date
            Date = MoonPhase()\Date
            Break
         EndIf
      Next
   EndIf
   Debug #PB_Compiler_Procedure
   Debug Date
   ProcedureReturn Date
EndProcedure

Procedure GetMoonPhase(Year = 0, Month = 0, Day = 0) ; Get Moon phase of last result or of the date in parameters
   If Year And Month And Day
      MoonPhase_Calculation(Year, Month)
      Phase = #MoonPhase_None
      ForEach MoonPhase()
         If Year = MoonPhase()\An And Month = MoonPhase()\Mois And Day = MoonPhase()\Jour
            Phase = MoonPhase()\Phase
            Break
         EndIf
      Next
   ElseIf ListIndex(MoonPhase())
         Phase = MoonPhase()\Phase
      EndIf
   CompilerIf #PB_Compiler_Debugger
      Debug #PB_Compiler_Procedure
      Select Phase
         Case #MoonPhase_None
            Debug "Ce jour n'est pas un état spécifique de la Lune"
         Case #MoonPhase_NewMoon
            Debug "Nouvelle lune"
         Case #MoonPhase_FirstQuarter
            Debug "Premier quartier"
         Case #MoonPhase_FullMoon 
            Debug "Pleine lune"
         Case #MoonPhase_LastQuarter
            Debug "Dernier quartier"
      EndSelect
   CompilerEndIf
   ProcedureReturn Phase
EndProcedure

Procedure GetMoonPhaseYear() ; Get year of moon phase of last result
   An = #MoonPhase_None
   If ListIndex(MoonPhase())
      An = MoonPhase()\An
   EndIf
   Debug #PB_Compiler_Procedure
   Debug An
   ProcedureReturn An
EndProcedure

Procedure GetMoonPhaseMonth() ; Get month of moon phase of last result
   Mois = #MoonPhase_None
   If ListIndex(MoonPhase())
      Mois = MoonPhase()\Mois
   EndIf
   Debug #PB_Compiler_Procedure
   Debug Mois
   ProcedureReturn Mois
EndProcedure

Procedure GetMoonPhaseDay() ; Get day of moon phase of last result
   Jour = #MoonPhase_None
   If ListIndex(MoonPhase())
      Jour = MoonPhase()\Jour
   EndIf
   Debug #PB_Compiler_Procedure
   Debug Jour
   ProcedureReturn Jour
EndProcedure

Procedure GetMoonPhaseHour(Year = 0, Month = 0, Day = 0) ; Get hour of Moon phase of last result or of the date in parameters
   If Year And Month And Day
      MoonPhase_Calculation(Year, Month)
      Heure = #MoonPhase_None
      ForEach MoonPhase()
         If Year = MoonPhase()\An And Month = MoonPhase()\Mois And Day = MoonPhase()\Jour
            Heure = MoonPhase()\Heure
            Break
         EndIf
      Next
   ElseIf ListIndex(MoonPhase())
         Heure = MoonPhase()\Heure
      EndIf
   Debug #PB_Compiler_Procedure
   Debug Heure
   ProcedureReturn Heure
EndProcedure

Procedure GetMoonPhaseMinute(Year = 0, Month = 0, Day = 0) ; Get minute of Moon phase of last result or of the date in parameters
   If Year And Month And Day
      MoonPhase_Calculation(Year, Month)
      Minute = #MoonPhase_None
      ForEach MoonPhase()
         If Year = MoonPhase()\An And Month = MoonPhase()\Mois And Day = MoonPhase()\Jour
            Minute = MoonPhase()\Minute
            Break
         EndIf
      Next
   ElseIf ListIndex(MoonPhase())
         Minute = MoonPhase()\Minute
      EndIf
   Debug #PB_Compiler_Procedure
   Debug Minute
   ProcedureReturn Minute
EndProcedure

Procedure AddressListSubclassed(hwnd, msg, wParam, lParam) ;color le header grille
   FontID4 = LoadFont(4,"Tahoma",8 ,#PB_Font_Bold|#PB_Font_HighQuality)
   #LVM_GETHEADER = #LVM_FIRST + 31 
   Protected hdi.HD_ITEM 
   result = CallWindowProc_(AddressCallback, hwnd, msg, wParam, lParam)
   Select msg 
      Case #WM_NOTIFY 
         *pnmh.NMHDR = lParam        
         If *pnmh\code = #NM_CUSTOMDRAW 
            *pnmcd.NMCUSTOMDRAW = lParam                                                                
            Select *pnmcd\dwDrawStage 
               Case #CDDS_PREPAINT 
                  result = #CDRF_NOTIFYITEMDRAW 
               Case #CDDS_ITEMPREPAINT                                                                    
                  text$ = Space(100) 
                  hdi\mask = #HDI_TEXT 
                  hdi\pszText = @text$ 
                  hdi\cchTextMax = Len(text$) 
                  SendMessage_(*pnmh\hwndFrom, #HDM_GETITEM, *pnmcd\dwItemSpec, hdi)                    
                  If *pnmcd\uItemState & #CDIS_SELECTED 
                     DrawFrameControl_(*pnmcd\hdc, *pnmcd\rc, #DFC_BUTTON, #DFCS_BUTTONPUSH | #DFCS_PUSHED)  
                     InflateRect_(*pnmcd\rc, -1, -1) 
                  Else 
                     DrawFrameControl_(*pnmcd\hdc, *pnmcd\rc, #DFC_BUTTON, #DFCS_BUTTONPUSH) 
                  EndIf                      
                  ; Draw background. 
                  InflateRect_(*pnmcd\rc, -2, -1) 
                  SetBkMode_(*pnmcd\hdc, #TRANSPARENT) 
                  FillRect_(*pnmcd\hdc, *pnmcd\rc, Colour) ;couleur fond du header
                  SetTextColor_(*pnmcd\hdc, $ED2C12 )  ;$ED2C12
                  DrawText_(*pnmcd\hdc, @text$, Len(text$), *pnmcd\rc, #DT_LEFT | #DT_VCENTER | #DT_END_ELLIPSIS) 
                  result = #CDRF_SKIPDEFAULT 
            EndSelect 
         EndIf 
   EndSelect 
   ProcedureReturn result 
EndProcedure 
; Test du programme

Enumeration
   #ListeMois
   #ListeAn
   #An
   #Mois
EndEnumeration

Procedure RemplirListe(An, Mois)
   
   ; Pour tous les jours du mois
   ClearGadgetItems(#ListeMois)
   Date = Date(An, Mois, 1, 0, 0, 0) ; Premier jour du mois
   While Month(Date) = Mois
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Jour
      Jour = Day(Date)
      Jour_Texte.s = RSet(Str(Jour), 2, "0") + "/" + RSet(Str(Mois), 2, "0") + "/" + Str(An)
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Calcul de la phase de la Lune
      Phase = GetMoonPhase(An, Mois, Jour)
      Select Phase
         Case #MoonPhase_None
            Phase_Texte.s = ""
         Case #MoonPhase_NewMoon
            Phase_Texte.s = "Nouvelle lune"
         Case #MoonPhase_FirstQuarter
            Phase_Texte.s = "Premier quartier"
         Case #MoonPhase_FullMoon
            Phase_Texte.s = "Pleine lune"
         Case #MoonPhase_LastQuarter
            Phase_Texte.s = "Dernier quartier"
      EndSelect
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Calcul de l'heure
      If Phase <> #MoonPhase_None
         Heure = GetMoonPhaseHour(An, Mois, Jour)
         Minute = GetMoonPhaseMinute(An, Mois, Jour)
         Heure_Texte.s = RSet(Str(Heure), 2, "0") + ":" + RSet(Str(Minute), 2, "0")
      Else
         Heure_Texte.s = ""
      EndIf
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Affiche dans la liste
      AddGadgetItem(#ListeMois, -1, Jour_Texte + Chr(10) + Heure_Texte + Chr(10) + Phase_Texte)
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Ajoute un jour
      Date = AddDate(Date, #PB_Date_Day, 1)
   Wend
   
   
   ; Pour l'année complète
   ClearGadgetItems(#ListeAn)
   Date = Date(An, 1, 1, 0, 0, 0) ; Premier jour de l'année
   Date = NextMoonPhase(An, Mois, 1)
   While Year(Date) = An
      ; Jour
      Mois = GetMoonPhaseMonth()
      Jour = GetMoonPhaseDay()
      Jour_Texte.s = RSet(Str(Jour), 2, "0") + "/" + RSet(Str(Mois), 2, "0") + "/" + Str(An)
      ; Calcul de la phase de la Lune
      Phase = GetMoonPhase()
      Select Phase
         Case #MoonPhase_None
            Phase_Texte.s = ""
         Case #MoonPhase_NewMoon
            Phase_Texte.s = "Nouvelle lune"
         Case #MoonPhase_FirstQuarter
            Phase_Texte.s = "Premier quartier"
         Case #MoonPhase_FullMoon 
            Phase_Texte.s = "Pleine lune" 
         Case #MoonPhase_LastQuarter
            Phase_Texte.s = "Dernier quartier"
      EndSelect
      ; Calcul de l'heure
      Heure = GetMoonPhaseHour()
      Minute = GetMoonPhaseMinute()
      Heure_Texte.s = RSet(Str(Heure), 2, "0") + ":" + RSet(Str(Minute), 2, "0")
      ; Affiche dans la liste
      AddGadgetItem(#ListeAn, -1, Jour_Texte + Chr(10) + Heure_Texte + Chr(10) + Phase_Texte)
      ; Phase suivante
      Date = NextMoonPhase()
   Wend
   
EndProcedure
;==========================================================================
Procedure.s DateToString(MODE_DATE=0)
  Select MODE_DATE
    Case 1 ; date
      ladate.s = Str(Day(Date()))+"/"+Str(Month(Date()))+"/"+Str(Year(Date()))
    Case 2 ; heure
      ladate.s = Str(Hour(Date()))+":"+Str(Minute(Date()))+":"+Str(Second(Date()))
    Default ; date + heure
      ladate.s = Str(Day(Date()))+"/"+Str(Month(Date()))+"/"+Str(Year(Date()))+" Il est "+Str(Hour(Date()))+":"+Str(Minute(Date()))+":"+Str(Second(Date()))
  EndSelect
  ProcedureReturn ladate.s
EndProcedure

Procedure AfficheHeure()
SetGadgetText(#Ma_fen3,    DateToString() )
EndProcedure
;==============================================================================
; Lecture de la date actuelle
Date = Date()
An = Year(Date)
Mois = Month(Date)
;=======================================================================================================
WinStatus=#False   ;True

  LoadFont       (#font0, Police$ ,9,#PB_Font_Bold |#PB_Font_HighQuality |#PB_Font_Italic)
  LoadFont       (#font1, Police$ ,10,#PB_Font_Bold |#PB_Font_HighQuality |#PB_Font_Italic)
  LoadFont       (#font2, Police$ ,7,#PB_Font_Bold | #PB_Font_HighQuality |#PB_Font_Italic)
  LoadFont(#Police_4,"Tahoma",9,#PB_Font_Bold |#PB_Font_HighQuality | #PB_Font_Italic)
; Ici vos gadgets
;=====================================================================
OpenWindow(#Ma_fen3, 0, 0, 745, 630, "Phase de la Lune LSI 2012", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_ScreenCentered | #PB_Window_TitleBar | #LVS_NOSORTHEADER) 


StickyWindow(#Ma_fen3, 1)
SetWindowColor(#Ma_fen3,$D6A82C)  ;$11E0EE couleur cadre bleu $D6A82C $0B9509(vert) $E7CF76 $7BC01B

Global ListGadget.l 
SetClassLongPtr_(WindowID(#Ma_fen3),#GCL_STYLE,$00020000);*** pour faire une ombre
HideWindow(#Ma_fen3,0)

;=======================================================================================
SetGadgetFont  (#PB_Default, FontID(#font0)) 
;ContainerGadget(#cont, 10, 14, 370, 600,#PB_Container_Double) 

ListGadget = ListIconGadget(#ListeMois, 12, 14, 340, 574, "   Jour du Mois", 120, #PB_ListIcon_FullRowSelect | #PB_ListIcon_GridLines | #PB_ListIcon_MultiSelect |#PB_ListIcon_AlwaysShowSelection| #LVS_NOSORTHEADER );| $A80F0F )
SetGadgetColor(#ListeMois, #PB_Gadget_LineColor, $7BC01B);$7BC01B $403CFC
AddGadgetColumn(#ListeMois, 1, "Heure", 70)
;SetGadgetItemColor(#ListeMois,i-1,#PB_Gadget_BackColor, RGB(100+Random(155),100+Random(155),100+Random(155)))
AddGadgetColumn(#ListeMois, 2, "Phase de la lune", 135)
AddressCallback = SetWindowLong_(GadgetID(#ListeMois), #GWL_WNDPROC, @AddressListSubclassed())  ;LSI MLD je crois
;SetWindowCallback(@ListIconGadget_CustomDraw()) 
StringGadget(#Mois, 10, 576, 300, 24, Str(Mois), #PB_String_Numeric | #ES_CENTER)
SetGadgetColor (#Mois, #PB_Gadget_FrontColor, #White)

StringGadget (#Ma_fen3, 12, 585, 340, 28, "",#ES_CENTER|#PB_String_ReadOnly);vu dans un code d'ARS
SetGadgetColor (#Ma_fen3, #PB_Gadget_FrontColor, #Gray)
SetGadgetText(#Ma_fen3,    DateToString() )
AddWindowTimer(#Ma_fen3,10,1000)
BindEvent(#PB_Event_Timer,@AfficheHeure(),#Ma_fen3)
  
  ;===================================================================================
;Global ListGadget.l 
SetGadgetFont  (#PB_Default, FontID(#font0)) 
ContainerGadget(#cont, 363, 14, 370, 600,#PB_Container_Double) 

ListGadget = ListIconGadget(#ListeAn, 0, 0, 370, 570, "   Jour de l'année", 140, #PB_ListIcon_FullRowSelect | #PB_ListIcon_GridLines | #PB_ListIcon_MultiSelect |#PB_ListIcon_AlwaysShowSelection| #LVS_NOSORTHEADER );| $A80F0F )

; SetGadgetColor(#ListeAn, #PB_Gadget_LineColor, $7B2BF4);$7BC01B) ; vu dans un code de :kernadec aout 2012  RGB(255,0,0) 
AddGadgetColumn(#ListeAn, 1, "  Heure", 70)
SetGadgetItemColor(#ListeAn,i-1,#PB_Gadget_BackColor, RGB(100+Random(155),100+Random(155),100+Random(155)))
AddGadgetColumn(#ListeAn, 2, "  Phase de la lune", 150)
 Colour = CreateSolidBrush_($EFCECE)   ; couleur fond $EFCECE
 AddressCallback = SetWindowLong_(GadgetID(#ListeAn), #GWL_WNDPROC, @AddressListSubclassed())  ;LSI MLD je crois
SetWindowCallback(@ListIconGadget_CustomDraw()) 
SetGadgetFont  (#PB_Default, FontID(#font0)) 

TextGadget(#PB_Any, 200, 576, 100, 24, "Année", #PB_Text_Center)
TextGadget(#PB_Any, 0, 576, 80, 24, "Mois", #PB_Text_Center) 
SpinGadget(#An, 280, 572, 70, 27, -9999, 9999,#PB_Spin_Numeric)
SetGadgetState (#An, 2013) : SetGadgetText(#An,Str(Year(Date()))) 
SetGadgetColor (#An, #PB_Gadget_FrontColor, #Red)

SetGadgetFont  (#PB_Default, FontID(#font1)) 
SpinGadget     (#Mois, 60, 572, 60, 27, 1, 13,#PB_Spin_Numeric)
SetGadgetState (#Mois, 10) : SetGadgetText(#Mois, Str(Month(Date())))  ;10
SetGadgetColor (#Mois, #PB_Gadget_FrontColor, #Red)
RemplirListe(An, Mois)
;============================================================
; On appelle la procedure permettant de personnaliser le ListIconGadget
; window callback permettant de personnaliser l'affichage du ListIconGadget
Procedure.l ListIconGadget_CustomDraw(WindowID.l, Message.l, wParam.l, lParam.l)
  If Message = #WM_NOTIFY
    *LVCDHeader.NMLVCUSTOMDRAW = lParam
    If *LVCDHeader\nmcd\hdr\hWndFrom = ListGadget And *LVCDHeader\nmcd\hdr\code = #NM_CUSTOMDRAW
      Select *LVCDHeader\nmcd\dwDrawStage
      
        Case #CDDS_PREPAINT
          ProcedureReturn #CDRF_NOTIFYITEMDRAW
        
        Case #CDDS_ITEMPREPAINT
          ProcedureReturn #CDRF_NOTIFYSUBITEMDRAW
        
        Case #CDDS_SUBITEMPREPAINT
          ; Modifier la couleur de fond
          ; *LVCDHeader\clrTextBk = RGB(255, 255, 223)
          ; Modifier la couleur du texte
          ; *LVCDHeader\clrText = RGB(0, 0, 255)
          ; Modifier la police
          ; SelectObject_(*LVCDHeader\nmcd\hDC, FontBold)
          
          ; On récupère les coordonnées de la case à colorier
          Row.l = *LVCDHeader\nmcd\dwItemSpec
          Col.l = *LVCDHeader\iSubItem
          
          ; On personnalise la case
          If Col = 0 
            SelectObject_(*LVCDHeader\nmcd\hDC, FontBold) 
          Else 
            SelectObject_(*LVCDHeader\nmcd\hDC, FontReg) 
          EndIf 
          If (Row/2) * 2 = Row 
            *LVCDHeader\clrTextBk = RGB(255, 255, 223) 
            If Col = 2 
              *LVCDHeader\clrText = RGB(0, 0, 255) 
            EndIf
            If Col = 0 
              *LVCDHeader\clrText = RGB(0, 0, 255) 
              EndIf 
          Else 
            *LVCDHeader\clrTextBk = RGB(208, 208, 176) 
            If Col = 2 
              *LVCDHeader\clrText = RGB(255, 0, 0) ;255, 0, 0
            EndIf 
            If Col = 0
              *LVCDHeader\clrText = RGB(255, 0, 0) ;255, 0, 0
            EndIf 
          EndIf
          
          ProcedureReturn #CDRF_NEWFONT
          
        Default
          ProcedureReturn #PB_ProcessPureBasicEvents
          
      EndSelect
    Else
      ProcedureReturn #PB_ProcessPureBasicEvents
    EndIf
  Else
    ProcedureReturn #PB_ProcessPureBasicEvents
  EndIf
EndProcedure

Repeat
   Event = WaitWindowEvent()
   
   Select Event
      Case #PB_Event_Gadget
         Select EventGadget()
            Case #An, #Mois
               If EventType() = #PB_EventType_Change
                  
                  An = Val(GetGadgetText(#An))
                  Mois = Val(GetGadgetText(#Mois))
                  If An And Mois
                     RemplirListe(An, Mois)
                  EndIf
                  
               EndIf
         EndSelect
   EndSelect
  
Until Event = #PB_Event_CloseWindow
Répondre