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 Respuesta

Respuesta
1
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

Llevar datos de un grid a un formulario para modificarlos

Estoy aprendiendo a programar en foxpro 9 y tengo la siguiente duda:Tengo un grid que muestra la tabla cliente, a la cual esta conectada. Lo que quisiera hacer es:en el evento doble click sobre cualquiera de los clientes mostrados en el grid, este me...
2 respuestas

¿Cómo guardar un archivo PDF?

Tengo un formulario que piede cedula del cliente dirección y un documento a guardar en la DBF que es un examen en archivo PDF Como grabo el la tabla ese archivo, de manera que cuando consulte por cedeula A) Pueda abrir el archivo PDF en pantalla B)...
2 respuestas

Añadir registro a un grid que contiene datos pero en cualquier parte del grid

Tengo un form que tiene varios text y un grid el cual esta relacionado con una tabla y le voy agregando registro mediante un click en un botón . Hasta ahí todo de lujo ! El problema es que el usuario quiere agregar un registro en cualquier parte del...
4 respuestas

Sumar columna de un grid

Pues yo nuevamente. Como hago para sumar toda la columna de un grid Ejemplo Grid: Cantidad Precio Total 100 10 1,000 50 10 500 Total 1,500
3 respuestas

Capturar Imagen y Grabarlo en Vfp

Estimado amigo de nuevo molestándote esta vez quisiera que ayudes a realizar lo siguiente se desea que al momento que el personal digite su código de ingreso, en pantalla le visualice y a la vez grabe en una tabla sus Nombres, hora que marco y foto...
4 respuestas

Como agrupar registros

¿Quisiera saber como agrupar registro y sumarlos a lva ves que los veo en un reporte? Ejemplo Tengo una tabla llamada PEDIDOS en la cual almaceno los pedidos de las rutas para el día siguiente Ruta articulo cantidad fecha 1 2-02 11 21/02/11 1 3-02 2...
2 respuestas

Comparación de Huellas Digitales

Quería saber si me pueden pasar un ejemplo de comparación de huellas digitales con Digital Persona U.are.U 4000 Estuve viendo en esta misma pagina que había alguien que hablaba sobre esto. Pero no se completo el tema. Solo necesito un ejemplo de...
2 respuestas

Ayuda para poder manipula lector de huellas

Necesito ayuda con respecto a como poder controlar un lector de huellas digital (microsoft fingerprint reader), puesto que se me ha requerido crear un proyecto que permita controlar entradas y salidas de personal utilizando un lector de huellas...
2 respuestas

Necesito un form de punto de ventas en VFP

Necesito crear un formulario para que sea un punto de ventas y todavía no se como arrancar dicho proyecto... Quisiera me puedan ayudar.
3 respuestas

Calculo de rfc y curp

Me pidieron hacer un programa en visual para calcular el rfc y curp con su homoclave, del personal de mi empresa, ¿Podrías decirme donde conseguirlo o en su caso darme una copia del código fuente pra hacerlo?
4 respuestas