Better Date\Datetime Controls

[Ed Andres]

I am trying to implement the solution from

Better Date\Datetime Controls
faq184-3913

and am having a little trouble. The problem is that during runtime, the calendar just flashes up and then disappears. In the development environment, it works flawlessly. I'm thinking it is something obvious that I am just overlooking. Here is the code from the classes. Any help is appreciated - I'd really like to use this solution.

**************************************************
*-- Class: clsdate (c:\cts_service\libs\cts_service_app.vcx)
*-- ParentClass: control
*-- BaseClass: control
*-- Time Stamp: 08/05/08 07:35:10 AM
*
DEFINE CLASS clsdate AS control


Width = 98
Height = 24
BackStyle = 0
SpecialEffect = 1
BackColor = RGB(255,255,255)
*-- Specifies the source of data to which an object is bound.
controlsource = .F.
*-- Specifies the current state of a control.
value = .F.
Name = "clsdate"


ADD OBJECT txtdate AS textbox WITH ;
Alignment = 3, ;
BorderStyle = 0, ;
Value = {}, ;
Height = 21, ;
Left = 1, ;
Margin = 3, ;
SpecialEffect = 1, ;
Top = 1, ;
Width = 73, ;
NullDisplay = " ", ;
Name = "txtDate"


ADD OBJECT cmdcalendar AS commandbutton WITH ;
Top = 1, ;
Left = 73, ;
Height = 22, ;
Width = 24, ;
Picture = "..\..\vfp9\graphics\bitmaps\assorted\calendar.bmp", ;
Caption = "", ;
TabStop = .F., ;
Name = "cmdCalendar"


PROCEDURE value_access
*To do: Modify this routine for the Access method
RETURN THIS.txtDate.Value
ENDPROC


PROCEDURE value_assign
LPARAMETERS vNewVal
*To do: Modify this routine for the Assign method
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 Refresh
this.txtDate.Refresh()
ENDPROC


PROCEDURE Init
IF !EMPTY(this.controlsource)
this.txtDate.ControlSource = this.controlsource
ELSE
this.txtDate.value = {}
ENDIF
ENDPROC


PROCEDURE cmdcalendar.Click
LOCAL ldHoldDate
Public gdSelectedDate, goCalendar
IF EMPTY(this.Parent.txtDate.value) .OR. ISNULL(this.Parent.txtDate.value)
gdSelectedDate = DATE()
ELSE
gdSelectedDate = this.Parent.txtDate.value
ENDIF
ldHoldDate = gdSelectedDate
goCalendar = NewObject([clsCalendar],[\libs\cts_service_app],"",gdSelectedDate)
***goCalendar = CREATEOBJECT("clsCalendar",gdSelectedDate)
this.Parent.PosCalendar(goCalendar)
goCalendar.visible = .t.
READ EVENTS
IF ldHoldDate != gdSelectedDate
WITH this.parent
.txtDate.Value = gdSelectedDate
.txtDate.refresh()
ENDWITH
ENDIF
goCalendar = NULL
RELEASE gdSelectedDate, goCalendar
ENDPROC


ENDDEFINE
*
*-- EndDefine: clsdate
**************************************************


**************************************************
*-- Class: clscalendar (c:\cts_service\libs\cts_service_app.vcx)
*-- ParentClass: form
*-- BaseClass: form
*-- Time Stamp: 08/07/08 01:45:13 PM
*
DEFINE CLASS clscalendar AS form


Top = 0
Left = 0
Height = 177
Width = 194
ShowWindow = 2
ShowInTaskBar = .F.
DoCreate = .T.
ShowTips = .T.
BorderStyle = 1
Caption = " "
ControlBox = .F.
Closable = .F.
TitleBar = 0
WindowType = 1
AlwaysOnTop = .T.
BackColor = RGB(255,255,255)
ContinuousScroll = .F.
Themes = .F.
Name = "clscalendar"


ADD OBJECT olecontrol1 AS olecontrol WITH ;
Top = 0, ;
Left = 0, ;
Height = 100, ;
Width = 100, ;
Name = "Olecontrol1"


PROCEDURE Deactivate
CLEAR EVENTS
ENDPROC


PROCEDURE Init
LPARAMETERS tlDate
WITH this.olecontrol1
.day = DAY(tlDate)
.month = MONTH(tlDate)
.year = YEAR(tlDate)
.Width = this.Width
.height = this.height
ENDWITH
ENDPROC


PROCEDURE olecontrol1.DATECLICK
*** ActiveX Control Event ***
LPARAMETERS ttdateclicked
gdSelectedDate = TTOD(ttdateclicked)
CLEAR EVENTS
ENDPROC


ENDDEFINE
*
*-- EndDefine: clscalendar
**************************************************


Ed

 

[bborissov]

Remove CLEAR EVENTS from everywhere!

Borislav Borissov
VFP9 SP2, SQL Server 2000/2005.

 

[Ed Andres]

Removing the CLEAR EVENTS from

PROCEDURE olecontrol1.DATECLICK
*** ActiveX Control Event ***
LPARAMETERS ttdateclicked
gdSelectedDate = TTOD(ttdateclicked)
CLEAR EVENTS
ENDPROC

Will never let the form unload - even so, running it without the CLEAR EVENTS still does not show the form, it just flashes.

BTW - Thanks for the quick response.

Ed

 

[Dan Freeman]

Borislav is right. You shouldn't have clear events anywhere in the code?

How are you calling this form? Your description of "flashing" makes it sound like this is the only form running in an exe and you don't have a READ EVENTS.

 

[Ed Andres]

This is the code to create the form from the cmdcalendar.Click procedure


goCalendar = NewObject([clsCalendar],[\libs\cts_service_app],"",gdSelectedDate)
***goCalendar = CREATEOBJECT("clsCalendar",gdSelectedDate)
this.Parent.PosCalendar(goCalendar)
goCalendar.visible = .t.
READ EVENTS

There is your READ EVENTS


Ed

 

[TamarGranor]

Is goCalendar a form or a control? If it's a form, replace the line:

goCalendar.Visible = .T.

with:

goCalendar.Show()

If it's a control, then you shouldn't have READ EVENTS at this point. It should already be in effect.

Tamar

 

[Ed Andres]

goCalendar is a form and I changed the code to goCalendar.Show() and I get the same behavior - Works fine in the dev environment but just flashes in the run-time. This is really perplexing but I appreciate everyone's great suggestions.


Ed

 

[Mike Lewis]

Ed,

Have you declared goCalendar as public, private or local? From its name, it looks like it's meant to be public, but that is only the case if you have declared it using the PUBLIC keyword.

If goCalendar is local, the form will disappear as soon as it goes out of scope, that is, at the end of the routine in which you run the goCalendar = NEWOBJECT(.... code

To avoid that situation, make sure that goCalendar is indeed public. Alternatively, do goCalendar.Show(), as per Tamar's suggestion, but pass 1 as a parameter:

goCalendar.Show(1)

That will make the form modal, which means you will have to explicitly close it before it disappears.

Mike

__________________________________
Mike Lewis (Edinburgh, Scotland)

My Visual FoxPro site: www.ml-consult.co.uk

 

[Ed Andres]

goCalendar is declared PUBLIC in the cmdcalendar.Click procedure. I even tried goCalendar.Show(1) and still no good.


Ed

 

[Ed Andres]

Ok, so I actually created a from exactly like the class and put it in my project only changing a couple things. I made it modal and instead of the CLEAR EVENTS in the DATECLICK, I have a thisform.release.

In the control class I changed a few lines in the cmdcalendar.Click procedure as follows:

***goCalendar = NewObject([clsCalendar],[\libs\cts_service_app],"",gdSelectedDate)
**goCalendar = CREATEOBJECT("clsCalendar",gdSelectedDate)
**this.Parent.PosCalendar(goCalendar)
**goCalendar.show(1)
**READ EVENTS
DO FORM clscalendar.scx WITH gdSelectedDate

This works fine in both environments however, I cannot position the clscalendar form.

Ed