Dtpicker

[fureal2002]

Hello,
am working on a project using the Dtpicker and i want to stop the user of the program from selecting a previous date. only the current date and any other up comming date should be selected. can some please help me out here. tnx

[dglienna]

Hmm. Missing the MSCAL.OCX on Windows 7...

You'd have to edit the user input after they selected.

[dglienna]

Of course, you can use a FLEXGRID!

'Default Using the MSFlexGrid as a Calendar
'Sample using the MSFlexGrid as a Month Calendar like Outlook.
'   VB:
'---------------------------------------------------------------------------------------
' Module    : Form1
' DateTime  : 11-7-2004 00:28
' Author    : Flyguy
' Purpose   : Sample using FlexGrid as Month Calendar
'---------------------------------------------------------------------------------------
Option Explicit

Private m_lDate As Long ' The date we are working on

Private Sub Form_Load()
  m_lDate = Date
  DrawGrid m_lDate
End Sub

Private Sub Command1_Click()
  m_lDate = DateAdd("m", -1, m_lDate)
  DrawGrid m_lDate
End Sub

Private Sub Command2_Click()
  m_lDate = DateAdd("m", 1, m_lDate)
  DrawGrid m_lDate
End Sub

Private Sub Form_Resize()
  ' I really don't care about errors when resizing
  On Error Resume Next
  
  Command2.Left = Me.ScaleWidth - Command1.Left - Command2.Width
  With MSFlexGrid1
    .Left = Command1.Left
    .Top = 2 * Command1.Top + Command2.Height
    .Move .Left, .Top, Me.ScaleWidth - 2 * .Left, Me.ScaleHeight - .Top - .Left
  End With
  
  ' Also update the grid interior
  SizeGrid
End Sub

'---------------------------------------------------------------------------------------
' Procedure : MSFlexGrid1_DblClick
' DateTime  : 10-7-2004 23:55
' Author    : Flyguy
' Purpose   : To enter some data in the clicked cell
'---------------------------------------------------------------------------------------
'
Private Sub MSFlexGrid1_DblClick()
  Dim lRow As Long
  Dim lCol As Long
  Dim sText As String
  
  With MSFlexGrid1
    lRow = .MouseRow
    lCol = .MouseCol
    If lRow / 2 = lRow \ 2 Then lRow = lRow + 1
    sText = InputBox(.TextMatrix(lRow - 1, lCol), , .TextMatrix(lRow, lCol))
    If StrPtr(sText) <> 0 Then .TextMatrix(lRow, lCol) = sText
  End With
End Sub

Private Sub MSFlexGrid1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  SetCellFocus
End Sub

Private Sub MSFlexGrid1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  If Button = vbLeftButton Then SetCellFocus
End Sub

'---------------------------------------------------------------------------------------
' Procedure : DrawGrid
' DateTime  : 11-7-2004 00:23
' Author    : Flyguy
' Purpose   : Draw the calendar for the given month
'---------------------------------------------------------------------------------------
'
Private Sub DrawGrid(ByVal theDate As Long)
  Dim lFirstDate As Long
  Dim lLastDate As Long
  Dim lFirstCol As Long
  Dim lCol As Long, lRow As Long, lRows As Long
  Dim lDate As Long
  
  Me.Caption = Format(theDate, "mmmm yyyy")
  
  ' Get the 1st and last day of the month
  lFirstDate = DateSerial(Year(theDate), Month(theDate), 1)
  lLastDate = DateSerial(Year(theDate), Month(theDate) + 1, 1) - 1
  
  
  ' The starting column
  lFirstCol = Weekday(lFirstDate, vbUseSystemDayOfWeek) - 1
  'If you are not getting Sunday on the left then comment out above, and uncomment below
  'lFirstCol = Weekday(lFirstDate) - 1
  
  ' Determine the number of weeks
  lRows = DateDiff("ww", lFirstDate, lLastDate, vbUseSystemDayOfWeek) + 1
  'If you are not getting Sunday on the left then comment out above, and uncomment below
  'lRows = DateDiff("ww", lFirstDate, lLastDate) + 1
  
  
  With MSFlexGrid1
    ' No borders etc to autosize nicely
    .BorderStyle = flexBorderNone
    .Appearance = flexFlat
    .ScrollBars = flexScrollBarNone
    
    ' Just some color settings
    .GridColor = vb3DFace
    .BackColor = .GridColor
    
    ' No highlighting
    .HighLight = flexHighlightNever
    .FocusRect = flexFocusLight
    
    ' Enable texts to span multiple lines
    .WordWrap = True
    
    ' Number of days in a week <img src=\"x_images/images/smilies/wink.gif\" border=\"0\" alt=\"\" title=\"Wink\" class=\"inlineimg\" />
    .Cols = 7
    
    ' For the date header
    .Rows = lRows * 2
    .Clear
    
    lRow = 0
    lCol = lFirstCol - 1
    For lDate = lFirstDate To lLastDate
      ' Column and Row counters
      lCol = lCol + 1
      If lCol > 6 Then
        lRow = lRow + 2
        lCol = 0
      End If
      
      ' Format the date header of the cell
      .Col = lCol
      .Row = lRow
      .TextMatrix(lRow, lCol) = FormatDateTime(lDate, vbShortDate)
      .CellAlignment = flexAlignRightTop
      ' Different color for weekend days
      If Weekday(lDate, vbMonday) > 5 Then
        .CellBackColor = RGB(239, 239, 239)
      Else
       .CellBackColor = vbWhite
      End If
      ' Make it yellow when today
      If lDate = Date Then .CellBackColor = vbYellow
      
      ' Format the data cell
      .Row = lRow + 1
      .CellBackColor = vbWhite
      .CellAlignment = flexAlignLeftTop
      .CellFontBold = True
      ' Different color for weekend days
      If Weekday(lDate, vbMonday) > 5 Then
        .CellBackColor = RGB(239, 239, 239)
      Else
         .CellBackColor = vbWhite
      End If
      ' Make it yellow when today
      If lDate = Date Then .CellBackColor = vbInfoBackground
    Next lDate
    
    ' No fixed columns/rows
    .FixedRows = 0
    .FixedCols = 0
    
    ' Set the initial focus
    .Col = lFirstCol
    .Row = 1
    
    SizeGrid
    
    .Redraw = True
  End With
End Sub

'---------------------------------------------------------------------------------------
' Procedure : SizeGrid
' DateTime  : 11-7-2004 00:23
' Author    : Flyguy
' Purpose   : Resize the cells when the grid is resized
'---------------------------------------------------------------------------------------
'
Private Sub SizeGrid()
  Dim lRowHeight As Long
  Dim lRow As Long
  
  ' Don't care about resize errors
  On Error Resume Next
  
  With MSFlexGrid1
    .Redraw = False
    
    ' Set the width of all columns
    .ColWidth(-1) = Int(.Width / .Cols)
    
    ' Correct the width of last column
    .ColWidth(.Cols - 1) = .ColWidth(.Cols - 1) + (.Width - .Cols * .ColWidth(.Cols - 1))
    
    ' Calculate the height of the data cells
    lRowHeight = (.Height - (.Rows / 2) * .RowHeight(0)) / (.Rows / 2)
    
    ' Set the height of the data cells
    For lRow = 1 To .Rows - 1 Step 2
      .RowHeight(lRow) = lRowHeight
    Next lRow
    
    .Redraw = True
  End With
      
End Sub

'---------------------------------------------------------------------------------------
' Procedure : SetCellFocus
' DateTime  : 10-7-2004 23:56
' Author    : Flyguy
' Purpose   : Make sure to set the focus to the data part
'---------------------------------------------------------------------------------------
'
Private Sub SetCellFocus()
  Dim lRow As Long
  Dim lCol As Long
  
  With MSFlexGrid1
    lRow = .MouseRow
    lCol = .MouseCol
    If lRow >= 0 And lCol >= 0 Then
      If lRow / 2 = lRow \ 2 Then lRow = lRow + 1
      .Row = lRow
      .Col = lCol
    End If
  End With
End Sub

Not sure of the origin...

[TechGnome]

Correct me if I'm wrong... but doesn't the DTPicker have MinDate setting? Seems to me I remember using that (as well as a MaxDate property) before.

-tg

[fureal2002]

ya but the minDate only allows you to pick a date from the mindate set to the maxdate. what i want to be done is that, only from the current date to a further date can be selected. for instance if today is 10/11/2010, only from this date and any other further date will they be able to select, no past date selection.

[dglienna]

Doesn't make sense. Ask the user if the date should be BEFORE today, before letting them choose?

[TechGnome]

You you would set the MinDate to the current date.... leave the MaxDate alone... That's exactly what you're asking for... even in your description of how it works is exactly what you're asking for...

-tg