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

' Gambas class file
Inherits UserControl
Export
 
Public Const ThisDay As Integer = 0
Public Const FirstDayOfWeek As Integer = 1
Public Const FirstDayOfMonth As Integer = 2
Public Const FirstDayOfYear As Integer = 3

Public Const _Properties As String = "*,Tag,HeightForm=200,WidthForm=300,FormatString=%dddd% %dd% %mmmm% %yyyy%,Value,Range,Alignment{Align.*}=Align.Center,Begin{DatePicker.*}=DatePicker.ThisDay"
Public Const _DefaultEvent As String = "Change"
Public Const _DefaultSize As String = "20,4"
Public Const _DrawWith As String = "ComboBox"

Private $hObserver As Observer

Private $hHBox As HBox
Private $hForm As Form
Private $hButton As ToggleButton
Private $hTextBox As TextBox
Private $hdatechooser As DateChooser
Private $iWidthForm As Integer
Private $iHeightForm As Integer
Private $hList As Integer
Private $sFormat As String
Private $iFin As Integer
Private $iDebut As Integer
Private htimer As timer
Private IsActivate As Boolean
Property Tag As Variant
Property HeightForm As Integer
Property WidthForm As Integer
Property FormatString As String
Property Value As Date
Property Range As Integer
Property Alignment As Integer
Property Begin As Integer

Event Change()

Public Sub _New()
  
  Dim hPanel, hPanel2 As Panel
  
  hTimer = New timer As "hTimer"
  htimer.delay = 100
  hPanel2 = New Panel(Me)
  hPanel2.Arrangement = Arrange.Horizontal
  $hTextBox = New TextBox(hPanel2) As "TextBox"
  $hTextBox.Expand = True
  $hTextBox.Enabled = False
  $hTextBox.ForeColor = Color.Black
  $hButton = New ToggleButton(hPanel2) As "Button"
  $hButton.Width = 40
  $hButton.Picture = Picture["icon:/medium/calendar"]
  
  
  $hForm = New Form As "LstForm"
  Object.Attach($hForm, Me, "LstForm")
  $hForm.Border = Form.None
  $hForm.SkipTaskbar = True
  $hForm.Arrangement = Arrange.Fill
  $hForm.Stacking = Form.Above

  HPanel = New Panel($hForm)
  HPanel.Arrangement = Arrange.Fill
  $hdatechooser = New DateChooser(HPanel) As "DateChooser"
  Me.WidthForm = 300
  Me.HeightForm = 200
  $hForm.Resize($iWidthForm, $iHeightForm)
  Me.FormatString = "%dddd% %dd% %mmmm% %yyyy%"
  Me.Begin = ThisDay
  Me.Value = Now()
  Me.Alignment = Align.Center
  $hObserver = New Observer(Me.Window) As "OBS"
End

Public Sub Form_Open()
  Display_Text()
End


Public Sub Form_Resize()
    $hForm.Resize($iWidthForm, $iHeightForm)
End

Public Sub Button_MouseDown()
  $hForm.visible = Not (isActivate Or $hForm.visible)
  isActivate = $hForm.visible
  $hButton.Value = Not IsActivate
End

Public Sub TextBox_MouseDown()
 Button_MouseDown
  $hButton.Value = IsActivate
End

Public Sub LstForm_DeACtivate()
  htimer.Start
  $hForm.hide
End

Public Sub hTimer_Timer()
  hTimer.Stop
  isActivate = False
  $hButton.Value = IsActivate
End 

Public Sub LstForm_Show()
    If $hButton.ScreenY + $hButton.Height + $hForm.Height < Desktop.Height Then 
      $hForm.Move($hButton.ScreenX + $hButton.Width - $iWidthForm, $hButton.ScreenY + $hButton.Height)
    Else 
      $hForm.Move($hButton.ScreenX + $hButton.Width - $iWidthForm, $hButton.ScreenY - $hForm.Height)
    Endif
End


Private Function Tag_Read() As Variant
  Return $hTextBox.Tag
End

Private Sub Tag_Write(Value As Variant)
  $hTextBox.Tag = Value
End

Private Function Value_Read() As Date
  Return $hdatechooser.Value
End

Private Sub Value_Write(d As Date)
  $hdatechooser.Value = d
  Display_Text()
End

Private Function WidthForm_Read() As Integer
  Return $iWidthForm
End

Private Sub WidthForm_Write(Value As Integer)
  $iWidthForm = Value
  $hForm.Resize($iWidthForm, $iHeightForm)
End

Private Function HeightForm_Read() As Integer
  Return $iHeightForm
End

Private Sub HeightForm_Write(Value As Integer)
  $iHeightForm = Value
  $hForm.Resize($iWidthForm, $iHeightForm)
End

Private Function FormatString_Read() As String
  Return $sFormat
End

Private Sub FormatString_Write(Value As String)
  $sFormat = Value
End

Private Function Range_Read() As Integer
  Return $iFin
End

Private Sub Range_Write(Value As Integer)
   $iFin = Value
End

Private Function Begin_Read() As Integer
  Return $iDebut
End

Private Sub Begin_Write(Value As Integer)
   $iDebut = Value
End

Private Function Alignment_Read() As Integer
  Return $hTextBox.Alignment
End

Private Sub Alignment_Write(Value As Integer)
   $hTextBox.Alignment = Value
End

Public Sub TextBox_Change()
  Raise Change()
End

Private Sub Display_Text()
  Dim form As New String[]
  Dim ret As String
  Dim d As Date
  Dim s As String
  d = $hdatechooser.Value
  Select $iDebut
  Case FirstDayOfWeek
    d = DateAdd(d, gb.day, (- WeekDay(d) + 1))
   d = Date(Year(d), Month(d), Day(d), 0, 0, 0)
  Case FirstDayOfMonth
    d = Date(Year(d), Month(d), 1, 0, 0, 0)
   Case FirstDayOfYear
    d = Date(Year(d), 1, 1, 0, 0, 0)
  End Select
 $hdatechooser.Value = d
  
  form = ["yy", "yyyy", "m", "mm", "mmm", "mmmm", "d", "dd", "ddd", "dddd", "h", "hh", "n", "nn", "s", "ss", "u"]
  ret = $sFormat
  ret = Replace$(ret, "%w%", CStr(Week(d)))
  For Each s In form
    ret = Replace$(ret, "%" & s & "%", Format$(d, s))
  Next
  If $iFin Then 
    d = DateAdd(d, gb.Day, $iFin)
    For Each s In form
      ret = Replace$(ret, "%" & s & "2%", Format$(d, s))
    Next
  Endif
  $hTextBox.Text = ret
End

Public Sub DateChooser_Change()
 Display_Text()
End

Public Sub OBS_Move()
  If $hForm.Visible Then 
    If $hButton.ScreenY + $hButton.Height + $hForm.Height < Desktop.Height Then 
      $hForm.Move($hButton.ScreenX + $hButton.Width - $iWidthForm, $hButton.ScreenY + $hButton.Height)
    Else 
      $hForm.Move($hButton.ScreenX + $hButton.Width - $iWidthForm, $hButton.ScreenY - $hForm.Height)
    Endif
  Endif
End