Date Picker Dialog

Example scripts and tips (replaces Old Scripts & Tips archive)

Moderators: Dorian (MJT support), JRL, Phil Pendlebury

Post Reply
User avatar
Marcus Tettmar
Site Admin
Posts: 7378
Joined: Thu Sep 19, 2002 3:00 pm
Location: Dorset, UK
Contact:

Date Picker Dialog

Post by Marcus Tettmar » Tue Aug 28, 2007 9:12 am

This code creates a "Date Picker" dialog that can be used to request a date from the user. Avoids input validation and formatting.

Code: Select all

VBSTART
VBEND

Dialog>dlgDatePicker
   Caption=Date Picker
   Width=303
   Height=290
   Top=225
   Left=172
   Min=0
   Max=0
   Resize=0

   Button=x,16,72,17,25,10
   Button=x,56,72,17,25,11
   Button=x,96,72,17,25,12
   Button=x,136,72,17,25,13
   Button=x,176,72,17,25,14
   Button=x,216,72,17,25,15
   Button=x,256,72,17,25,16
   Button=x,16,104,17,25,17
   Button=x,56,104,17,25,18
   Button=x,96,104,17,25,19
   Button=x,136,104,17,25,20
   Button=x,176,104,17,25,21
   Button=x,216,104,17,25,22
   Button=x,256,104,17,25,23
   Button=x,16,136,17,25,24
   Button=x,56,136,17,25,25
   Button=x,96,136,17,25,26
   Button=x,136,136,17,25,27
   Button=x,176,136,17,25,28
   Button=x,216,136,17,25,29
   Button=x,256,136,17,25,30
   Button=x,16,168,17,25,31
   Button=x,56,168,17,25,32
   Button=x,96,168,17,25,33
   Button=x,136,168,17,25,34
   Button=x,176,168,17,25,35
   Button=x,216,168,17,25,36
   Button=x,256,168,17,25,37
   Button=x,16,200,17,25,38
   Button=x,56,200,17,25,39
   Button=x,96,200,17,25,40
   Button=x,136,200,17,25,41
   Button=x,176,200,17,25,42
   Button=x,216,200,17,25,43
   Button=x,256,200,17,25,44
   Button=x,16,234,17,25,45
   Button=x,56,234,17,25,46
   Button=x,96,234,17,25,47
   Button=x,136,234,17,25,48
   Button=x,176,234,17,25,49
   Button=x,216,234,17,25,50
   Button=x,256,234,17,25,51

   Button=->,240,16,33,25,502
   Button=<-,16,16,33,25,501

   Edit=txtYear,160,16,65,
   Edit=txtMonth,64,16,89,
   Label=M ,16,48,true
   Label=T ,56,48,true
   Label=W ,96,48,true
   Label=Th,136,48,true
   Label=F,176,48,true
   Label=Sa,216,48,true
   Label=Su,256,48,true
EndDialog>dlgDatePicker

//Define month name array
Let>mName[1]=January
Let>mName[2]=February
Let>mName[3]=March
Let>mName[4]=April
Let>mName[5]=May
Let>mName[6]=June
Let>mName[7]=July
Let>mName[8]=August
Let>mName[9]=September
Let>mName[10]=October
Let>mName[11]=November
Let>mName[12]=December

//Initialise
Year>nYear
Month>nMon
Let>nMon=nMon-0

Show>dlgDatePicker
GoSub>ResetButtons
Label>dpLoop

  GetDialogAction>dlgDatePicker,r
  If>r=501
    Let>nMon=nMon-1
	If>nMon=0
	  Let>nYear=nYear-1
	  Let>nMon=12
	Endif
	GoSub>ResetButtons
  Endif
  If>r=502
    Let>nMon=nMon+1
	If>nMon=13
	  Let>nYear=nYear+1
	  Let>nMon=1
	Endif
	GoSub>ResetButtons
  Endif
  If>r=2
    //User cancelled
	Let>cancelled=TRUE
    Goto>allDone
  Endif

  If>{(%r% > 9) AND (%r% < 67)}
     //A day button was clicked
	 Let>ndx=r-9
	 Let>daySelected=dlgDatePicker.msButton%ndx%
	 If>daySelected<>x
	   Let>nDay=daySelected
	   Let>cancelled=FALSE
	   Goto>allDone
	 Endif
  Endif

  Wait>0.02
Goto>dpLoop

Label>allDone
If>cancelled=FALSE
  MessageModal>User selected day %nDay% of Month %nMon% of Year %nYear%
Else
  MessageModal>User Cancelled
Endif


SRT>ResetButtons
  Let>dlgDatePicker.txtYear=%nYear%
  Let>txtMonth=mName[%nMon%]
  Let>dlgDatePicker.txtMonth=%txtMonth%

  //what day does the 1st of nMon fall on?
  VBEval>WeekDay(DateSerial(%nYear%,%nMon%,1)),nDay1

  //how many days in month
  VBEval>Day(DateAdd("d", -1, DateAdd("m", 1, "%nYear% - %nMon% -1"))),NumDays

  //blank out all buttons
  Let>k=0
  Repeat>k
    Let>dlgDatePicker.msButton%k%=x
	Let>h=k
	//work around handle numbering bug in older 9.1 versions
	If>MSCHED_VER<9.1.04
	  Let>h=h+1
	Endif
	Let>thisHwnd=dlgDatePicker.msButton%h%.Handle
	LibFunc>User32,ShowWindow,r,thisHwnd,0
	Let>k=k+1
  Until>k=42

  //If starts on Sunday
  If>nDay1=1
    Let>nDay1=8
  Endif

  //Set day numbers on appropriate buttons
  Let>NumDays=NumDays+1
  Let>btnStart=nDay1-2
  Let>k=btnStart-1

  //work around handle numbering bugs in v9
  Separate>MSCHED_VER,.,VerParts
  StringReplace>MSCHED_VER,.,,numericVer
  If>VerParts_1>9
	Let>k=btnStart+1
  Endif
  Let>d=1
  Repeat>d
    Let>dlgDatePicker.msButton%k%=%d%
	Let>h=k
	//work around handle numbering bug in older 9.1 versions
	If>{(%numericVer%<9104) AND (%VerParts_1%<10)}
	  Let>h=h+1
	Endif
	Let>thisHwnd=dlgDatePicker.msButton%h%.Handle
	LibFunc>User32,ShowWindow,r,thisHwnd,1
    Let>k=k+1
	Let>d=d+1
  Until>d=NumDays

  //Reset and redraw dialog
  ResetDialogAction>dlgDatePicker
End>ResetButtons
Edited for compatibility with v10. This should now work in all v9 versions as well as v10.
Marcus Tettmar
http://mjtnet.com/blog/ | http://twitter.com/marcustettmar

Did you know we are now offering affordable monthly subscriptions for Macro Scheduler Standard?

Post Reply
Sign up to our newsletter for free automation tips, tricks & discounts