gambas-source-code/comp/src/gb.form/FCalendar.class

' Gambas class file

Private $dDate As Date
Private $dStart As Date
Private $dMonth As Date
Private $dLast As Date
Private $iDisabledColor As Integer
Private $cDateColor As New Collection

Public Sub _new()
  
  Dim iMonth As Integer
  
  For iMonth = 1 To 12
    cmbMonth.Add(DConv(Format(Date(1972, iMonth, 1), "mmmm")))
  Next 

  $dDate = Now  
  SetDate()
  
  $iDisabledColor = GetDisabledColor()
  
  UpdateFont
  
End

Private Sub GetDisabledColor() As Integer

  Dim H, S, V As Integer
  
  H = Color[Color.Foreground].Hue
  S = 0 'Color[Color.Foreground].Saturation
  V = Color[Color.Foreground].Value
  
  If V < 128 Then
    V = 255 - (255 - Color[Color.Foreground].Value) / 4
  Else 
    V /= 4
  Endif 
  
  Return Color.HSV(H, S, V)

End



Private Sub GetParent() As DateChooser
  
  Return Me.Parent
  
End


Private Sub SetDate(Optional iYear As Integer, Optional iMonth As Integer, Optional iDay As Integer)
  
  Dim dMonth As Date
  Dim dDate As Date

  If iYear <= 0 Then iYear = Year($dDate)
  If iMonth <= 0 Then iMonth = Month($dDate)
  If iDay <= 0 Then iDay = Day($dDate)
  
  Do  
    Try dDate = Date(iYear, iMonth, iDay)
    If Not Error Then Break 
    Dec iDay
    If iDay < 29 Then Return
  Loop

  $dDate = dDate
  
  dMonth = Date(Year(dDate), Month(dDate), 1)
  
  If dMonth <> $dMonth Then
  
    $dMonth = dMonth
    
    cmbMonth.Index = Month($dMonth) - 1
    txtYear.Value = Year($dMonth)
    
    iDay = WeekDay($dMonth) - 1
    If iDay < 1 Then iDay += 7
    $dStart = $dMonth - iDay
    
  Endif
    
  dwgMonth.Refresh
  
  If $dDate <> $dLast Then 
    $dLast = $dDate
    GetParent()._Change    
  Endif
  
End


Public Sub SetValue(dDate As Date)
  
  SetDate(Year(dDate), Month(dDate), Day(dDate))
  
End

Public Sub GetValue() As Date
  
  Return Date($dDate)
  
End


Public Sub dwgMonth_Draw()

  Dim I, J As Integer
  Dim X, Y, W, H As Integer
  Dim XD, YD As Integer
  Dim dDate As Date
  Dim iForeground As Integer
  Dim iBackground As Integer
  Dim sKey As String
  
  iForeground = dwgMonth.Foreground 'Draw.Foreground
  iBackground = dwgMonth.Background 'Draw.Background
  
  W = dwgMonth.ClientW / 7
  H = dwgMonth.ClientH / 7
  
  If W = 0 Or H = 0 Then Return
  
  XD = 0 '(Draw.W - W * 7) / 2
  YD = dwgMonth.ClientH - H * 6
  
  Draw.FillStyle = Fill.Solid
  Draw.LineStyle = Line.None
  
  Draw.FillColor = Color.SelectedBackground
  Draw.Foreground = Color.SelectedForeground
  Draw.Font = dwgMonth.Font
  Draw.Font.Size = Draw.Font.Size * H / Draw.Font.Height("a") * 0.7
  Draw.Font.Bold = True

  X = XD
  Y = 0
  For I = 0 To 4
    Draw.Rect(X, Y, W, YD)
    Draw.Text(Format(CDate($dStart + I), "ddd"), X, Y, W, YD, Align.Center)
    X += W
  Next  
  
  Draw.FillColor = iBackground
  Draw.Foreground = Color.SelectedBackground

  For I = 5 To 6
    Draw.Rect(X, Y, W, YD)
    Draw.Text(Format(CDate($dStart + I), "ddd"), X, Y, W, YD, Align.Center)
    X += W
  Next

  Draw.LineStyle = Line.Solid
  Draw.Foreground = iForeground
  Draw.Line(XD, YD - 1, XD + Draw.W - 1, YD - 1)
  Draw.LineStyle = Line.None

  dDate = $dStart
  Y = YD
  For J = 0 To 5
    X = XD
    For I = 0 To 6

      If CInt(dDate) = CInt($dDate) Then
        Draw.FillColor = Color.SelectedBackground
        Draw.Foreground = Color.SelectedForeground
      Else 
        If Month(dDate) <> Month($dMonth) Then 
          Draw.FillColor = iBackground
          Draw.Foreground = $iDisabledColor
        Else
          Draw.FillColor = iBackground
          Draw.Foreground = iForeground
        Endif
        sKey = CStr(Date(dDate))
        If $cDateColor.Exist(sKey) Then 
          If Draw.Foreground = $iDisabledColor Then 
            Draw.FillColor = Color.Medium(Draw.Foreground, $cDateColor[sKey])
          Else 
            Draw.FillColor = $cDateColor[sKey]
          Endif
        Endif
      Endif

      Draw.Rect(X + 1, Y + 1, W - 2, H - 2)

      Draw.Font.Bold = CInt(Now) = CInt(dDate)

      Draw.Text(Day(dDate), X, Y, W, H, Align.Center)
      
      If CInt(Now) = CInt(dDate) Then 
        Draw.LineStyle = Line.Solid
        Draw.FillStyle = Fill.None
        Draw.Foreground = iForeground
        Draw.Rect(X, Y, W, H)
        Draw.FillStyle = Fill.Solid
        Draw.LineStyle = Line.None
      Endif

      X += W
      Inc dDate
      
    Next 
    Y += H
  Next

End

Public Sub cmbMonth_Click()

  SetDate(0, cmbMonth.Index + 1)

End

Public Sub btnPrevMonth_Click()

  If Month($dMonth) = 1 Then 
    SetDate(Year($dMonth) - 1, 12)
  Else 
    SetDate(0, Month($dMonth) - 1)
  Endif  

End

Public Sub btnNextMonth_Click()

  If Month($dMonth) = 12 Then 
    SetDate(Year($dMonth) + 1, 1)
  Else 
    SetDate(0, Month($dMonth) + 1)
  Endif  

End

Public Sub txtYear_Change()

  SetDate(txtYear.Value)

End

Public Sub btnPrevYear_Click()

  SetDate(Year($dMonth) - 1)

End

Public Sub btnNextYear_Click()

  SetDate(Year($dMonth) + 1)

End

Public Sub dwgMonth_KeyPress()

  Select Case Key.Code
  
    Case Key.Left
      Dec $dDate
      SetDate
  
    Case Key.Right
      Inc $dDate
      SetDate
  
    Case Key.Up
      $dDate -= 7
      SetDate
  
    Case Key.Down
      $dDate += 7
      SetDate
      
    Case Key.Space
      dwgMonth_DblClick
  
  End Select   

End

Public Sub dwgMonth_MouseDown()

  Dim W, H As Integer
  Dim XD, YD As Integer
  
  W = dwgMonth.ClientW / 7
  H = dwgMonth.ClientH / 7
  
  If W = 0 Or H = 0 Then Return
  
  XD = 0 '(Draw.W - W * 7) / 2
  YD = dwgMonth.ClientH - H * 6

  If Mouse.Y < YD Then Return 
  
  $dDate = $dStart + Min(6, Mouse.X \ W) + ((Mouse.Y - YD) \ H) * 7
  SetDate

End

Public Sub btnReload_Click()

  $dDate = Now
  SetDate  

End

Public Sub dwgMonth_DblClick()

  GetParent()._Activate

End

Public Sub UpdateFont()

  cmbMonth.Height = Desktop.Scale * 4
  panToolbar.H = cmbMonth.Height
  
End

Public Sub SetDateColor(dDate As Date, iColor As Integer)
  
  Dim sKey As String = CStr(Date(dDate))
  
  If iColor = Color.Default Then 
    $cDateColor.Remove(sKey)
  Else 
    $cDateColor[sKey] = iColor
  Endif
  
End

Public Sub Form_Open()

  

End