- Unable to RELOAD list boxes - prevents the SetLang from working after the LISTBOX is created
- Unable to REDIM to resize the y$() array to allow varying year ranges
Code: |
' TestDatePicker
run "DatePicker",#dp '- #dp SetDate(2,29,2004) render #dp button #b,"Validate",[validate] wait [validate] print #dp GetDate$();" is "; if #dp IsValid() then print "valid" else print "invalid" end |
Code: |
' DatePicker - a simple date picker/validator
' By Brent D. Thorn, 1/2009 ' PUBLIC DOMAIN Global #m, #d, #y Global YEARCOUNT: YEARCOUNT = 100 Dim m$(12) Dim d$(31) Dim y$(YEARCOUNT) Call Init ListBox #m, m$(), 1 ListBox #d, d$(), 1 ListBox #y, y$(), 1 Sub Init r = SetLang("en") For d = 1 To 31 d$(d) = Str$(d) Next year = Val(Date$("yyyy/mm/dd")) For y = 1 To YEARCOUNT y$(y) = Str$(year - y + 1) Next End Sub Function SetLang( lang$ ) Select Case lang$ Case "es" 'Spanish m$(0) = "Mes": d$(0) = "Día": y$(0) = "Año" m$(1) = "Ene": m$(2) = "Feb": m$(3) = "Mar" m$(4) = "Abr": m$(5) = "May": m$(6) = "Jun" m$(7) = "Jul": m$(8) = "Ago": m$(9) = "Sep" m$(10) = "Oct": m$(11) = "Nov": m$(12) = "Dic" Case Else 'English m$(0) = "Month": d$(0) = "Day": y$(0) = "Year" m$(1) = "Jan": m$(2) = "Feb": m$(3) = "Mar" m$(4) = "Apr": m$(5) = "May": m$(6) = "Jun" m$(7) = "Jul": m$(8) = "Aug": m$(9) = "Sep" m$(10) = "Oct": m$(11) = "Nov": m$(12) = "Dec" End Select End Function Function IsValid() m = Month() d = Day() y = Year() If m * d * y Then Select Case m Case 2 leap = ((y Mod 4 = 0) And ((y Mod 100 > 0) Or (y Mod 400 = 0))) IsValid = (d <= 28 + leap) Case 4, 6, 9, 11 IsValid = (d <= 30) Case Else IsValid = 1 End Select End If End Function Function Month() msel$ = #m Selection$() For Month = 0 To 12 If msel$ = m$(Month) Then Exit For Next End Function Function Day() Day = Val(#d Selection$()) End Function Function Year() Year = Val(#y Selection$()) End Function Function GetDate$() GetDate$ = Str$(Month())+"/"+Str$(Day())+"/"+Str$(Year()) End Function Function SetDate( m, d, y ) #m Select(m$(m)) #d Select(Str$(d)) #y Select(Str$(y)) End Function |