PureBasic

Forums PureBasic
Nous sommes le Mar 18/Juin/2019 19:53

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 18 messages ]  Aller à la page Précédente  1, 2
Auteur Message
 Sujet du message: Re: Le Soldat Inconnu... Coup de chapeau
MessagePosté: Sam 26/Jan/2019 20:49 
Hors ligne

Inscription: Mer 13/Sep/2017 14:35
Messages: 60
Localisation: Picardie (Somme)
Citation:
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:
; 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


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Le Soldat Inconnu... Coup de chapeau
MessagePosté: Dim 27/Jan/2019 8:07 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 02/Oct/2011 16:17
Messages: 2134
Localisation: 50200 Coutances
Bon dimanche Mouillard, c'est en effet un très bon code qui me sert tous les jours pour m'indiquer les heures de lever de lune, ainsi que la dates des phases, mais tu as du avoir le hoquet quand tu as posté, car tu as envoyé deux fois le même.

Pour les renseignements que tu recherches, ça ne doit pas être trop compliqué à faire sachant que les marées sont dues à l'attraction lunaire, donc quand elle pleine et plutôt pendant les équinoxes, mais il faut tenir compte des coordonnées GPS de l'endroit, et quant à savoir la position de la lune à ce moment précis, c'est encore un autre problème. Bonne chance tout de même.

_________________
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce GT 640 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.62, 5.70 LTS
Un homme doit être poli, mais il doit aussi être libre !


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Le Soldat Inconnu... Coup de chapeau
MessagePosté: Dim 27/Jan/2019 9:16 
Hors ligne

Inscription: Ven 29/Juin/2007 17:50
Messages: 3413
Micoute a écrit:
tu as du avoir le hoquet quand tu as posté, car tu as envoyé deux fois le même
C'est un changement de norme je pense.

J'ai dû adapter mon protocole depuis quelques semaines (durant le message NIELSEN.

Avant :
1) Formulaire de connexion
2) Formulaire de réponse/éditer de message




Maintenant :
1) Formulaire fantôme de connexion (fantôme = je ne remplis rien, je valide directement)
2) Formulaire de connexion

3) Formulaire fantôme de réponse de message
4) Formulaire de réponse de message

Une sécu possible :
5.1) Cliquer sur AJOUTER UN MESSAGE (ou EDITER UN MESSAGE)
5.2) Ecrire son message
5.3) Sélectionner tout (le message)
5.4) Copier
5.5) Cliquer sur ENVOYER

6.1) Sélectionner tout (le message)
6.2) Coller son message
6.3) Cliquer sur ENVOYER

7.1) Si un 3ème ou x ième formulaire revient, refaire 6.1, sélectionner tout
7.2) Coller son message
7.3) Cliquer sur ENVOYER

Ça évite de perdre des données ou valider un message vide ou non édité. Je pense que c'est un nouveau standard avec une minuterie/temporisation.

Pareil pour éditer, 2 étapes au lieu d'une.

Bonjour à Mouillard en passant, et merci d'avoir mis à jour un code de LSI.


Haut
 Profil  
Répondre en citant le message  
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 18 messages ]  Aller à la page Précédente  1, 2

Heures au format UTC + 1 heure


Qui est en ligne

Utilisateurs parcourant ce forum: Google Adsense [Bot] et 2 invités


Vous ne pouvez pas poster de nouveaux sujets
Vous ne pouvez pas répondre aux sujets
Vous ne pouvez pas éditer vos messages
Vous ne pouvez pas supprimer vos messages

Rechercher:
Aller à:  

 


Powered by phpBB © 2008 phpBB Group | Traduction par: phpBB-fr.com
subSilver+ theme by Canver Software, sponsor Sanal Modifiye