Urgente sobre MonthView

De antemano un cordial saludo.
Porfavor serias tan amable de ayudarme necesito utilizar el MonthView (q creo se utiliza en basic ) en una aplicacion en visual fox 6.0 (tengo entendido q es un control ocx q baje de internet q no se como lo pudiero pasar a un frm de fox) y lo q quiero realizar en como un calendario interactivo q cuando le de un click a una fecha tome ese valor pero la verdad no tengo idea de como se utiliza este control te agradeceria me ayudes urgente mente.
te dejo mis mails.
[email protected]
[email protected]
Atte.
Enrique
gracias.....
1

1 Respuesta

26.200 pts. Desarrollo de Aplicaciones Visual Fox, ADO/ODBC...
Visual Fox trae unos controles bastante buenos, segun mi humilde opinion y para tener menos problemas, podrias usar estos directamente; aca te dejo un ejemplo sobre el uso; crea un prg y ejecutalo, esta muy completo.
Public oform
Set StrictDate To 0
Set Seconds Off &&to see seconds change to SET SECONDS ON
oform = Createobject("clsFormDateTime")
On Shutdown oform.Release()
oform.Show()
Define Class clsformdatetime As Form
Top = 0
Left = 0
Height = 272
Width = 387
DoCreate = .T.
Caption = "New Date/DateTime Classes"
Name = "clsformdatetime"
AutoCenter = .T.
Add Object command2 As CommandButton With ;
Top = 188, ;
Left = 137, ;
Height = 27, ;
Width = 65, ;
Caption = "< Previous", ;
Name = "Command2"
Add Object clsdatetime1 As clsdatetime With ;
Top = 145, ;
Left = 141, ;
Width = 191, ;
Height = 24, ;
controlsource = "MyTable.dtValue", ;
Name = "Clsdatetime1", ;
txtdatetime.Name = "txtDateTime", ;
spntime.Name = "spnTime", ;
txtdate.Name = "txtDate", ;
cmdcalendar.Name = "cmdCalendar", ;
txttime.Name = "txtTime"
Add Object command3 As CommandButton With ;
Top = 188, ;
Left = 202, ;
Height = 27, ;
Width = 65, ;
Caption = "Next >", ;
Name = "Command3"
Add Object command1 As CommandButton With ;
Top = 188, ;
Left = 72, ;
Height = 27, ;
Width = 65, ;
Caption = "|< First", ;
Name = "Command1"
Add Object command4 As CommandButton With ;
Top = 188, ;
Left = 267, ;
Height = 27, ;
Width = 65, ;
Caption = "Last >|", ;
Name = "Command4"
Add Object label1 As Label With ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "New Classes:", ;
Height = 17, ;
Left = 54, ;
Top = 119, ;
Width = 80, ;
Name = "Label1"
Add Object label2 As Label With ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "VFP Standard:", ;
Height = 17, ;
Left = 54, ;
Top = 56, ;
Width = 80, ;
Name = "Label2"
Add Object txtstandard As TextBox With ;
ControlSource = "MyTable.dtValue", ;
Height = 23, ;
Left = 141, ;
Top = 83, ;
Width = 191, ;
Name = "txtStandard"
Add Object clsdate1 As clsdate With ;
Top = 116, ;
Left = 141, ;
Width = 98, ;
controlsource = "MyTable.dValue", ;
Name = "Clsdate1", ;
txtdate.Name = "txtDate", ;
cmdcalendar.Name = "cmdCalendar"
Add Object text1 As TextBox With ;
ControlSource = "MyTable.dValue", ;
Height = 23, ;
Left = 141, ;
Top = 56, ;
Width = 98, ;
Name = "Text1"
Procedure Load
Create Cursor mytable (dtvalue T, dvalue d)
Insert Into mytable (dtvalue, dvalue) Values ({12/11/2000 02:59:02 am},{12/11/2000})
Insert Into mytable (dtvalue, dvalue) Values ({01/15/2001 12:42:15 pm},{01/15/2001})
Insert Into mytable (dtvalue, dvalue) Values ({04/25/2002 07:35:28 am},{04/25/2002})
Insert Into mytable (dtvalue, dvalue) Values ({07/22/2003 01:21:31 pm},{07/22/2003})
Insert Into mytable (dtvalue, dvalue) Values ({08/17/2004 09:17:43 am},{08/17/2004})
Insert Into mytable (dtvalue, dvalue) Values ({09/05/2005 11:02:59 pm},{09/05/2005})
Go Top In "MyTable"
Endproc
Procedure Unload
On Shutdown
Clear Events
Endproc
Procedure Refresh()
Local blnfirst, blnsecond
blnfirst = Recno("MyTable") != 1
blnsecond = Reccount("MyTable") != Recno("MyTable")
This.command1.Enabled = blnfirst
This.command2.Enabled = blnfirst
This.command3.Enabled = blnsecond
This.command4.Enabled = blnsecond
Endproc
Procedure command2.Click
Skip -1 In "MyTable"
Thisform. Refresh()
Endproc
Procedure command3.Click
Skip 1 In "MyTable"
Thisform. Refresh()
Endproc
Procedure command1.Click
Go Top In "MyTable"
Thisform. Refresh()
Endproc
Procedure command4.Click
Go Bottom In "MyTable"
Thisform. Refresh()
Endproc
Enddefine
Define Class clsdatetime As Control
Width = 191
Height = 24
BackStyle = 0
SpecialEffect = 1
TabStop = .T.
BackColor = Rgb(255,255,255)
Name = "clsdatetime"
Value = .F.
ControlSource = .F.
Add Object txtdatetime As clshiddendt With ;
ControlSource = "MyTable.dValue", ;
Height = 16, ;
Left = 78, ;
Top = 4, ;
Visible = .F., ;
Width = 14, ;
Name = "txtDatetime"
Add Object spntime As Spinner With ;
BorderStyle = 0, ;
Height = 22, ;
KeyboardHighValue = 1, ;
KeyboardLowValue = -1, ;
Left = 172, ;
SpinnerHighValue = 1.00, ;
SpinnerLowValue = -1.00, ;
TabIndex = 4, ;
TabStop = .F., ;
Top = 1, ;
Width = 19, ;
Name = "spnTime"
Add Object txtdate As TextBox With ;
StrictDateEntry = 1, ;
Alignment = 3, ;
BorderStyle = 0, ;
Value = {}, ;
Height = 21, ;
Left = 1, ;
Margin = 3, ;
SpecialEffect = 1, ;
TabIndex = 1, ;
Top = 1, ;
Width = 73, ;
BackColor = Rgb(255,255,255), ;
Name = "txtDate"
Add Object cmdcalendar As CommandButton With ;
Top = 1, ;
Left = 73, ;
Height = 22, ;
Width = 24, ;
Picture = Home() + "Graphics\Bitmaps\Assorted\CALENDAR.BMP", ;
Caption = "", ;
TabIndex = 2, ;
TabStop = .F., ;
Name = "cmdCalendar"
Add Object txttime As TextBox With ;
StrictDateEntry = 1, ;
Alignment = 0, ;
BorderStyle = 0, ;
Format = "", ;
Height = 21, ;
HideSelection = .F., ;
InputMask = "##:##:## AA", ;
Left = 96, ;
Margin = 3, ;
SpecialEffect = 1, ;
TabIndex = 3, ;
Top = 1, ;
Width = 77, ;
IMEMode = 0, ;
Name = "txtTime"
Procedure validtime
Parameter ctime
Private noccurs, nval, cval
ctime = Upper(ctime)
noccurs = Occurs(":", ctime)
nval = Val(Left(ctime, 2))
If !Between(nval, 1, 12)
ctime = Stuff(ctime,1,2,"12")
Else
ctime = Stuff(ctime, 1, 2, Right("0" + Alltrim(Str(nval)), 2))
Endif
nval = Val(Substr(ctime,4,2))
If !Between(nval, 0, 59)
ctime = Stuff(ctime,4,2,"00")
Else
ctime = Stuff(ctime, 4, 2, Right("0" + Alltrim(Str(nval)), 2))
Endif
Do Case
Case noccurs = 1 &&Seconds not shown handle AM/PM only
cval = Substr(ctime,7, 1)
If cval $ "AP"
ctime = Stuff(ctime,7,2,cval+"M")
Else
ctime = Stuff(ctime,7,2,"AM")
Endif
Case noccurs = 2 &&Handle seconds and AM/PM
nval = Val(Substr(ctime,7,2))
If !Between(nval, 0, 59)
ctime = Stuff(ctime,7,2,"00")
Else
ctime = Stuff(ctime, 7, 2, Right("0" + Alltrim(Str(nval)), 2))
Endif
cval = Substr(ctime,10, 1)
If cval $ "AP"
ctime = Stuff(ctime,10,2,cval+"M")
Else
ctime = Stuff(ctime,10,2,"AM")
Endif
Endcase
Return (ctime)
Endproc
Procedure value_access
Return This.txtdatetime.Value
Endproc
Procedure value_assign
Lparameters vnewval
This.txtdatetime.Value = m.vnewval
Endproc
Procedure controlsource_access
*To do: Modify this routine for the Access method
Return This.ControlSource
Endproc
Procedure controlsource_assign
Lparameters vnewval
*To do: Modify this routine for the Assign method
This.ControlSource = m.vnewval
Endproc
Procedure parsedatetime
Local cdatetime, ddatetime
ddatetime = Iif(Type("this.txtdatetime.value") = "T", This.txtdatetime.Value, Dtot(This.txtdatetime.Value))
cdatetime = Ttoc(ddatetime)
If Empty(Ttod(ddatetime))
This.txtdate.Value = {}
If Occurs(":",cdatetime) > 1
This.txttime.Value = " : : AM"
Else
This.txttime.Value = " : AM"
Endif
Else
This.txtdate.Value = Ttod(ddatetime)
This.txttime.Value = Ttoc(ddatetime,2)
Endif
This.txtdate.Refresh()
This.txttime.Refresh()
Endproc
Procedure savedatetime
This.txtdatetime.Value = Ctot(Dtoc(This.txtdate.Value) + Space(1) + This.txttime.Value)
Endproc
Procedure poscalendar
Lparameters localendar
With localendar
If Thisform.WindowType = 0 && Host form is Modeless
.Top = Objtoclient( This, 1 ) + Sysmetric(9) + This.txtdate.Height + ;
IIF( Thisform.BorderStyle = 3, Sysmetric(4), Sysmetric(13) ) + ;
IIF( Thisform.ShowWindow = 2, Thisform.Top, Objtoclient( Thisform, 1 ) ) + 3 && if there is a menu: + SYSMETRIC(20)
.Left = Objtoclient( This, 2 ) + Iif( Thisform.BorderStyle = 3, Sysmetric(3), Sysmetric(12) ) + ;
IIF( Thisform.ShowWindow = 2, Thisform.Left, Objtoclient( Thisform, 2 ) )
If ( ( .Top + .Height ) > Sysmetric(2) ) && Adjust to "drop up" if
.Top = .Top - .Height - This.txtdate.Height - ( 2 * Sysmetric(13) ) && near bottom of screen
Endif
Else && Host form is Modal
.Top = Objtoclient( This, 1 ) + This.txtdate.Height + Sysmetric(9) + ;
IIF( Thisform.BorderStyle = 3, Sysmetric(4), Sysmetric(13) ) + ;
THISFORM.Top + 3 && if there is a menu: + SYSMETRIC(20)
.Left = Objtoclient( This, 2 ) + Iif( Thisform.BorderStyle = 3, Sysmetric(3), Sysmetric(12) ) + ;
THISFORM.Left
If ( ( .Top + .Height ) > _vfp.Height ) && Adjust to "drop up" if
.Top = .Top - .Height - This.txtdate.Height - ( 2 * Sysmetric(13) ) && near bottom of screen
Endif
Endif
Do Case && Shift horizontal position if close to right edge
Case .ShowWindow = 0 && In Screen
If .Left + .Width > _vfp.Width
.Left = 4 + .Left - .Width + This.txtdate.Width - 2 * Sysmetric(3)
Endif
Case .ShowWindow = 1 && In Top-Level Form
If .Left + .Width > Thisform.Width
.Left = 4 + .Left - .Width + This.txtdate.Width - 2 * Sysmetric(3)
Endif
Case .ShowWindow = 2 && Top-Level Form
If .Left + .Width > Sysmetric(1)
.Left = 4 + .Left - .Width + This.txtdate.Width - 2 * Sysmetric(3)
Endif
Endcase
Endwith
Endproc
Procedure Init
If !Empty(This.ControlSource)
This.txtdatetime.ControlSource = This.ControlSource
Else
This.txtdatetime.Value = {/:}
Endif
Endproc
Procedure Refresh
This.txtdatetime.Refresh()
This.txtdatetime.Value = This.txtdatetime.Value
Endproc
Procedure txtdatetime.value_assign
Lparameters vnewval
If DoDefault(vnewval)
This.Parent.parsedatetime()
Endif
Endproc
Procedure spntime.InteractiveChange
Local namount
If Set("seconds") = "ON"
namount = This.Value
Else
namount = (This.Value * 60)
Endif
This.Parent.txtdatetime.Value = This.Parent.txtdatetime.Value + namount
This.Value = 0
Endproc
Procedure txtdate.LostFocus
This.Parent.savedatetime()
Endproc
Procedure cmdcalendar.Click
Local dholddate
Public dselecteddate, ocalendar
If Empty(This.Parent.txtdate.Value)
dselecteddate = Date()
Else
dselecteddate = This.Parent.txtdate.Value
Endif
dholddate = dselecteddate
ocalendar = Createobject("clsCalendar",dselecteddate)
This.Parent.poscalendar(ocalendar)
ocalendar.Visible = .T.
Read Events
If dholddate != dselecteddate
With This.Parent
.txtdate.Value = dselecteddate
.txtdate.Refresh()
. Savedatetime()
Endwith
Endif
ocalendar = Null
Release dselecteddate, ocalendar
Endproc
Procedure txttime.LostFocus
This.Value = This.Parent.validtime(This.Value)
This.Refresh()
This.Parent.savedatetime()
Endproc
Procedure txttime.Init
If Set("Seconds") = "ON"
This.InputMask = "##:##:## AM"
Else
This.InputMask = "##:## AM"
Endif
Endproc
Enddefine
Define Class clsdate As Control
Width = 98
Height = 24
BackStyle = 0
SpecialEffect = 1
TabStop = .T.
BackColor = Rgb(255,255,255)
Name = "clsdate"
Value = .F.
ControlSource = .F.
Add Object txtdate As TextBox With ;
StrictDateEntry = 1, ;
Alignment = 3, ;
BorderStyle = 0, ;
Value = {}, ;
Height = 21, ;
Left = 1, ;
Margin = 3, ;
SpecialEffect = 1, ;
TabIndex = 1, ;
Top = 1, ;
Width = 73, ;
BackColor = Rgb(255,255,255), ;
Name = "txtDate"
Add Object cmdcalendar As CommandButton With ;
Top = 1, ;
Left = 73, ;
Height = 22, ;
Width = 24, ;
Picture = Home() + "Graphics\Bitmaps\Assorted\CALENDAR.BMP", ;
Caption = "", ;
TabIndex = 2, ;
TabStop = .F., ;
Name = "cmdCalendar"
Procedure value_access
Return This.txtdate.Value
Endproc
Procedure value_assign
Lparameters vnewval
This.txtdate.Value = m.vnewval
Endproc
Procedure controlsource_access
*To do: Modify this routine for the Access method
Return This.ControlSource
Endproc
Procedure controlsource_assign
Lparameters vnewval
*To do: Modify this routine for the Assign method
This.ControlSource = m.vnewval
Endproc
Procedure poscalendar
Lparameters localendar
With localendar
If Thisform.WindowType = 0 && Host form is Modeless
.Top = Objtoclient( This, 1 ) + Sysmetric(9) + This.txtdate.Height + ;
IIF( Thisform.BorderStyle = 3, Sysmetric(4), Sysmetric(13) ) + ;
IIF( Thisform.ShowWindow = 2, Thisform.Top, Objtoclient( Thisform, 1 ) ) + 3 && if there is a menu: + SYSMETRIC(20)
.Left = Objtoclient( This, 2 ) + Iif( Thisform.BorderStyle = 3, Sysmetric(3), Sysmetric(12) ) + ;
IIF( Thisform.ShowWindow = 2, Thisform.Left, Objtoclient( Thisform, 2 ) )
If ( ( .Top + .Height ) > Sysmetric(2) ) && Adjust to "drop up" if
.Top = .Top - .Height - This.txtdate.Height - ( 2 * Sysmetric(13) ) && near bottom of screen
Endif
Else && Host form is Modal
.Top = Objtoclient( This, 1 ) + This.txtdate.Height + Sysmetric(9) + ;
IIF( Thisform.BorderStyle = 3, Sysmetric(4), Sysmetric(13) ) + ;
THISFORM.Top + 3 && if there is a menu: + SYSMETRIC(20)
.Left = Objtoclient( This, 2 ) + Iif( Thisform.BorderStyle = 3, Sysmetric(3), Sysmetric(12) ) + ;
THISFORM.Left
If ( ( .Top + .Height ) > _vfp.Height ) && Adjust to "drop up" if
.Top = .Top - .Height - This.txtdate.Height - ( 2 * Sysmetric(13) ) && near bottom of screen
Endif
Endif
Do Case && Shift horizontal position if close to right edge
Case .ShowWindow = 0 && In Screen
If .Left + .Width > _vfp.Width
.Left = 4 + .Left - .Width + This.txtdate.Width - 2 * Sysmetric(3)
Endif
Case .ShowWindow = 1 && In Top-Level Form
If .Left + .Width > Thisform.Width
.Left = 4 + .Left - .Width + This.txtdate.Width - 2 * Sysmetric(3)
Endif
Case .ShowWindow = 2 && Top-Level Form
If .Left + .Width > Sysmetric(1)
.Left = 4 + .Left - .Width + This.txtdate.Width - 2 * Sysmetric(3)
Endif
Endcase
Endwith
Endproc
Procedure Init
If !Empty(This.ControlSource)
This.txtdate.ControlSource = This.ControlSource
Else
This.txtdate.Value = {}
Endif
Endproc
Procedure Refresh
This.txtdate.Refresh()
Endproc
Procedure cmdcalendar.Click
Local dholddate
Public dselecteddate, ocalendar
If Empty(This.Parent.txtdate.Value)
dselecteddate = Date()
Else
dselecteddate = This.Parent.txtdate.Value
Endif
dholddate = dselecteddate
ocalendar = Createobject("clsCalendar",dselecteddate)
This.Parent.poscalendar(ocalendar)
ocalendar.Visible = .T.
Read Events
If dholddate != dselecteddate
With This.Parent
.txtdate.Value = dselecteddate
.txtdate.Refresh()
Endwith
Endif
ocalendar = Null
Release dselecteddate, ocalendar
Endproc
Enddefine
Define Class clshiddendt As TextBox
Alignment = 3
BackStyle = 1
BorderStyle = 0
Value = ""
Height = 23
Visible = .F.
Width = 100
Name = "clshiddendt"
Procedure value_access
*To do: Modify this routine for the Access method
Return This.Value
Endproc
Procedure value_assign
Lparameters vnewval
*To do: Modify this routine for the Assign method
This.Value = m.vnewval
Endproc
Procedure Init
*!* IF EMPTY(this.ControlSource)
*!* this.Value = {/:}
*!* ENDIF
Endproc
Enddefine
Define Class clscalendar As Form
Top = 0
Left = 0
Height = 177
Width = 194
Desktop = .T.
ShowWindow = 2
ShowInTaskbar = .F.
DoCreate = .T.
ShowTips = .T.
BorderStyle = 1
Caption = ""
ControlBox = .F.
Closable = .F.
TitleBar = 0
AlwaysOnTop = .T.
BackColor = Rgb(255,255,255)
ContinuousScroll = .F.
Name = "clscalendar"
Add Object olecontrol1 As OleControl With ;
Top = 0, ;
Left = 0, ;
Height = 100, ;
Width = 100, ;
appearance = 0, ;
Name = "Olecontrol1", ;
OleClass = "MSComCtl2.MonthView.2"
Procedure Deactivate
Clear Events
Endproc
Procedure Init
Lparameters ldate
With This.olecontrol1
.Day = Day(ldate)
.Month = Month(ldate)
.Year = Year(ldate)
.Width = This.Width
.Height = This.Height
Endwith
Endproc
Procedure olecontrol1.dateclick
Lparameters dateclicked
dselecteddate = Ttod(m.dateclicked)
Clear Events
Endproc
Enddefine
Fijate en la web http://www.davphantom.net tiene una ayuda para descargar sobre el uso de monthview y demas controles.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas