Has anybody created a routine that allows Quicken type date entry?
For example, when in a date field, you can press + to add 1 day to the date, or - to subtract one date, or T for today's date, or M for the first of the month date?
And is there a way to make something like this Global, so the code could be created once, and then each date field would call this routine?
Thanks,
Alan
Quicken Dates
With this, you'll know Xmas 2300 is monday!
Code: Select all
;____________________________________________________________
;¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
; Ollivier
;_____________________________________________________________
;¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
Global ThreadOn.L
Structure DATEINFO
nDay.L
EndStructure
Macro InitDate()
Global InvalidDate.L
Global Dim Jour.S(6)
Jour(0) = "Monday"
Jour(1) = "Tuesday"
Jour(2) = "Wednesday"
Jour(3) = "Thursday"
Jour(4) = "Friday"
Jour(5) = "Saturday"
Jour(6) = "Sunday"
Global Dim Mois.S(11)
Mois(0) = "January"
Mois(1) = "February"
Mois(2) = "March"
Mois(3) = "April"
Mois(4) = "May"
Mois(5) = "Juny"
Mois(6) = "July"
Mois(7) = "August"
Mois(8) = "September"
Mois(9) = "October"
Mois(10) = "November"
Mois(11) = "December"
EndMacro
InitDate()
Procedure Equ(a, b)
Protected s.L
s = 0: If a = b: s = 1: EndIf
ProcedureReturn s
EndProcedure
Procedure.L Bsex(x.L) ; by Dobro
Protected Result.L
Result = (1 - Equ((x % 100), 0) )
Result | Equ(((x >> 2) % 100), 0)
Result & Equ((x % 4), 0)
ProcedureReturn Result
EndProcedure
Procedure JoursDansUnMois(x.L, y.L)
Protected Result.L
Result = (30 + ((x & 1) ! (x / 8) ) )
Result - (Equ(x, 2) * (2 - y) )
ProcedureReturn Result
EndProcedure
Procedure.L JourJ(JJ.L, MM.L, AA.L)
Protected JPM.L
Protected J.L
Protected i.L
J = 0
JPM = 0
For i = 1900 To AA - 1: J + (365 + Bsex(i) ): Next
For i = 1 To MM - 1: J + JoursDansUnMois(i, Bsex(AA) ): Next
J = ((J + JJ) - 1) % 7
InvalidDate = 0
If JJ > JoursDansUnMois(MM, Bsex(AA) ): InvalidDate = 1: EndIf
ProcedureReturn J
EndProcedure
Procedure.S Suffix(n)
Protected Suff.S
Select n
Case 1: Suff = "st"
Case 2: Suff = "nd"
Case 3: Suff = "rd"
Default: Suff = "th"
EndSelect
ProcedureReturn Suff
EndProcedure
Procedure Main(*F.POINT)
ThreadOn +1
Protected Win.L
Protected Day.L
Protected Month.L
Protected Year.L
Protected OldDay.L
Protected OldMonth.L
Protected OldYear.L
Protected DayV.L
Protected MonthV.L
Protected YearV.L
Protected Dating.L
Protected Text.S
With *F
Win = OpenWindow(-1, *F\X, *F\Y, 400, 52, "Dates and day", $CF0000)
EndWith
CreateGadgetList(WindowID(Win) )
ContainerGadget(-1, 10, 10, 380, 28, #PB_Container_Raised)
Month = SpinGadget(-1, 10, 0, 36, 20, 1, 12, #PB_Spin_Numeric)
Day = SpinGadget(-1, 64, 0, 36, 20, 1, 31, #PB_Spin_Numeric)
Year = SpinGadget(-1, 128, 0, 44, 20, 1900, 9999, #PB_Spin_Numeric)
Dating = TextGadget(-1, 192, 0, 190, 20, "")
SetGadgetText(Day, "1")
SetGadgetText(Month, "1")
SetGadgetText(Year, "1900")
Repeat
Ev = WaitWindowEvent()
OldDay = DayV
OldMonth = MonthV
OldYear = YearV
DayV = Val(GetGadgetText(Day) )
MonthV = Val(GetGadgetText(Month) )
YearV = Val(GetGadgetText(Year) )
If OldDay <> DayV: Busy = 0: EndIf
If OldMonth <> MonthV: Busy = 0: EndIf
If OldYear <> YearV: Busy = 0: EndIf
If ((DayV => 1) And ((DayV <= 31) And (MonthV => 1) ) ) And ((MonthV <= 12) And (YearV => 1900) )
If Busy = 0
Busy = 1
;Debug "X"
Text = Mois(MonthV - 1) + " the " + Str(DayV) + Suffix(DayV) + ", " + Jour(JourJ(DayV, MonthV, YearV) ) + " " + Str(YearV)
If InvalidDate: Text = "-": EndIf
SetGadgetText(Dating, Text)
EndIf
EndIf
If Ev = #PB_Event_CloseWindow: Quit | 1: EndIf
Until Quit
ThreadOn -1
EndProcedure
Dim Pos.POINT(99)
Pos(0)\X = 10
Pos(0)\Y = 10
Pos(1)\X = 100
Pos(1)\Y = 100
Pos(2)\X = 100
Pos(2)\Y = 200
CreateThread(@Main(), @Pos(0) )
Delay(100)
CreateThread(@Main(), @Pos(1) )
Delay(100)
CreateThread(@Main(), @Pos(2) )
Repeat
Delay(100)
Until ThreadOn <= 0