Calendar drop-down box

edauthier · Post by **edauthier** » Mon Aug 27, 2007 3:50 pm

I am using the input> command to have the user enter a date field and then a time field, these are then used as arguments in running an application through Run Program

I guess he just needs to deal with TIME now

Me_again · Post by **Me_again** » Thu Aug 30, 2007 10:03 pm

Great, thanks Marcus, just what I needed. I also wanted to independently change the year (without cycling through 12 months) so here's a version with that feature added:

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=->,272,17,25,20,503
Button=,28,17,25,20,502

Edit=txtYear,170,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=504
Let>nYear=nYear-1
GoSub>ResetButtons
Endif
If>r=503
Let>nYear=nYear+1
GoSub>ResetButtons
Endif
If>r=2
//User cancelled
Let>cancelled=TRUE
Goto>allDone
Endif

If>{(%r% > 9) AND (%r% ndx=r-10
Let>daySelected=dlgDatePicker.msButton%ndx%
If>daySelectedx
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_VERh=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
Let>d=1
Repeat>d
Let>dlgDatePicker.msButton%k%=%d%
Let>h=k
//work around handle numbering bug in older 9.1 versions
If>MSCHED_VERh=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

jpuziano · Post by **jpuziano** » Thu Aug 30, 2007 11:20 pm

Me_again wrote:Great, thanks Marcus, just what I needed. I also wanted to independently change the year (without cycling through 12 months) so here's a version with that feature added:

Perfect! Thanks Me_again!

kpassaur · Post by **kpassaur** » Sun Sep 25, 2011 10:21 am

Has anyone redone this in Ver 12 that would like to share?

JRL · Post by **JRL** » Mon Sep 26, 2011 4:34 pm

No guarantee. Not thoroughly tested but it brings up last year this year and next year correctly.

It would be nice to use AutoSize on the dialog but for some reason when I use that it rearranges the day buttons (panels).

Let me know how it works.

Code: Select all

VBStart
VBEnd
//File for dynamic dialog
Let>CFile=%Temp_dir%CalendarDialogFile.scp
DeleteFile>CFile

//Start of dialog
WriteLn>CFile,wres,Dialog>Dialog1
WriteLn>CFile,wres,object Dialog1: TForm ClientHeight = 230 ClientWidth = 260
//WriteLn>CFile,wres,AutoSize = True
WriteLn>CFile,wres,Caption = 'Calendar'
WriteLn>CFile,wres,Position = poScreenCenter

//Panels as arrow Buttons
Let>AB=100
Repeat>AB
  Add>AB,1
  WriteLn>CFile,wres,object Panel%AB%: tPanel
  Let>value={(%AB%-100)*20}
  WriteLn>CFile,wres,Left = %value%
  WriteLn>CFile,wres,Top = 0
  WriteLn>CFile,wres,Width = 20
  WriteLn>CFile,wres,Height = 20
  If>{(%AB%=102)or(%AB%=111)}
    Let>arrow=>
  Else
    Let>arrow=<
  EndIf
  WriteLn>CFile,wres,Caption = '%arrow%'
  WriteLn>CFile,wres,end
  If>AB=102
    Let>AB=109
  EndIf
Until>AB=111

//Month and Year Edit boxes
  WriteLn>CFile,wres,object Edit1: TEdit Left = 60 Top = -1 Width = 65 Height = 20 Text = '' ReadOnly = True end
  WriteLn>CFile,wres,object Edit2: TEdit Left = 170 Top = -1 Width = 30 Height = 20 Text = '' ReadOnly = True end

//Day labels for dialog
Let>LL=0
Repeat>LL
  Add>LL,1
  VBEval>WeekdayName(%LL%, True),DayName
  WriteLn>CFile,wres,object Label%LL%: TLabel
  Let>value={%LL%*30}
  WriteLn>CFile,wres,Left = %value%
  WriteLn>CFile,wres,Top = 30
  WriteLn>CFile,wres,Width = 10
  WriteLn>CFile,wres,Height = 13
  WriteLn>CFile,wres,Caption = '%DayName%'
  WriteLn>CFile,wres,end
Until>LL=7

//Panels as date buttons so we can have colors
Let>BB=0
Let>BC=0
Let>BR=20
Repeat>BB
  Add>BB,1
  WriteLn>CFile,wres,object Panel%BB%: tPanel
    Let>rvalue={%BC% mod 7}
  If>rvalue=0
    Add>BR,30
    Let>BC=0
  EndIf
  Add>BC,1
  Let>value={%BC%*30}
  WriteLn>CFile,wres,Left = %value%
  WriteLn>CFile,wres,Top = %BR%
  WriteLn>CFile,wres,Width = 20
  WriteLn>CFile,wres,Height = 20
  WriteLn>CFile,wres,Caption = ''
  WriteLn>CFile,wres,end
Until>BB=42

WriteLn>CFile,wres,end
WriteLn>CFile,wres,EndDialog>Dialog1

//Dialoghandlers for the panel buttons
Let>DH=0
Repeat>DH
  Add>DH,1
  WriteLn>CFile,wres,AddDialogHandler>Dialog1,Panel%DH%,OnClick,SelectDate(%DH%)
Until>DH=42

Include>CFile

Day>DD
Month>MM
Year>YYYY
Let>Today=%MM%/%DD%/%YYYY%

GoSub>SetCalendar,MM,DD,YYYY

AddDialogHandler>Dialog1,Panel101,OnClick,DownMonth
AddDialogHandler>Dialog1,Panel102,OnClick,UpMonth

AddDialogHandler>Dialog1,Panel110,OnClick,DownYear
AddDialogHandler>Dialog1,Panel111,OnClick,UpYear



//Show The Dialog
Show>Dialog1,

//Action performed when the date is selected
SRT>SelectDate
  Let>SelectDate_var_1={%SelectDate_var_1%-(%FirstDay%-1)}
  Let>comma=,
  MDL>%MM%/%SelectDate_var_1%/%YYYY%%CRLF%OR%CRLF%%MoName% %SelectDate_var_1%%Comma% %YYYY%
  Exit>0
END>SelectDate

SRT>SetCalendar
  Let>NextMonth=%SetCalendar_var_1%/01/%SetCalendar_var_3%
  Add>NextMonth,33
  Separate>NextMonth,/,part
  VBEval>WeekDay(DateSerial(%SetCalendar_var_3%,%SetCalendar_var_1%,1)),FirstDay
  VBEval>DateDiff("d", "%SetCalendar_var_1%/01/%SetCalendar_var_3%", "%part_1%/01/%part_3%"),DaysInMonth
  Let>PC=0
  Let>DayNumber=0
  Repeat>PC
    Add>PC,1
    If>{%PC%>=%FirstDay%}
      Add>DayNumber,1
      If>{%DayNumber%<=%DaysInMonth%}
        SetDialogProperty>Dialog1,panel%PC%,Visible,True
        SetDialogProperty>Dialog1,panel%PC%,Caption,%DayNumber%
        If>%MM%/%DayNumber%/%YYYY%=%Today%
          SetDialogProperty>Dialog1,Panel%PC%,Color,13959119
        Else
          SetDialogProperty>Dialog1,Panel%PC%,Color,16764069
        EndIf
      Else
        SetDialogProperty>Dialog1,panel%PC%,Visible,False
      EndIf
    Else
      SetDialogProperty>Dialog1,panel%PC%,Visible,False
    EndIf
  Until>PC=42
  VBEval>MonthName(%MM%),MoName
  SetDialogProperty>Dialog1,Edit1,Text,MoName
  SetDialogProperty>Dialog1,Edit2,Text,YYYY
END>SetCalendar

SRT>DownMonth
  Sub>MM,1
  If>MM=0
    Let>MM=12
    Sub>YYYY,1
  EndIf
  GoSub>SetCalendar,MM,DD,YYYY
END>DownMonth

SRT>UpMonth
  Add>MM,1
  If>MM=13
    Let>MM=1
    Add>YYYY,1
  EndIf
  GoSub>SetCalendar,MM,DD,YYYY
END>UpMonth

SRT>DownYear
  Sub>YYYY,1
  GoSub>SetCalendar,MM,DD,YYYY
END>DownYear

SRT>UpYear
  Add>YYYY,1
  GoSub>SetCalendar,MM,DD,YYYY
END>UpYear

kpassaur · Post by **kpassaur** » Mon Sep 26, 2011 5:02 pm

That is brilliant how you came up with drawing the dialog. It is way to cool, I just tried it up to 11/15/2015

Thanks

jpuziano · Post by **jpuziano** » Mon Sep 26, 2011 5:35 pm

Hi JRL,

I tried it as well... works great. Thanks for also making the week start with Sunday instead of Monday as it would appear on a normal calendar. I also like how you colored the date buttons blue and today's date is colored in green.

The only thing I can think of that might be missing (compared to a date picker you might see in an application) is a "Today" button. After jumping around for a while changing month and year, sometimes a user would like to jump back to today's date and month and start over. That only takes one click if there is a "Today" button.

But regardless of that, great job JRL - thanks for sharing this improved version for v12... and of course thanks to Marcus for putting together the original version.

JRL · Post by **JRL** » Tue Sep 27, 2011 2:59 am

jpuziano wrote:The only thing I can think of that might be missing....

The "only thing"?

Ok. Added a return to today button. Also added VBStart at the start so that this one will compile properly. (I'll fix the other post) this one also has menu selections for month and year. Click the month or year then double click the choice from the popup menu. Also added a few comments.

kpassaur wrote:...how you came up with drawing the dialog...

I've posted several examples of that technique. It comes in handy sometimes. In this case it saves a few hundred lines of code. In other cases it can create the illusion of multi-threading. See Happy Button for example.

Code: Select all

VBSTART
VBEND

//File for dynamic dialog
Let>CFile=%Temp_dir%CalendarDialogFile.scp
DeleteFile>CFile

//Start of dialog
WriteLn>CFile,wres,Dialog>Dialog1
WriteLn>CFile,wres,object Dialog1: TForm ClientHeight = 230 ClientWidth = 260
//WriteLn>CFile,wres,AutoSize = True
WriteLn>CFile,wres,Caption = 'Calendar'
WriteLn>CFile,wres,Position = poScreenCenter

//Panels as arrow Buttons
Let>AB=100
Repeat>AB
  Add>AB,1
  WriteLn>CFile,wres,object Panel%AB%: tPanel
  Let>value={(%AB%-100)*20}
  WriteLn>CFile,wres,Left = %value%
  WriteLn>CFile,wres,Top = 0
  WriteLn>CFile,wres,Width = 20
  WriteLn>CFile,wres,Height = 20
  If>{(%AB%=102)or(%AB%=111)}
    Let>arrow=>
  Else
    Let>arrow=<
  EndIf
  WriteLn>CFile,wres,Caption = '%arrow%'
  WriteLn>CFile,wres,end
  If>AB=102
    Let>AB=109
  EndIf
Until>AB=111

//Month and Year Edit boxes
  WriteLn>CFile,wres,object Panel50: TPanel Left = 60 Top = 0 Width = 55 Height = 20 Caption = '' end
  WriteLn>CFile,wres,object Panel60: TPanel Left = 170 Top = 0 Width = 30 Height = 20 Caption = '' end

//Day labels for dialog
Let>LL=0
Repeat>LL
  Add>LL,1
  VBEval>WeekdayName(%LL%, True),DayName
  WriteLn>CFile,wres,object Label%LL%: TLabel
  Let>value={%LL%*30}
  WriteLn>CFile,wres,Left = %value%
  WriteLn>CFile,wres,Top = 30
  WriteLn>CFile,wres,Width = 10
  WriteLn>CFile,wres,Height = 13
  WriteLn>CFile,wres,Caption = '%DayName%'
  WriteLn>CFile,wres,end
Until>LL=7

//Panels as date buttons so we can have colors
Let>BB=0
Let>BC=0
Let>BR=20
Repeat>BB
  Add>BB,1
  WriteLn>CFile,wres,object Panel%BB%: tPanel
    Let>rvalue={%BC% mod 7}
  If>rvalue=0
    Add>BR,30
    Let>BC=0
  EndIf
  Add>BC,1
  Let>value={%BC%*30}
  WriteLn>CFile,wres,Left = %value%
  WriteLn>CFile,wres,Top = %BR%
  WriteLn>CFile,wres,Width = 20
  WriteLn>CFile,wres,Height = 20
  WriteLn>CFile,wres,Caption = ''
  WriteLn>CFile,wres,end
Until>BB=42
  
//jpuziano's return to today button
WriteLn>CFile,wres,object Panel120: tPanel Left = 115 Top = 0 Width = 55 Height = 20 Caption = 'Today' Visible = False end

//End of dialog
WriteLn>CFile,wres,end
WriteLn>CFile,wres,EndDialog>Dialog1

//Dialoghandlers for the panel buttons
Let>DH=0
Repeat>DH
  Add>DH,1
  WriteLn>CFile,wres,AddDialogHandler>Dialog1,Panel%DH%,OnClick,SelectDate(%DH%)
Until>DH=42

//Include the Dialog
Include>CFile

//Get today info
Day>DD
Month>MM
Year>YYYY
MidStr>YYYY,3,2,YY
Let>Today=%MM%/%DD%/%YYYY%
Let>ReturnDate=%MM%/%DD%/%YY%

//Set Dialog handlers and colors
SetDialogProperty>Dialog1,panel120,Caption,%ReturnDate%
AddDialogHandler>Dialog1,Panel101,OnClick,DownMonth
AddDialogHandler>Dialog1,Panel102,OnClick,UpMonth
AddDialogHandler>Dialog1,Panel110,OnClick,DownYear
AddDialogHandler>Dialog1,Panel111,OnClick,UpYear
AddDialogHandler>Dialog1,Panel120,OnClick,ReturnToday
AddDialogHandler>Dialog1,Panel50,OnClick,PickMonth
AddDialogHandler>Dialog1,Panel60,OnClick,PickYear
SetDialogObjectColor>Dialog1,,16777200
SetDialogProperty>Dialog1,Panel101,Color,13959119
SetDialogProperty>Dialog1,Panel102,Color,13959119
SetDialogProperty>Dialog1,Panel110,Color,13959119
SetDialogProperty>Dialog1,Panel111,Color,13959119
SetDialogProperty>Dialog1,Panel50,Color,16777210
SetDialogProperty>Dialog1,Panel60,Color,16777210
SetDialogProperty>Dialog1,Panel120,Color,16777210

//Win 7 denies object colors unless I set parent background to false
Let>PB=0
Repeat>PB
  Add>PB,1
  SetDialogProperty>Dialog1,panel%PB%,ParentBackground,False
Until>PB=120


GoSub>SetCalendar,MM,DD,YYYY

//Flags for Month and Year menu dialogs
Let>PickMonthFlag=0
Let>PickYearFlag=0

//Show The Calendar  Dialog
Show>Dialog1,

//Action performed when the date is selected
SRT>SelectDate
  Let>SelectDate_var_1={%SelectDate_var_1%-(%FirstDay%-1)}
  Let>comma=,
  MDL>%MM%/%SelectDate_var_1%/%YYYY%%CRLF%OR%CRLF%%MoName% %SelectDate_var_1%%Comma% %YYYY%
  Exit>0
END>SelectDate

//Configure the calendar,  runs each time any change is performed
SRT>SetCalendar
  Let>NextMonth=%SetCalendar_var_1%/01/%SetCalendar_var_3%
  Add>NextMonth,33
  Separate>NextMonth,/,part
  VBEval>WeekDay(DateSerial(%SetCalendar_var_3%,%SetCalendar_var_1%,1)),FirstDay
  VBEval>DateDiff("d", "%SetCalendar_var_1%/01/%SetCalendar_var_3%", "%part_1%/01/%part_3%"),DaysInMonth
  Let>PC=0
  Let>DayNumber=0
  Repeat>PC
    Add>PC,1
    If>{%PC%>=%FirstDay%}
      Add>DayNumber,1
      Length>daynumber,len
      If>len=1
        Let>Daynumber=0%daynumber%
      EndIf
      If>{%DayNumber%<=%DaysInMonth%}
        SetDialogProperty>Dialog1,panel%PC%,Visible,True
        SetDialogProperty>Dialog1,panel%PC%,Caption,%DayNumber%
        If>%MM%/%DayNumber%/%YYYY%=%Today%
          SetDialogProperty>Dialog1,Panel%PC%,Color,13959119
        Else
          SetDialogProperty>Dialog1,Panel%PC%,Color,16768669
        EndIf
      Else
        SetDialogProperty>Dialog1,panel%PC%,Visible,False
      EndIf
    Else
      SetDialogProperty>Dialog1,panel%PC%,Visible,False
    EndIf
  Until>PC=42
  VBEval>MonthName(%MM%),MoName
  SetDialogProperty>Dialog1,Panel50,Caption,MoName
  SetDialogProperty>Dialog1,Panel60,Caption,YYYY
END>SetCalendar

//Routine to decrement the month by one
SRT>DownMonth
  Sub>MM,1
  If>MM=0
    Let>MM=12
    Sub>YYYY,1
  EndIf
    Length>MM,len
  If>len=1
    Let>MM=0%MM%
  EndIf
  SetDialogProperty>Dialog1,panel120,Visible,True
  GoSub>SetCalendar,MM,DD,YYYY
END>DownMonth

//Routine to increment the month by one
SRT>UpMonth
  Add>MM,1
  If>MM=13
    Let>MM=1
    Add>YYYY,1
  EndIf
  Length>MM,len
  If>len=1
    Let>MM=0%MM%
  EndIf
  SetDialogProperty>Dialog1,panel120,Visible,True
  GoSub>SetCalendar,MM,DD,YYYY
END>UpMonth

//Routine to decrement the year by one
SRT>DownYear
  Sub>YYYY,1
  SetDialogProperty>Dialog1,panel120,Visible,True
  GoSub>SetCalendar,MM,DD,YYYY
END>DownYear

//Routine to increment the year by one
SRT>UpYear
  Add>YYYY,1
  SetDialogProperty>Dialog1,panel120,Visible,True
  GoSub>SetCalendar,MM,DD,YYYY
END>UpYear

//jpuziano's requested return to today routine
SRT>ReturnToday
  Separate>Today,/,Part
  SetDialogProperty>Dialog1,panel120,Visible,False
  Let>MM=Part_1
  Let>DD=Part_2
  Let>YYYY=Part_3
  GoSub>SetCalendar,MM,DD,YYYY
END>ReturnToday

//Routine to select a month via menu
SRT>PickMonth
If>PickMonthFlag=0
Dialog>Dialog3
object Dialog3: TForm
  AutoSize = True
  BorderStyle = bsNone
  object MSListBox1: tMSListBox
    Left = 0
    Top = 0
    Width = 100
    Height = 180
    ItemHeight = 13
    SelectedIndex = -1
  end
end
EndDialog>Dialog3
Let>PickMonthFlag=1
Let>MoList=
Let>ML=0
Repeat>ML
  Add>ML,1
  VBEval>MonthName(%ML%),MoName
  Concat>MoList,%MoName%%CRLF%
Until>ML=12
EndIf
AddDialogHandler>Dialog3,MSListBox1,OnDblClick,PostMonth
AddDialogHandler>Dialog3,MSListBox1,OnKeyPress,PostMonth
SetDialogProperty>Dialog3,MSListBox1,Text,MoList
SetDialogProperty>Dialog3,,Position,poScreenCenter
SetDialogProperty>Dialog3,MSListBox1,SelectedIndex,{%MM%-1}
Show>Dialog3,

Add>MonthSelection,1
Length>MonthSelection,len
If>len=1
  Let>MM=0%MonthSelection%
Else
  Let>MM=MonthSelection
EndIf
SetDialogProperty>Dialog1,panel120,Visible,True
GoSub>SetCalendar,MM,DD,YYYY

SRT>PostMonth
  GetDialogProperty>Dialog3,MSListBox1,SelectedIndex,MonthSelection
  CloseDialog>Dialog3
END>PostMonth
END>PickMonth


////Routine to select a year via menu
SRT>PickYear
If>PickYearFlag=0
Dialog>Dialog5
object Dialog5: TForm
  AutoSize = True
  BorderStyle = bsNone
  object MSListBox1: tMSListBox
    Left = 0
    Top = 0
    Width = 50
    Height = 180
    ItemHeight = 13
    SelectedIndex = -1
  end
end
EndDialog>Dialog5
Let>PickYearFlag=1
EndIf
Let>YrList=
Let>YL=%YYYY%-50
Let>YL_end=%YYYY%+50
Repeat>YL
  Add>YL,1
  ConCat>YrList,%YL%%CRLF%
Until>YL=YL_end

AddDialogHandler>Dialog5,MSListBox1,OnDblClick,PostYear
AddDialogHandler>Dialog5,MSListBox1,OnKeyPress,PostYear
SetDialogProperty>Dialog5,MSListBox1,Text,YrList
SetDialogProperty>Dialog5,,Position,poScreenCenter
SetDialogProperty>Dialog5,MSListBox1,SelectedIndex,49
Show>Dialog5,
Let>YYYY=YearSelection
SetDialogProperty>Dialog1,panel120,Visible,True
GoSub>SetCalendar,MM,DD,YYYY

SRT>PostYear
  GetDialogProperty>Dialog5,MSListBox1,SelectedItems,YearSelection
  CloseDialog>Dialog5
END>PostYear
END>PickYear

Post by **Marcus Tettmar** » Tue Sep 27, 2011 8:51 am

Just throwing in a completely different method which uses the Calendar OCX that ships with Microsoft Office:

Code: Select all

VBSTART
Function doDatePicker(file)
  Set objExplorer = CreateObject("InternetExplorer.Application")
  objExplorer.Navigate file
  objExplorer.ToolBar = 0
  objExplorer.StatusBar = 0
  objExplorer.Width=400
  objExplorer.Height = 300
  objExplorer.Visible = 1
  Do While (objExplorer.Document.Body.All.OKClicked.Value = "")
    Wscript.Sleep 250
  Loop
  doDatePicker = objExplorer.Document.Body.All.Calendar1.Value
  objExplorer.Quit
End Function
VBEND

LabelToVar>HTAFILE,varHTML
WriteLn>%TEMP_DIR%datepicker.html,wr,varHTML

VBEval>doDatePicker("%TEMP_DIR%datepicker.html"),theDate
MessageModal>theDate

DeleteFile>%TEMP_DIR%datepicker.html

/*
HTAFILE:
<HTML>
<HEAD>
<TITLE>Date Picker</TITLE>
</HEAD>
<SCRIPT language="VBScript">
<!--
Sub OKButton_OnClick
OkClicked.Value = 1
End Sub
'-->
</SCRIPT>
<BODY bgcolor="buttonface">
<p align="center">
<OBJECT CLASSID="clsid:8E27C92B-1264-101C-8A2F-040224009C02"
id=Calendar1>
<param name="BackColor" value="-2147483633">
<param name="DayLength" value="1">
<param name="MonthLength" value="1">
<param name="DayFontColor" value="0">
<param name="FirstDay" value="7">
<param name="GridCellEffect" value="1">
<param name="GridFontColor" value="10485760">
<param name="GridLinesColor" value="-2147483632">
<param name="ShowDateSelectors" value="-1">
<param name="ShowDays" value="-1">
<param name="ShowHorizontalGrid" value="-1">
<param name="ShowTitle" value="-1">
<param name="ShowVerticalGrid" value="-1">
<param name="TitleFontColor" value="10485760">
<param name="ValueIsNull" value="0">
</OBJECT>

<br>
<INPUT NAME="OKButton" TYPE="BUTTON" VALUE="OK" >
<input type="hidden" name="OKClicked" size="20"></P>
</BODY>
</HTML>
*/

Methuselah · Post by **Methuselah** » Tue Apr 23, 2013 11:09 am

A recent system I worked on did not have Office, so I needed to revert to a Macro Scheduler only solution.
This is the upgraded version based on earlier work of Msched forum members in this post.

Changed to again work with Dialog Designer (for MSched version 14)
Uses DateLocal to avoid errors in non-US time zones (esp mm/dd vs dd/mm)
Accepts a default seed date in ISO format (yyyy-mm-dd)
Returns selected date in MACRO_RESULT (ISO format)
Dropdowns now appear close to affected region
Includes Default(seed date) and Today(real time) support

Two code offerings are included.
1. An example calling routine
2. The upgraded DatePicker ( save as DatePicker_ISO_V14.scp)

Have fun, chaps.
Robin.

@CallCalender.scp

Code: Select all

//==============
//== Interface macro to set/verify run date
//==============
Dialog>dlgRunDate
object dlgRunDate: TForm
  Left = 323
  Top = 122
  HelpContext = 5000
  AlphaBlend = True
  BorderIcons = [biSystemMenu]
  Caption = 'Schedule Run Date'
  ClientHeight = 62
  ClientWidth = 227
  Color = 16763799
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  Position = poMainFormCenter
  ShowHint = True
  OnTaskBar = False
  PixelsPerInch = 96
  TextHeight = 13
  object Label2: TLabel
    Left = 32
    Top = 22
    Width = 44
    Height = 13
    Caption = 'Run date'
  end
  object imgCalendar: tMSImage
    Left = 168
    Top = 16
    Width = 25
    Height = 25
    Hint = 'Open Calendar'
    Center = True
    Picture.Data = {
      0954506E67496D61676589504E470D0A1A0A0000000D49484452000000160000
      00160806000000C4B46C3B0000000467414D410000B18F0BFC610500000A4569
      4343504943432070726F66696C65000078DA9D53675453E9163DF7DEF4424B88
      80944B6F5215082052428B801491262A2109104A8821A1D91551C1114545041B
      C8A088038E8E808C15512C0C8A0AD807E421A28E83A3888ACAFBE17BA36BD6BC
      F7E6CDFEB5D73EE7ACF39DB3CF07C0080C9648335135800CA9421E11E083C7C4
      C6E1E42E40810A2470001008B3642173FD230100F87E3C3C2B22C007BE000178
      D30B0800C04D9BC0301C87FF0FEA42995C01808401C07491384B08801400407A
      8E42A600404601809D98265300A0040060CB6362E300502D0060277FE6D30080
      9DF8997B01005B94211501A09100201365884400683B00ACCF568A4500583000
      14664BC43900D82D00304957664800B0B700C0CE100BB200080C003051888529
      00047B0060C8232378008499001446F2573CF12BAE10E72A00007899B23CB924
      3945815B082D710757572E1E28CE49172B14366102619A402EC2799919328134
      0FE0F3CC0000A0911511E083F3FD78CE0EAECECE368EB60E5F2DEABF06FF2262
      62E3FEE5CFAB70400000E1747ED1FE2C2FB31A803B06806DFEA225EE04685E0B
      A075F78B66B20F40B500A0E9DA57F370F87E3C3C45A190B9D9D9E5E4E4D84AC4
      425B61CA577DFE67C25FC057FD6CF97E3CFCF7F5E0BEE22481325D814704F8E0
      C2CCF44CA51CCF92098462DCE68F47FCB70BFFFC1DD322C44962B9582A14E351
      12718E449A8CF332A52289429229C525D2FF64E2DF2CFB033EDF3500B06A3E01
      7B912DA85D6303F64B27105874C0E2F70000F2BB6FC1D4280803806883E1CF77
      FFEF3FFD47A02500806649927100005E44242E54CAB33FC708000044A0812AB0
      411BF4C1182CC0061CC105DCC10BFC6036844224C4C24210420A64801C726029
      AC82422886CDB01D2A602FD4401D34C051688693700E2EC255B80E3D700FFA61
      089EC128BC81090441C808136121DA8801628A58238E08179985F821C1480412
      8B2420C9881451224B91354831528A542055481DF23D720239875C46BA913BC8
      003282FC86BC47319481B2513DD40CB543B9A8371A8446A20BD06474319A8F16
      A09BD072B41A3D8C36A1E7D0AB680FDA8F3E43C730C0E8180733C46C302EC6C3
      42B1382C099363CBB122AC0CABC61AB056AC03BB89F563CFB17704128145C009
      3604774220611E4148584C584ED848A8201C243411DA093709038451C2272293
      A84BB426BA11F9C4186232318758482C23D6128F132F107B8843C43724128943
      3227B9900249B1A454D212D246D26E5223E92CA99B34481A2393C9DA646BB207
      39942C202BC885E49DE4C3E433E41BE421F25B0A9D624071A4F853E22852CA6A
      4A19E510E534E5066598324155A39A52DDA8A15411358F5A42ADA1B652AF5187
      A81334759A39CD8316494BA5ADA295D31A681768F769AFE874BA11DD951E4E97
      D057D2CBE947E897E803F4770C0D861583C7886728199B18071867197718AF98
      4CA619D38B19C754303731EB98E7990F996F55582AB62A7C1591CA0A954A9526
      951B2A2F54A9AAA6AADEAA0B55F355CB548FA95E537DAE46553353E3A909D496
      AB55AA9D50EB531B5367A93BA887AA67A86F543FA47E59FD890659C34CC34F43
      A451A0B15FE3BCC6200B6319B3782C216B0DAB86758135C426B1CDD97C762ABB
      98FD1DBB8B3DAAA9A13943334A3357B352F394663F07E39871F89C744E09E728
      A797F37E8ADE14EF29E2291BA6344CB931655C6BAA96979658AB48AB51AB47EB
      BD36AEEDA79DA6BD45BB59FB810E41C74A275C2747678FCE059DE753D953DDA7
      0AA7164D3D3AF5AE2EAA6BA51BA1BB4477BF6EA7EE989EBE5E809E4C6FA7DE79
      BDE7FA1C7D2FFD54FD6DFAA7F5470C5806B30C2406DB0CCE183CC535716F3C1D
      2FC7DBF151435DC34043A561956197E18491B9D13CA3D5468D460F8C69C65CE3
      24E36DC66DC6A326062621264B4DEA4DEE9A524DB9A629A63B4C3B4CC7CDCCCD
      A2CDD699359B3D31D732E79BE79BD79BDFB7605A785A2CB6A8B6B86549B2E45A
      A659EEB6BC6E855A3959A558555A5DB346AD9DAD25D6BBADBBA711A7B94E934E
      AB9ED667C3B0F1B6C9B6A9B719B0E5D806DBAEB66DB67D6167621767B7C5AEC3
      EE93BD937DBA7D8DFD3D070D87D90EAB1D5A1D7E73B472143A563ADE9ACE9CEE
      3F7DC5F496E92F6758CF10CFD833E3B613CB29C4699D539BD347671767B97383
      F3888B894B82CB2E973E2E9B1BC6DDC8BDE44A74F5715DE17AD2F59D9BB39BC2
      EDA8DBAFEE36EE69EE87DC9FCC349F299E593373D0C3C843E051E5D13F0B9F95
      306BDFAC7E4F434F8167B5E7232F632F9157ADD7B0B7A577AAF761EF173EF63E
      729FE33EE33C37DE32DE595FCC37C0B7C8B7CB4FC36F9E5F85DF437F23FF64FF
      7AFFD100A78025016703898141815B02FBF87A7C21BF8E3F3ADB65F6B2D9ED41
      8CA0B94115418F82AD82E5C1AD2168C8EC90AD21F7E798CE91CE690E85507EE8
      D6D00761E6618BC37E0C2785878557863F8E7088581AD131973577D1DC4373DF
      44FA449644DE9B67314F39AF2D4A352A3EAA2E6A3CDA37BA34BA3FC62E6659CC
      D5589D58496C4B1C392E2AAE366E6CBEDFFCEDF387E29DE20BE37B17982FC85D
      7079A1CEC2F485A716A92E122C3A96404C884E3894F041102AA8168C25F21377
      258E0A79C21DC267222FD136D188D8435C2A1E4EF2482A4D7A92EC91BC357924
      C533A52CE5B98427A990BC4C0D4CDD9B3A9E169A76206D323D3ABD3183929190
      7142AA214D93B667EA67E66676CBAC6585B2FEC56E8BB72F1E9507C96BB390AC
      05592D0AB642A6E8545A28D72A07B267655766BFCD89CA3996AB9E2BCDEDCCB3
      CADB90379CEF9FFFED12C212E192B6A5864B572D1D58E6BDAC6A39B23C7179DB
      0AE315052B865606AC3CB88AB62A6DD54FABED5797AE7EBD267A4D6B815EC1CA
      82C1B5016BEB0B550AE5857DEBDCD7ED5D4F582F59DFB561FA869D1B3E15898A
      AE14DB1797157FD828DC78E51B876FCABF99DC94B4A9ABC4B964CF66D266E9E6
      DE2D9E5B0E96AA97E6970E6E0DD9DAB40DDF56B4EDF5F645DB2F97CD28DBBB83
      B643B9A3BF3CB8BC65A7C9CECD3B3F54A454F454FA5436EED2DDB561D7F86ED1
      EE1B7BBCF634ECD5DB5BBCF7FD3EC9BEDB5501554DD566D565FB49FBB3F73FAE
      89AAE9F896FB6D5DAD4E6D71EDC703D203FD07230EB6D7B9D4D51DD23D54528F
      D62BEB470EC71FBEFE9DEF772D0D360D558D9CC6E223704479E4E9F709DFF71E
      0D3ADA768C7BACE107D31F761D671D2F6A429AF29A469B539AFB5B625BBA4FCC
      3ED1D6EADE7AFC47DB1F0F9C343C59794AF354C969DAE982D39367F2CF8C9D95
      9D7D7E2EF9DC60DBA2B67BE763CEDF6A0F6FEFBA1074E1D245FF8BE73BBC3BCE
      5CF2B874F2B2DBE51357B8579AAF3A5F6DEA74EA3CFE93D34FC7BB9CBB9AAEB9
      5C6BB9EE7ABDB57B66F7E91B9E37CEDDF4BD79F116FFD6D59E393DDDBDF37A6F
      F7C5F7F5DF16DD7E7227FDCECBBBD97727EEADBC4FBC5FF440ED41D943DD87D5
      3F5BFEDCD8EFDC7F6AC077A0F3D1DC47F7068583CFFE91F58F0F43058F998FCB
      860D86EB9E383E3939E23F72FDE9FCA743CF64CF269E17FEA2FECBAE17162F7E
      F8D5EBD7CED198D1A197F29793BF6D7CA5FDEAC0EB19AFDBC6C2C61EBEC97833
      315EF456FBEDC177DC771DEFA3DF0F4FE47C207F28FF68F9B1F553D0A7FB9319
      9393FF040398F3FCEF35948200000006624B474400FF00FF00FFA0BDA7930000
      00096F464673000000010000000100086D542A0000000970485973000004EC00
      0004EC018A6EFD720000000774494D4507DB0B1912172626C0193D000000E949
      44415478DA633C7DF67C0D030343330375412D23D0E0FF2646065435F5CCB90B
      0C2806B7EF7EC8C0C00844FFFF33FC070980D8400866FF4768646404C90365FE
      230BFF67A87455C06E70F5D6BB50C56013818CFF109A0162010354086C1C2323
      8C03730143ABB7127683FD1A973388AA19409CC188EA4A98050CC8AE87A901D2
      AF6E5F60D85C1789DDE0CC553719CEEC5E8F3F00715866E21AC0303D4C03BBC1
      348B3C5C60EEDCB94419989C9C4CBAC1304DC4B0E96730B15E26392848751949
      2EA699C1A34141DBA0D8B163078387870759AE4406540D0A820693EB7DBC0653
      0BC00CA649650A00D73E3EE41C0739760000000049454E44AE426082}
  end
  object txtRunDate: TEdit
    Left = 86
    Top = 17
    Width = 75
    Height = 21
    Alignment = taCenter
    AutoSize = False
    TabOrder = 0
    Text = 'RunDate'
  end
end
EndDialog>dlgRunDate

SetDialogProperty>dlgRunDate,txtRunDate,Text,2013-04-20
AddDialogHandler>dlgRunDate,imgCalendar,OnClick,showCal
Show>dlgRunDate,res

SRT>showCal
    GetDialogProperty>dlgRunDate,txtRunDate,Text,WhichDate
    Macro>DatePicker_ISO_V14.scp /SETDATE=%WhichDate%
    SetDialogProperty>dlgRunDate,txtRunDate,Text,MACRO_RESULT
END>showCal

Label>Exit

DatePicker_ISO_V14.scp

Code: Select all

//==
//== Based on the earlier work of Msched forum members
//== 1. Changed to again work with Dialog Designer (for MSched version 14)
//== 2. Uses DateLocal to avoid errors in non-US time zones (esp mm/dd vs dd/mm)
//== 3. Accepts a default seed date in ISO format (yyyy-mm-dd)
//== 4. Returns selected date in MACRO_RESULT (ISO format)
//== 5. Dropdowns now appear close to affected region 
//== 6. Includes Default(seed date) and Today(real time) support 
//==
Dialog>Dialog1
object Dialog1: TForm
  Left = 379
  Top = 162
  HelpContext = 5000
  BorderIcons = [biSystemMenu]
  Caption = 'Calendar'
  ClientHeight = 230
  ClientWidth = 260
  Color = clSilver
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  Position = poMainFormCenter
  ShowHint = True
  OnTaskBar = False
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 30
    Top = 30
    Width = 19
    Height = 13
    Caption = 'Sun'
  end
  object Label2: TLabel
    Left = 60
    Top = 30
    Width = 21
    Height = 13
    Caption = 'Mon'
  end
  object Label3: TLabel
    Left = 90
    Top = 30
    Width = 19
    Height = 13
    Caption = 'Tue'
  end
  object Label4: TLabel
    Left = 120
    Top = 30
    Width = 23
    Height = 13
    Caption = 'Wed'
  end
  object Label5: TLabel
    Left = 150
    Top = 30
    Width = 19
    Height = 13
    Caption = 'Thu'
  end
  object Label6: TLabel
    Left = 180
    Top = 30
    Width = 11
    Height = 13
    Caption = 'Fri'
  end
  object Label7: TLabel
    Left = 210
    Top = 30
    Width = 16
    Height = 13
    Caption = 'Sat'
  end
  object PanelDownMonth: TPanel
    Left = 4
    Top = 0
    Width = 20
    Height = 20
    Cursor = crHandPoint
    Caption = '<'
    ParentBackground = False
    TabOrder = 0
  end
  object PanelUpMonth: TPanel
    Left = 80
    Top = 0
    Width = 20
    Height = 20
    Cursor = crHandPoint
    Caption = '>'
    ParentBackground = False
    TabOrder = 1
  end
  object PanelDownYear: TPanel
    Left = 184
    Top = 0
    Width = 20
    Height = 20
    Cursor = crHandPoint
    Caption = '<'
    ParentBackground = False
    TabOrder = 2
  end
  object PanelUpYear: TPanel
    Left = 233
    Top = 0
    Width = 20
    Height = 20
    Cursor = crHandPoint
    Caption = '>'
    ParentBackground = False
    TabOrder = 3
  end
  object PanelMonth: TPanel
    Left = 23
    Top = 0
    Width = 55
    Height = 20
    ParentBackground = False
    TabOrder = 4
  end
  object PanelYear: TPanel
    Left = 202
    Top = 0
    Width = 30
    Height = 20
    ParentBackground = False
    TabOrder = 5
  end
  object Panel1: TPanel
    Left = 30
    Top = 50
    Width = 20
    Height = 20
    TabOrder = 6
  end
  object Panel2: TPanel
    Left = 60
    Top = 50
    Width = 20
    Height = 20
    TabOrder = 7
  end
  object Panel3: TPanel
    Left = 90
    Top = 50
    Width = 20
    Height = 20
    TabOrder = 8
  end
  object Panel4: TPanel
    Left = 120
    Top = 50
    Width = 20
    Height = 20
    TabOrder = 9
  end
  object Panel5: TPanel
    Left = 150
    Top = 50
    Width = 20
    Height = 20
    TabOrder = 10
  end
  object Panel6: TPanel
    Left = 180
    Top = 50
    Width = 20
    Height = 20
    TabOrder = 11
  end
  object Panel7: TPanel
    Left = 210
    Top = 50
    Width = 20
    Height = 20
    TabOrder = 12
  end
  object Panel8: TPanel
    Left = 30
    Top = 80
    Width = 20
    Height = 20
    TabOrder = 13
  end
  object Panel9: TPanel
    Left = 60
    Top = 80
    Width = 20
    Height = 20
    TabOrder = 14
  end
  object Panel10: TPanel
    Left = 90
    Top = 80
    Width = 20
    Height = 20
    TabOrder = 15
  end
  object Panel11: TPanel
    Left = 120
    Top = 80
    Width = 20
    Height = 20
    TabOrder = 16
  end
  object Panel12: TPanel
    Left = 150
    Top = 80
    Width = 20
    Height = 20
    TabOrder = 17
  end
  object Panel13: TPanel
    Left = 180
    Top = 80
    Width = 20
    Height = 20
    TabOrder = 18
  end
  object Panel14: TPanel
    Left = 210
    Top = 80
    Width = 20
    Height = 20
    TabOrder = 19
  end
  object Panel15: TPanel
    Left = 30
    Top = 110
    Width = 20
    Height = 20
    TabOrder = 20
  end
  object Panel16: TPanel
    Left = 60
    Top = 110
    Width = 20
    Height = 20
    TabOrder = 21
  end
  object Panel17: TPanel
    Left = 90
    Top = 110
    Width = 20
    Height = 20
    TabOrder = 22
  end
  object Panel18: TPanel
    Left = 120
    Top = 110
    Width = 20
    Height = 20
    TabOrder = 23
  end
  object Panel19: TPanel
    Left = 150
    Top = 110
    Width = 20
    Height = 20
    TabOrder = 24
  end
  object Panel20: TPanel
    Left = 180
    Top = 110
    Width = 20
    Height = 20
    TabOrder = 25
  end
  object Panel21: TPanel
    Left = 210
    Top = 110
    Width = 20
    Height = 20
    TabOrder = 26
  end
  object Panel22: TPanel
    Left = 30
    Top = 140
    Width = 20
    Height = 20
    TabOrder = 27
  end
  object Panel23: TPanel
    Left = 60
    Top = 140
    Width = 20
    Height = 20
    TabOrder = 28
  end
  object Panel24: TPanel
    Left = 90
    Top = 140
    Width = 20
    Height = 20
    TabOrder = 29
  end
  object Panel25: TPanel
    Left = 120
    Top = 140
    Width = 20
    Height = 20
    TabOrder = 30
  end
  object Panel26: TPanel
    Left = 150
    Top = 140
    Width = 20
    Height = 20
    TabOrder = 31
  end
  object Panel27: TPanel
    Left = 180
    Top = 140
    Width = 20
    Height = 20
    TabOrder = 32
  end
  object Panel28: TPanel
    Left = 210
    Top = 140
    Width = 20
    Height = 20
    TabOrder = 33
  end
  object Panel29: TPanel
    Left = 30
    Top = 170
    Width = 20
    Height = 20
    TabOrder = 34
  end
  object Panel30: TPanel
    Left = 60
    Top = 170
    Width = 20
    Height = 20
    TabOrder = 35
  end
  object Panel31: TPanel
    Left = 90
    Top = 170
    Width = 20
    Height = 20
    TabOrder = 36
  end
  object Panel32: TPanel
    Left = 120
    Top = 170
    Width = 20
    Height = 20
    TabOrder = 37
  end
  object Panel33: TPanel
    Left = 150
    Top = 170
    Width = 20
    Height = 20
    TabOrder = 38
  end
  object Panel34: TPanel
    Left = 180
    Top = 170
    Width = 20
    Height = 20
    TabOrder = 39
  end
  object Panel35: TPanel
    Left = 210
    Top = 170
    Width = 20
    Height = 20
    TabOrder = 40
  end
  object Panel36: TPanel
    Left = 30
    Top = 200
    Width = 20
    Height = 20
    TabOrder = 41
  end
  object Panel37: TPanel
    Left = 60
    Top = 200
    Width = 20
    Height = 20
    TabOrder = 42
  end
  object PanelToday: TPanel
    Left = 110
    Top = 0
    Width = 65
    Height = 20
    Caption = 'Today'
    Color = 15333612
    ParentBackground = False
    TabOrder = 43
    Visible = False
  end
  object pnlCurrDate: TPanel
    Left = 119
    Top = 201
    Width = 113
    Height = 23
    Caption = 'Today'
    Color = 33023
    ParentBackground = False
    TabOrder = 44
  end
end
EndDialog>Dialog1
AddDialogHandler>Dialog1,Panel1,OnClick,SelectDate(1)
AddDialogHandler>Dialog1,Panel2,OnClick,SelectDate(2)
AddDialogHandler>Dialog1,Panel3,OnClick,SelectDate(3)
AddDialogHandler>Dialog1,Panel4,OnClick,SelectDate(4)
AddDialogHandler>Dialog1,Panel5,OnClick,SelectDate(5)
AddDialogHandler>Dialog1,Panel6,OnClick,SelectDate(6)
AddDialogHandler>Dialog1,Panel7,OnClick,SelectDate(7)
AddDialogHandler>Dialog1,Panel8,OnClick,SelectDate(8)
AddDialogHandler>Dialog1,Panel9,OnClick,SelectDate(9)
AddDialogHandler>Dialog1,Panel10,OnClick,SelectDate(10)
AddDialogHandler>Dialog1,Panel11,OnClick,SelectDate(11)
AddDialogHandler>Dialog1,Panel12,OnClick,SelectDate(12)
AddDialogHandler>Dialog1,Panel13,OnClick,SelectDate(13)
AddDialogHandler>Dialog1,Panel14,OnClick,SelectDate(14)
AddDialogHandler>Dialog1,Panel15,OnClick,SelectDate(15)
AddDialogHandler>Dialog1,Panel16,OnClick,SelectDate(16)
AddDialogHandler>Dialog1,Panel17,OnClick,SelectDate(17)
AddDialogHandler>Dialog1,Panel18,OnClick,SelectDate(18)
AddDialogHandler>Dialog1,Panel19,OnClick,SelectDate(19)
AddDialogHandler>Dialog1,Panel20,OnClick,SelectDate(20)
AddDialogHandler>Dialog1,Panel21,OnClick,SelectDate(21)
AddDialogHandler>Dialog1,Panel22,OnClick,SelectDate(22)
AddDialogHandler>Dialog1,Panel23,OnClick,SelectDate(23)
AddDialogHandler>Dialog1,Panel24,OnClick,SelectDate(24)
AddDialogHandler>Dialog1,Panel25,OnClick,SelectDate(25)
AddDialogHandler>Dialog1,Panel26,OnClick,SelectDate(26)
AddDialogHandler>Dialog1,Panel27,OnClick,SelectDate(27)
AddDialogHandler>Dialog1,Panel28,OnClick,SelectDate(28)
AddDialogHandler>Dialog1,Panel29,OnClick,SelectDate(29)
AddDialogHandler>Dialog1,Panel30,OnClick,SelectDate(30)
AddDialogHandler>Dialog1,Panel31,OnClick,SelectDate(31)
AddDialogHandler>Dialog1,Panel32,OnClick,SelectDate(32)
AddDialogHandler>Dialog1,Panel33,OnClick,SelectDate(33)
AddDialogHandler>Dialog1,Panel34,OnClick,SelectDate(34)
AddDialogHandler>Dialog1,Panel35,OnClick,SelectDate(35)
AddDialogHandler>Dialog1,Panel36,OnClick,SelectDate(36)
AddDialogHandler>Dialog1,Panel37,OnClick,SelectDate(37)

//== Get today info
Day>DD
Month>MM
Year>YYYY
DateLocal>%YYYY%,%MM%,%DD%,RealTimeDate

//== Allow seeding of calendar - named iso-format SETDATE (11chars yyyy-mm-dd)
Len>%SETDATE%,pLen
If>%pLen%=9,NoSeed
Separate>SETDATE,-,part
Let>YYYY=%part_1%
Let>MM=%part_2%
Let>DD=%part_3%
Label>NoSeed

DateLocal>%YYYY%,%MM%,%DD%,Today
DateLocal>%YYYY%,%MM%,%DD%,ReturnDate


//Set Dialog handlers and colors
//SetDialogProperty>Dialog1,PanelToday,Caption,%ReturnDate%
//Let>2Day=Toda
//Concat>2Day,y
//SetDialogProperty>Dialog1,PanelToday,Caption,2Day
SetDialogProperty>Dialog1,PanelToday,Caption,Default

AddDialogHandler>Dialog1,PanelDownMonth,OnClick,DownMonth
AddDialogHandler>Dialog1,PanelUpMonth,OnClick,UpMonth
AddDialogHandler>Dialog1,PanelDownYear,OnClick,DownYear
AddDialogHandler>Dialog1,PanelUpYear,OnClick,UpYear
AddDialogHandler>Dialog1,PanelToday,OnClick,ReturnToday
AddDialogHandler>Dialog1,PanelMonth,OnClick,PickMonth
AddDialogHandler>Dialog1,PanelYear,OnClick,PickYear
AddDialogHandler>Dialog1,pnlCurrDate,OnClick,GotoCurrDate
SetDialogProperty>Dialog1,pnlCurrDate,Caption,Today: %RealTimeDate%

SetDialogObjectColor>Dialog1,,16777200
SetDialogProperty>Dialog1,PanelDownMonth,Color,13959119
SetDialogProperty>Dialog1,PanelUpMonth,Color,13959119
SetDialogProperty>Dialog1,PanelDownYear,Color,13959119
SetDialogProperty>Dialog1,PanelUpYear,Color,13959119
SetDialogProperty>Dialog1,PanelMonth,Color,16777210
SetDialogProperty>Dialog1,PanelYear,Color,16777210
//SetDialogProperty>Dialog1,PanelToday,Color,16777210

Let>LimeGreen=13959119
Let>TodayOrange=33023
Let>DarkLime=8453888
SetDialogProperty>Dialog1,PanelToday,Color,%DarkLime%


//Win 7 denies object colors unless parent background set false
//== Also set other non-obvious settings for each button
Let>PB=0
Repeat>PB
  Add>PB,1
  SetDialogProperty>Dialog1,panel%PB%,ParentBackground,False

  SetDialogProperty>Dialog1,panel%PB%,Cursor,crHandPoint

  SetDialogProperty>Dialog1,panel%PB%,ParentFont,false
  //SetDialogProperty>Dialog1,panel%PB%,Font.Style,[fsBold]
  SetDialogProperty>Dialog1,panel%PB%,Font.Style,fsBold
  //SetDialogProperty>Dialog1,panel%PB%,FontStyle,[fsBold]
  //  SetDialogProperty>Dialog1,panel%PB%,FontStyle,fsBold
//    Font.Charset = DEFAULT_CHARSET
//    Font.Color = clWindowText
//    Font.Height = -11
//    Font.Name = 'MS Sans Serif'
//    Font.Style = [fsBold]
//    ParentFont = False

Until>PB=37


GoSub>SetCalendar,YYYY,MM,DD

//Flags for Month and Year menu dialogs
Let>PickMonthFlag=0
Let>PickYearFlag=0

//Show The Calendar Dialog
Show>Dialog1,res

//== Return the seed date or today if closed without selection
If>res=2
  Let>MACRO_RESULT=%YYYY%-%MM%-%DD%
  Exit>0
EndIf>

//Action performed when the date is selected
//== Return the selected date in MACRO_RESULT
SRT>SelectDate
  Let>SelectDate_var_1={%SelectDate_var_1%-(%FirstDay%-1)}
  Let>DD=%SelectDate_var_1%
  DateLocal>%YYYY%,%MM%,%SelectDate_var_1%,selDate
  //Let>comma=,
  //MDL>%selDate%%CRLF%OR%CRLF%%YYYY%-%MM%-%SelectDate_var_1%%CRLF%OR%CRLF%%MoName% %SelectDate_var_1%%Comma% %YYYY%
  Let>MACRO_RESULT=%YYYY%-%MM%-%DD%
  Exit>0
END>SelectDate

//Configure the calendar,  called each time any change is performed
SRT>SetCalendar
    Let>YYYY=%SetCalendar_var_1%
    Let>MM=%SetCalendar_var_2%
    Let>DD=%SetCalendar_var_3%
    DateLocal>YYYY,MM,DD,theDate
    DateAdd>theDate,M,1,NextMonth
    DatePart>NextMonth,Y,nYYYY
    DatePart>NextMonth,M,nMM

    //== Get weekday of first day and number of days in the month
  VBEval>WeekDay(DateSerial(%YYYY%,%MM%,1)),FirstDay
  VBEval>DateDiff("d", "%YYYY%-%MM%-01", "%nYYYY%-%nMM%-01"),DaysInMonth
  Let>PC=0
  Let>DayNumber=0
  Repeat>PC
    Add>PC,1
    If>{%PC%>=%FirstDay%}
      Add>DayNumber,1
      Length>daynumber,len
      If>len=1
        Let>Daynumber=0%daynumber%
      EndIf
      If>{%DayNumber%<=%DaysInMonth%}
        SetDialogProperty>Dialog1,panel%PC%,Visible,True
        SetDialogProperty>Dialog1,panel%PC%,Caption,%DayNumber%
        SetDialogProperty>Dialog1,Panel%PC%,Color,16768669
        DateLocal>%YYYY%,%MM%,%Daynumber%,chkToday
        If>%chkToday%=%RealTimeDate%
            SetDialogProperty>Dialog1,Panel%PC%,Color,TodayOrange
        EndIf>
        If>%chkToday%=%Today%
            SetDialogProperty>Dialog1,Panel%PC%,Color,DarkLime
        EndIf
      Else
        SetDialogProperty>Dialog1,panel%PC%,Visible,False
      EndIf
    Else
      SetDialogProperty>Dialog1,panel%PC%,Visible,False
    EndIf
  //==Until>PC=42
  Until>PC=37
  VBEval>MonthName(%MM%),MoName
  SetDialogProperty>Dialog1,PanelMonth,Caption,MoName
  SetDialogProperty>Dialog1,PanelYear,Caption,YYYY
END>SetCalendar

//Routine to decrement the month by one
SRT>DownMonth
  Sub>MM,1
  If>MM=0
    Let>MM=12
    Sub>YYYY,1
  EndIf
    Length>MM,len
  If>len=1
    Let>MM=0%MM%
  EndIf
  SetDialogProperty>Dialog1,PanelToday,Visible,True
  GoSub>SetCalendar,YYYY,MM,DD
END>DownMonth

//Routine to increment the month by one
SRT>UpMonth
  Add>MM,1
  If>MM=13
    Let>MM=1
    Add>YYYY,1
  EndIf
  Length>MM,len
  If>len=1
    Let>MM=0%MM%
  EndIf
  SetDialogProperty>Dialog1,PanelToday,Visible,True
  GoSub>SetCalendar,YYYY,MM,DD
END>UpMonth

//Routine to decrement the year by one
SRT>DownYear
  Sub>YYYY,1
  SetDialogProperty>Dialog1,PanelToday,Visible,True
  GoSub>SetCalendar,YYYY,MM,DD
END>DownYear

//Routine to increment the year by one
SRT>UpYear
  Add>YYYY,1
  SetDialogProperty>Dialog1,PanelToday,Visible,True
  GoSub>SetCalendar,YYYY,MM,DD
END>UpYear

//jpuziano's requested return to today routine
SRT>ReturnToday
  DatePart>Today,Y,YYYY
  DatePart>Today,M,MM
  DatePart>Today,D,DD
  SetDialogProperty>Dialog1,PanelToday,Visible,False
  GoSub>SetCalendar,YYYY,MM,DD
END>ReturnToday

//Return to CurrentDate (today)
SRT>GotoCurrDate
  DatePart>RealTimeDate,Y,YYYY
  DatePart>RealTimedate,M,MM
  DatePart>RealTimedate,D,DD
  //SetDialogProperty>Dialog1,PanelToday,Visible,False
  GoSub>SetCalendar,YYYY,MM,DD
END>GotoCurrDate


//Routine to select a month via menu
SRT>PickMonth
If>PickMonthFlag=0
Dialog>Dialog3
object Dialog3: TForm
  Left = 358
  Top = 121
  HelpContext = 5000
  AutoSize = True
  BorderIcons = [biSystemMenu]
  BorderStyle = bsNone
  Caption = 'CustomDialog'
  ClientHeight = 180
  ClientWidth = 116
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  PopupMode = pmAuto
  ShowHint = True
  OnTaskBar = False
  PixelsPerInch = 96
  TextHeight = 13
  object MSListBox1: tMSListBox
    Left = 0
    Top = 0
    Width = 100
    Height = 180
    ItemHeight = 13
    TabOrder = 0
    SelectedIndex = -1
  end
end
EndDialog>Dialog3
Let>PickMonthFlag=1
Let>MoList=
Let>ML=0
Repeat>ML
  Add>ML,1
  VBEval>MonthName(%ML%),MoName
  Concat>MoList,%MoName%%CRLF%
Until>ML=12
EndIf
AddDialogHandler>Dialog3,MSListBox1,OnClick,PostMonth
//AddDialogHandler>Dialog3,MSListBox1,OnDblClick,PostMonth
//AddDialogHandler>Dialog3,MSListBox1,OnKeyPress,PostMonth
SetDialogProperty>Dialog3,MSListBox1,Text,MoList
//SetDialogProperty>Dialog3,,Position,poScreenCenter
//== Rather position close to month textbox
GetDialogProperty>Dialog1,,Left,dlgParLeft
GetDialogProperty>Dialog1,PanelMonth,Left,dlgLeft
GetDialogProperty>Dialog1,,Top,dlgParTop
GetDialogProperty>Dialog1,PanelMonth,Top,dlgTop
Add>dlgLeft,dlgParLeft
Add>dlgTop,dlgParTop
Add>dlgTop,50
SetDialogProperty>Dialog3,,Left,dlgLeft
SetDialogProperty>Dialog3,,Top,dlgTop
SetDialogProperty>Dialog3,MSListBox1,SelectedIndex,{%MM%-1}
Show>Dialog3,r

Add>MonthSelection,1
Length>MonthSelection,len
If>len=1
  Let>MM=0%MonthSelection%
Else
  Let>MM=MonthSelection
EndIf
SetDialogProperty>Dialog1,PanelToday,Visible,True
GoSub>SetCalendar,YYYY,MM,DD

SRT>PostMonth
  GetDialogProperty>Dialog3,MSListBox1,SelectedIndex,MonthSelection
  CloseDialog>Dialog3
END>PostMonth
END>PickMonth


////Routine to select a year via menu
SRT>PickYear
If>PickYearFlag=0
Dialog>Dialog5
object Dialog5: TForm
  Left = 358
  Top = 121
  HelpContext = 5000
  AutoSize = True
  BorderIcons = [biSystemMenu]
  BorderStyle = bsNone
  Caption = 'CustomDialog'
  ClientHeight = 180
  ClientWidth = 116
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  PopupMode = pmAuto
  ShowHint = True
  OnTaskBar = False
  PixelsPerInch = 96
  TextHeight = 13
  object MSListBox1: tMSListBox
    Left = 0
    Top = 0
    Width = 50
    Height = 180
    ItemHeight = 13
    TabOrder = 0
    SelectedIndex = -1
  end
end
EndDialog>Dialog5
Let>PickYearFlag=1
EndIf
Let>YrList=
Let>YL=%YYYY%-10
Let>YL_end=%YYYY%+10
Repeat>YL
  Add>YL,1
  ConCat>YrList,%YL%%CRLF%
Until>YL=YL_end

AddDialogHandler>Dialog5,MSListBox1,OnClick,PostYear
//AddDialogHandler>Dialog5,MSListBox1,OnDblClick,PostYear
//AddDialogHandler>Dialog5,MSListBox1,OnKeyPress,PostYear
SetDialogProperty>Dialog5,MSListBox1,Text,YrList
//SetDialogProperty>Dialog5,,Position,poScreenCenter
//== Rather position close to year textbox
GetDialogProperty>Dialog1,,Left,dlgParLeft
GetDialogProperty>Dialog1,PanelYear,Left,dlgLeft
GetDialogProperty>Dialog1,,Top,dlgParTop
GetDialogProperty>Dialog1,PanelYear,Top,dlgTop
Add>dlgLeft,dlgParLeft
Add>dlgTop,dlgParTop
Add>dlgTop,50
SetDialogProperty>Dialog5,,Left,dlgLeft
SetDialogProperty>Dialog5,,Top,dlgTop
//== Better sync this - (number of entries-1)=current selected year
SetDialogProperty>Dialog5,MSListBox1,SelectedIndex,9
Show>Dialog5,r
Let>YYYY=YearSelection
SetDialogProperty>Dialog1,PanelToday,Visible,True
GoSub>SetCalendar,YYYY,MM,DD

SRT>PostYear
  GetDialogProperty>Dialog5,MSListBox1,SelectedItems,YearSelection
  CloseDialog>Dialog5
END>PostYear
END>PickYear

JRL · Post by **JRL** » Tue Apr 23, 2013 5:33 pm

Nice job! I particularly like the little calendar glyph.

One note. I had to add %script_dir%\ in the Macro> line in CallCalender.scp. Otherwise the scripts work flawlessly.

-------------------------------------------------------------------------------------------------------------------------------------------------

SRT>showCal

GetDialogProperty>dlgRunDate,txtRunDate,Text,WhichDate
Macro>%script_dir%\DatePicker_ISO_V14.scp /SETDATE=%WhichDate%
SetDialogProperty>dlgRunDate,txtRunDate,Text,MACRO_RESULT

END>showCal

Calendar drop-down box

Curious

To Cool

Upgraded to V14