PureBasic Forums - English

Posted: **Thu Jul 19, 2007 12:18 pm**

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

Posted: **Tue Oct 09, 2007 10:46 pm**

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

PureBasic Forums - English

Quicken Dates

Quicken Dates