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
