DateInfos

' ==============================================================================
'                                 DATE INFOS
'                                 Y.GERONIMI
'                             PANORAMIC 0.9.29i11
' ==============================================================================
' DECLARATION DES VARIABLES
' ==============================================================================
' incrémentation des boucles hors procédures
  dim x%
' ------------------------------------------------------------------------------
' incrémentation des numéros d'objet
  dim no%,tp%
' ------------------------------------------------------------------------------
  dim LangCfg%
  dim Lang%
' ------------------------------------------------------------------------------
  dim TMess$
  dim RMess%
' ------------------------------------------------------------------------------
' date
  dim J%
  dim M%
  dim A%
  dim Bi%
  dim JS%
  dim JA%
  dim NJ$
  dim SA%
  dim JS1J%
' ------------------------------------------------------------------------------
  dim PathAppli$
  dim FileParam$
  dim FileFlagFr$
  dim FileFlagEn$
' ==============================================================================
' DECLARATION DES SOUS PROGRAMMES ET DES ETIQUETTES
' ==============================================================================
  label CLIC
  label CHANGE
  label CLOSE0
  label RESIZE0
' ------------
  label LANG_FR
  label LANG_EN
' ==============================================================================
' DATAS
' ==============================================================================
  LANG_FR:
  DATA "Date Infos","Date ",      
  DATA "Infos ","Bissextile ?       :","Jour de la semaine :","Nom du jour        :","Jour de l'année    :"
  DATA "N° de la semaine   :","Langue "
  LANG_EN:
  DATA "Date Infos","Date "
  DATA "Infos ","Leap year ? :","Day of week : ","Day name    :","Day of year : "
  DATA "Week number :","Language "
' ==============================================================================
' Chemins de fichiers
' ==============================================================================
' Param
'  PathAppli$ = "C:\Users\Yannick\Desktop\DateInfos"
  PathAppli$ = file_extract_path$(Param_value$(0))  
  FileParam$ = PathAppli$+"DateInfo.cfg"
' ------------------------------------------------------------------------------
' Images
  FileFlagFr$ = "fr.bmp"
  FileFlagEn$ = "En.bmp"
' ------------------------------------------------------------------------------
' Init langue  
  if file_exists(FileParam$)=1
     file_open_read 21,FileParam$
     LangCfg%=val(file_readln$(21))
     Lang%=LangCfg%
     file_close 21
  else
     Lang%=1
  end_if    
' ==============================================================================
' INTERFACE
' ==============================================================================
  BUILD_FORM0(250,330,0,0)
  SET_TEXT_ATTRIBUT(0,"Courier New",10,"1000",0,0,130)
  on_close 0,CLOSE0
  on_resize 0,RESIZE0
  
  BUILD_OBJECT("CONTAINER",1,0,50,width_client(0)-150,5,5)
  SET_TEXT_ATTRIBUT(1,"Courier New",10,"1000",150,0,0)
  
  BUILD_OBJECT("COMBO",2,0,22,40,25,10)
  for x%=1 to 31 : item_add 2,right$(string$(2,"0")+str$(x%),2) : next x%
  item_select 2,date_day
  on_change 2,CHANGE
  BUILD_OBJECT("COMBO",3,0,22,40,25,55)
  for x%=1 to 12 : item_add 3,right$(string$(2,"0")+str$(x%),2) : next x%
  item_select 3,date_month
  on_change 3,CHANGE
  BUILD_OBJECT("COMBO",4,0,22,60,25,100)
  for x%=(date_year-100) to (date_year+100) : item_add 4,x% : next x%
  item_select 4,101
  on_change 4,CHANGE
  
  BUILD_OBJECT("CONTAINER",5,0,150,width_client(0)-10,55,5)
  SET_TEXT_ATTRIBUT(5,"Courier New",10,"1000",150,0,0)
  
  tp%=25
  for x%=6 to 10
     BUILD_OBJECT("ALPHA",x%,5,20,100,tp%,10)
     SET_TEXT_ATTRIBUT(x%,"Courier New",10,"1000",0,0,130)
     tp%=tp%+25
  next x%  

  tp%=25
  for x%=11 to 15
     BUILD_OBJECT("ALPHA",x%,5,20,120,tp%,180)
     SET_TEXT_ATTRIBUT(x%,"Courier New",10,"1000",150,100,0)
     tp%=tp%+25
  next x%
  
  BUILD_OBJECT("CONTAINER",16,0,50,135,5,width_client(0)-140)
  SET_TEXT_ATTRIBUT(16,"Courier New",10,"1000",150,0,0)
  
  BUILD_OBJECT("OPTION",17,16,20,20,25,5)
  cursor_point 17
  on_click 17,CLIC
  
  BUILD_OBJECT("PICTURE",19,16,20,30,23,30)  
  file_load 19,FileFlagFr$
  
  BUILD_OBJECT("OPTION",18,16,20,20,25,70)
  cursor_point 18
  on_click 18,CLIC
  
  BUILD_OBJECT("PICTURE",20,16,20,30,23,95)  
  file_load 20,FileFlagEn$
  
  SET_LANGUE_OPTION(Lang%)
  SET_OBJECT_CAPTION(Lang%)
  MAJ_AFFICHAGE(Lang%)
  END
' ==============================================================================
' SOUS PROGRAMMES
' ==============================================================================
  CLIC:
     if number_click =17 : Lang%=1 : end_if
     if number_click =18 : Lang%=2 : end_if
     SET_OBJECT_CAPTION(Lang%)
     MAJ_AFFICHAGE(Lang%)
  return
' ------------------------------------------------------------------------------  
  CHANGE:
     MAJ_AFFICHAGE(Lang%)
  return
' ------------------------------------------------------------------------------
  CLOSE0:
     M%=0
     if LangCfg%<>0
        if LangCfg%<>Lang% and Lang%=1
           TMess$ ="La langue a été changée."+chr$(13)+"Voulez les vous enregistrer les nouveaux paramètres ?"
           RMess% = Message_information_yes_no(TMess$)
        else
           if LangCfg%<>Lang% and Lang%=2
              TMess$ ="The language has been changed."+chr$(13)+"Would you save the new settings?"
              RMess% = Message_information_yes_no(TMess$)
           end_if
        end_if
     else
        if Lang%=2
           TMess$ ="The language has been changed."+chr$(13)+"Would you save the new settings?"
           RMess% = Message_information_yes_no(TMess$)        
        end_if
     end_if
     if RMess%=1
        file_open_write 21,FileParam$
        file_writeln 21,str$(Lang%)
        file_close 21
     end_if                
  return
' ------------------------------------------------------------------------------
  RESIZE0:
     height 0,250
     width 0,330
     top 0,int((screen_y-250)/2)
     left 0,int((screen_x-330)/2)
  return
' ==============================================================================
' PROCEDURES
' ==============================================================================
  SUB MAJ_AFFICHAGE(L%)
     dim_local dte$,NmJr$
     if L%=1
        NmJr$ ="Dimanche"+"Lundi"+string$(3,chr$(32))+"Mardi"+string$(3,chr$(32))+"Mercredi"+"Jeudi"+string$(3,chr$(32))+"Vendredi"+"Samedi"+string$(2,chr$(32))
     else
        NmJr$ ="Sunday"+string$(3,chr$(32))+"Monday"+string$(3,chr$(32))+"Tuesday"+string$(2,chr$(32))+"Wednesday"+"Thursday"+chr$(32)+"Friday"+string$(3,chr$(32))+"Saturday"+chr$(32)
     end_if

     J%=val(text$(2)) : M%=val(text$(3)) : A%=val(text$(4))
     Bi%=IsBissextile(A%)
     if Bi%=1
        if L%=1 : caption 11,"Oui" : end_if
        if L%=2 : caption 11,"Yes" : end_if        
     else
        if L%=1 : caption 11,"Non" : end_if
        if L%=2 : caption 11,"No"  : end_if  
     end_if
     dte$ = text$(2)+"/"+text$(3)+"/"+text$(4)
    
     JS%  = JourSemaine%(dte$)
     if L%=2
        caption 12,str$(JS%+1)
     else
        if JS%=0
           caption 12,str$(JS%+7)
        else
           caption 12,str$(JS%)
        end_if
     end_if
    
     if Lang%=1
        NJ$  = trim$(mid$(NmJr$,(JS%*8)+1,8))
     else
        NJ$  = trim$(mid$(NmJr$,(JS%*9)+1,9))
     end_if  
     caption 13,NJ$
          
     JA%   = val(JourAnnee$(dte$,Bi%))
     caption 14,str$(JA%)
    
     JS1J% = val(PremierJanvier$(dte$,Bi%))
     if JS1J%<5
        SA% = int((JS1J%+JA%+5)/7)
     else
        SA% = int((JS1J%+JA%+5)/7-1)
     end_if
     caption 15,str$(SA%)
  END_SUB
' ------------------------------------------------------------------------------
  SUB SET_LANGUE_OPTION(L%)
     if L%=1 : mark_on 17 : else : mark_on 18 : end_if
  END_SUB
' ------------------------------------------------------------------------------
  SUB SET_OBJECT_CAPTION(L%)
     dim_local i%,capt$
     if L%=1
        restore_label LANG_FR
     else
        restore_label LANG_EN
     end_if
     read capt$ : caption 0,capt$
     read capt$ : caption 1,capt$
     for i%=5 to 10
        read capt$ : caption i%,capt$
     next i%
     read capt$ : caption 16,capt$
  END_SUB
' ------------------------------------------------------------------------------  
' Construction d'objets                                                                                                    
  SUB BUILD_OBJECT(Object$,Obj%,Par%,H%,W%,T%,L%)
     dim_local i%,ListObject$,ObjName$,Type%,Fen%
 
     ListObject$ ="SCENE3D BUTTON EDIT MEMO COMBO ALPHA FORM LIST PICTURE CHECK OPTION"+chr$(32)
     ListObject$ = ListObject$ + "MAIN_MENU SUB_MENU SOUND MOVIE TRACK_BAR OPEN_DIALOG SAVE_DIALOG"+chr$(32)
     ListObject$ = ListObject$ + "SCROLL_BAR PROGRESS_BAR SPIN GRID CONTAINER MEMO_RICH BUTTON_PICTURE DLIST SCENE2D TIMER"+chr$(32)
     ListObject$ = ListObject$ + "PANEL - MAIN_MENU_POP CONTAINER_OPTION OPEN_DIALOG_PIC SAVE_DIALOG_PIC SHAPE HVIEWER SERIAL LED1 DIGIT1"+chr$(32)
     ListObject$ = ListObject$ + "SWITCH1 IMAGE CONTAINER_TAB TAB - - SYNEDIT CHART"+chr$(32)
     for i%=1 to 47
        ObjName$ = left$(ListObject$,instr(ListObject$,chr$(32))-1)
        ListObject$ = right$(ListObject$,len(ListObject$)-instr(ListObject$,chr$(32)))
        if ObjName$ = Object$
           Type% = i%
           exit_for
        end_if
     next i%
 
     select Type%
     case 1  : Fen% = 1 : SCENE3D Obj%
     case 2  : Fen% = 1 : BUTTON Obj%
     case 3  : Fen% = 1 : EDIT Obj%
     case 4  : Fen% = 1 : MEMO Obj%
     case 5  : Fen% = 1 : COMBO Obj%
     case 6  : Fen% = 1 : ALPHA Obj%
     case 7  : Fen% = 1 : FORM Obj%
     case 8  : Fen% = 1 : LIST Obj%
     case 9  : Fen% = 1 : PICTURE Obj%
     case 10 : Fen% = 1 : CHECK Obj%
     case 11 : Fen% = 1 : OPTION Obj%
     case 12 : Fen% = 0 : MAIN_MENU Obj%
     case 13 : Fen% = 0 : SUB_MENU Obj%
     case 14 : Fen% = 0 : SOUND Obj%
     case 15 : Fen% = 0 : MOVIE Obj%
     case 16 : Fen% = 1 : TRACK_BAR Obj%
     case 17 : Fen% = 0 : OPEN_DIALOG Obj%
     case 18 : Fen% = 0 : SAVE_DIALOG Obj%
     case 19 : Fen% = 1 : SCROLL_BAR Obj%
     case 20 : Fen% = 1 : PROGRESS_BAR Obj%
     case 21 : Fen% = 1 : SPIN Obj%
     case 22 : Fen% = 1 : GRID Obj%
     case 23 : Fen% = 1 : CONTAINER Obj%
     case 24 : Fen% = 1 : MEMO_RICH Obj%
     case 25 : Fen% = 1 : BUTTON_PICTURE Obj%
     case 26 : Fen% = 0 : DLIST Obj%
     case 27 : Fen% = 1 : SCENE2D Obj%
     case 28 : Fen% = 0 : TIMER Obj%
     case 29 : Fen% = 1 : PANEL Obj%
     case 30
     case 31 : Fen% = 0 : MAIN_MENU_POP Obj%
     case 32 : Fen% = 1 : CONTAINER_OPTION Obj%
     case 33 : Fen% = 0 : OPEN_DIALOG_PIC Obj%
     case 34 : Fen% = 0 : SAVE_DIALOG_PIC Obj%
     case 35 : Fen% = 1 : SHAPE Obj%
     case 36 : Fen% = 1 : HVIEWER Obj%
     case 37 : Fen% = 0 : SERIAL Obj%
     case 38 : Fen% = 1 : LED1 Obj%
     case 39 : Fen% = 1 : DIGIT1 Obi%
     case 40 : Fen% = 1 : SWITCH1 Obj%
     case 41 : Fen% = 0 : IMAGE Obj%
     case 42 : Fen% = 1 : CONTAINER_TAB Obj%
     case 43 : Fen% = 0 : TAB Obj%
     case 44
     case 45
     case 46 : Fen% = 1 : SYNEDIT Obj%
     case 47 : Fen% = 1 : CHART Obj%
     end_select
 
     if Par%>0
        parent Obj%,Par%
     end_if
 
     if Fen% = 1
        height Obj%,H%
        width Obj%,W%
        top Obj%,T%
        left Obj%,L%
     end_if
  END_SUB
' ------------------------------------------------------------------------------
' paramètres graphiques du form 0
  SUB BUILD_FORM0(H%,W%,T%,L%)
     height 0,H%
     width 0,W%
     if T%=0 : top 0,(screen_y-height(0))/2 : else : top 0,T%  : end_if
     if L%=0 : left 0,(screen_x-width(0))/2 : else : left 0,L% : end_if
  END_SUB
' ------------------------------------------------------------------------------
' Attributs du texte d'un objet
  SUB SET_TEXT_ATTRIBUT(Obj%,FtName$,FtSize%,FtStyle$,FtColR%,FtColG%,FtColB%)
     font_name Obj%,FtName$
     font_size Obj%,FtSize%
     if mid$(FtStyle$,1,1)="1" : font_bold Obj% : else : font_bold_off Obj% : end_if
     if mid$(FtStyle$,2,1)="1" : font_italic Obj% : else : font_italic_off Obj% : end_if
     if mid$(FtStyle$,3,1)="1" : font_underline Obj% : else : font_underline_off Obj%: end_if
     if mid$(FtStyle$,4,1)="1" : font_strike Obj% : else : font_strike_off Obj% : end_if
     font_color Obj%,FtColR%,FtColG%,FtColB%
  END_SUB
' ------------------------------------------------------------------------------
' Retourne 1 si l'année a est bissextile, 0 sinon
  FNC IsBissextile(a)
     IF (mod(a,4)=0) AND ((MOD(a,100)>0) OR (MOD(a,400)=0))
        result 1
     else
        result 0
     end_if
  END_FNC
' ------------------------------------------------------------------------------
' Infos sur un premier janvier d'une année
  FNC PremierJanvier$(d$,bis%)
     dim_local jj%,mm%,aaaa%,S,A,J,Sem%
  
     jj%=val(mid$(d$,1,2))
     mm%=val(mid$(d$,4,2))
     aaaa%=val(mid$(d$,7,4))  
     S = int(aaaa%/100)
     A = mod(aaaa%,100)  
     if bis%=1
        J = int(5*S)+int(S/4)+A+int(A/4)+6
        J = mod(J,7)
     else
        J = int(5*S)+int(S/4)+A+int(A/4)
        J = mod(J,7)  
     end_if  
     if J<4 : Sem%=0 : else : Sem%=1 : end_if
  
     result str$(J)
  END_FNC
' ------------------------------------------------------------------------------
' Retourne le numéro du jour de l'année
  FNC JourAnnee$(d$,bis%)
     dim_local jj%,mm%,aaaa%,N
  
     jj%  = val(mid$(d$,1,2))
     mm%  = val(mid$(d$,4,2))
     aaaa%= val(mid$(d$,7,4))
  
     if mm%=1
        N=jj%  
     else
        if mm%=2
           N=31+jj%
        else
           if bis%=1
              N=jj%+int((30.6*mm%)-32.3)+1
           else
              N=jj%+int((30.6*mm%)-32.3)
           end_if
        end_if
     end_if
     result str$(N)  
  END_FNC
' ------------------------------------------------------------------------------
' Renvoi le jour de la semaine depuis une date exprimé
' sous le format jj/mm/aaaa
  FNC JourSemaine%(D$)
     dim_local An%,Ms%,Jr%,az,ma,jjs%,rp  
     Jr% = val(mid$(D$,1,2))
     Ms% = val(mid$(D$,4,2))
     An% = val(mid$(D$,7,4))  
     if Ms%>=3:az=An%:ma=2:else:az=An%-1:ma=0:end_if
     rp=((int(23*Ms%))/9)+Jr%+4+An%+(int(az/4))-(int(az/100))+(int(az/400))-ma
     jjs%=int(mod(rp,7))  
     result jjs%  
  END_FNC