PureBasic Forums - English

Code: Select all

;xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
;The program is tiny utility for estimating of the term that comes for a given number of days from a starting day.
;This may be the date of the medical examination, laboratory testing date,  
;or the date of anything else. 
;The Default: Starting day = Today     Interval = 84 days 
;Written and compiled in PureBasic 5.00
;Standard PureBasic functions AddDate and DayOfWeek are not use in this program,
;alternative solution from old DOS times is presented.
;xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
;                                       START
;xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

Dim W.s (10)

W(0)= Chr(169) + "  Copyright: Luboš Svoboda 2013"
W(1)=  "ESTIMATING  OF  NEXT  DATE   (1. 1. 1900 - 31. 12. 2100) "
W(2)="Interval"
W(3)="Resulting day"
W(4)="Starting day"
W(5)="Licence"
W(6)="Calculation"
W(7)="  QUIT  "
W(8) ="Starting year is out of limit." 
W(9) ="Number of days is out of limit."
W(10)="Next Date 3.0"

;---------------------------------------------------------------------

Procedure.s DayWeek (D, M, R)
  
Dt = Int((5 * R - Int(1.2 - 0.1 * M)) / 4) + Val(Mid("033614625035", M, 1)) + D + 5
Dt = Dt - 7 * Int(Dt / 7)
Dweek$ = Mid("Sunday   Monday   Tuesday  WednesdayThursday Friday   Saturday ", 9 * Dt + 1, 9)
ProcedureReturn Dweek$

EndProcedure

;---------------------------------------------------------------

Procedure NumberDays (D, M, R) 

  If M<3
    Q= -1
  Else
    Q=0
  EndIf

  R = R - 2000 + Q
  M = M + 1 - 12 * Q
  Ndays = Int(R * 365.25) - Int(R / 100) + Int(R / 400) + Int(M * 30.6001) + D + 36462
 
  ProcedureReturn Ndays

EndProcedure

;---------------------------------------------------------------------
Macro DMR

  D= Val(Mid(Datum$, 1,2))
  M=Val(Mid(Datum$,5,2))
  R=Val(Mid(Datum$, 9,4))
  
EndMacro  
;---------------------------------------------------------------------

Macro CALC
  
        Datum$= GetGadgetText(14)        
        DMR
        Result$=""
        Interval=GetGadgetState(13)
        Ndays =  NumberDays(D, M, R)        
        Target = Ndays + Interval
        
        If R < 1900 Or R > 2100
          Result$= W(8)          
        EndIf
        
        If Target > 73414
          Result$ = W(9)         
        EndIf 
        
        If Result$=""
        M = 1
        D = 1
        Repeat
          R = R + 1
          Ndays = NumberDays(D, M, R)
        Until Target  < Ndays

        R = R - 1
        M = 0
        Repeat
          M = M + 1
          Ndays = NumberDays(D, M, R)
        Until Target < Ndays

        M = M - 1
        D = 0
        Repeat
          D = D + 1
          Ndays = NumberDays(D, M, R)
        Until Target = Ndays

        Dweek$ = DayWeek(D, M, R)
        Result$=  Str(D) + ". " + Str(M) + ". " + Str(R) + "    " + Dweek$
        EndIf
        
        SetGadgetText(18,Result$) 
        
  EndMacro
   ;---------------------------------------------------------------------
 

#WindowWidth  = 640
#WindowHeight = 160
GadgetHeight = 24

If OpenWindow(0, 100, 200, #WindowWidth, #WindowHeight, W(10) + Space(18)+ W(1), #PB_Window_MinimizeGadget)

  ;***************************************************************

  Datum$ = FormatDate("%dd. %mm. %yyyy", Date())  
  DMR  
  Dweek$ =  DayWeek (D,M,R)
 
  TextGadget  (9, 440, #WindowHeight-30, 200, 24, W(0))
 
    
  PanelGadget(3, 20, 15, #WindowWidth-50, 105)
  OpenGadgetList(3)

  AddGadgetItem(3, 1, W(6))

  TextGadget(#PB_Any,  230, 15, 200, 24, W(2))

  SpinGadget(13, 230, 30, 50,24, 1, 73414,#PB_Spin_ReadOnly   )
  SetGadgetState (13, 84) : SetGadgetText(13, "84")   ; Set initial value

  TextGadget(17,  25, 15, 100, GadgetHeight, W(4))
  DateGadget(14, 25, 30, 90, GadgetHeight, "%dd. %mm. %yyyy")

  TextGadget (19, 295, 15, 150, GadgetHeight, W(3))
  
  StringGadget(18, 295, 30, 160, 24, Result$)
  
  StringGadget(20, 130, 30, 85, GadgetHeight, "  "+Dweek$)

  ButtonGadget(16, 475, 30, 80, 24, W(7));Quit
  
  
  ;************************************************************************************

  AddGadgetItem(3, 2, W(5))

  TextGadget(#PB_Any, 30, 20, 500, 240,"Use it freely at home and at work.")
  TextGadget(#PB_Any, 30, 40, 500, 240,"Correct function of the program is not  guaranteed.")
  TextGadget(#PB_Any, 30, 60, 500, 240,"Use of the program is on your risk.") 

  ;***********************************************************************************

  CloseGadgetList()
  
  CALC

  ;0000000000000000000000000000000000000000000000000000000000000000000000000000000000
  
   Repeat
    EventID = WaitWindowEvent()
    If EventID = #PB_Event_Gadget

   Select EventGadget()

     
      Case 13 ; Spingadget

        SetGadgetText(13,Str(GetGadgetState(13)))       
        CALC
        
      Case 14  ;DateGadget                
               
       Datum$= GetGadgetText(14)        
       DMR
                
        Dweek$ =  DayWeek (D,M,R)
        SetGadgetText(20, " "+Dweek$)   
        CALC
        
      Case 16;
        
      End

   EndSelect
  
   EndIf

  Until EventID = #PB_Event_CloseWindow 

 ; 000000000000000000000000000000000000000000000000000000000000000000

 
EndIf

;xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
;                                    FINISH
;xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx