gambas-source-code/comp/src/gb.form/DateChooser.class
seraf1 07245f04a7 [GB.FORM]
* NEW: DatePicker and ValueBox : new visual aspect
* BUG: DatePicker and ValueBox : new form.type and form.border API adaptation


git-svn-id: svn://localhost/gambas/trunk@1329 867c0c6c-44f3-4631-809d-bfa615b0a4ec
2008-04-21 08:22:06 +00:00

114 lines
1.6 KiB
Text

' Gambas class file
Export
Inherits UserControl
Property Value As Date
Property Year As Integer
Property Month As Integer
Property Day As Integer
Property Font As Font
Event Change
Event Activate
Public Const _Properties As String = "*"
Public Const _DefaultEvent As String = "Change"
Public Const _DefaultSize As String = "40,28"
Private $hCal As FCalendar
Public Sub _new()
$hCal = New FCalendar(Me)
End
Private Function Value_Read() As Date
Return $hCal.GetValue()
End
Private Sub Value_Write(Value As Date)
$hCal.SetValue(Value)
End
Public Sub _Change()
Raise Change
End
Public Sub _Activate()
Raise Activate
End
Private Function Year_Read() As Integer
Return Year(Value_Read())
End
Private Sub Year_Write(Value As Integer)
Dim dDate As Date = Value_Read()
dDate = Date(Value, Month(dDate), Day(dDate))
Value_Write(dDate)
End
Private Function Month_Read() As Integer
Return Month(Value_Read())
End
Private Sub Month_Write(Value As Integer)
Dim dDate As Date = Value_Read()
dDate = Date(Year(Value), Value, Day(dDate))
Value_Write(dDate)
End
Private Function Day_Read() As Integer
Return Day(Value_Read())
End
Private Sub Day_Write(Value As Integer)
Dim dDate As Date = Value_Read()
dDate = Date(Year(dDate), Month(dDate), Value)
Value_Write(dDate)
End
Private Function Font_Read() As Font
Return Super.Font
End
Private Sub Font_Write(Value As Font)
Super.Font = Value
$hCal.UpdateFont
End
Public Sub SetDateColor({Date} As Date, Color As Integer)
$hCal.SetDateColor({Date}, Color)
End