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
