Date time picker activex control in VFP6

[IanWh]

Hi.

I'm using the Microsoft Date Time Picker control on a form in my vfp6 project. It's an olecontrol and the oleclass is MsComCtl2.DtPicker.2

It works fine - and I've used in plenty of times - but I don't seem to be able to get it to change the contents of a field in a table. When i set the control source, the control displays the correct date (or time if in that mode) but when I change the date or time, even though it displays the new date/time, when I go back to the table the changes have not been made. I know I can write some code in the object 'change' event to write this stuff back to the field - but shouldn't it do that for me?
Can't find any help, or see of anyone else having this problem. Anybody have an answer?

Thanks
Ian.

 

[Leland123]

Hi,

You might try something like:


***** datedbclick() Event of _olecalander1 *********
*******
*BOF
*******

*** ActiveX Control Event ***
LPARAMETERS datedblclicked

the_date=STR(this.month,2,0)+"/"+STR(this.day,2,0)+"/"+STR(this.year,4,0) && make sure US date

thisform.the_control_name.value=CTOD(the_date)

return

**********
*eof
********** Leland F. Jackson, CPA
Software - Master (TM)

https://www.smvfp.com

Nothing Runs Like the Fox

 

[wgcs]

Remember that the ActiveX controls were not designed Just for VFP, so VFP isn't guaranteed to work perfectly with them (though with VFP6, things have gotten pretty smooth).

I created a wrapper for the DTPicker that makes sure the VFP field/property does get updated as the picker is changed.

**************************************************
*-- Class:        aasdatepicker (c:\source\aas.vcx)
*-- ParentClass:  olecontrol
*-- BaseClass:    olecontrol
*-- Time Stamp:   03/08/01 08:18:00 PM
*-- OLEObject = C:\WINNT\system32\MSCOMCT2.OCX
*
DEFINE CLASS aasdatepicker AS olecontrol


	Height = 22
	Width = 188
	Visible = .T.
	afhoffset = 0
	atoffset = 0
	aloffset = 0
	ahoffset = 0
	awoffset = 0
	autoresizetop = .T.
	autoresizeleft = .T.
	autoresizewidth = .T.
	autoresizeheight = .T.
	afteststr = "''"
	autoresizefont = .T.
	lformanychange = .T.
	vfpcontrolsource = ('')
	realforecolor = 0
	afwoffset = 0
	Name = "aasdatepicker"

	*-- Pass-Through to THIS.OBJECT.Font.Size
	fontsize = .F.

	*-- FontName -- C -- Pass through to THIS.Object.Font.Name
	fontname = .F.

	*-- FontBold -- L -- Pass through to THIS.Object.Font.Bold
	fontbold = .F.

	*-- FontItalic -- C -- Pass through to THIS.Object.Font.Italic
	fontitalic = .F.

	*-- FontUnderline -- C -- Pass through to THIS.Object.Font.Underline
	fontunderline = .F.


	PROCEDURE anychange
		if THIS.lFormAnyChange
		  THISFORM.AnyChange
		endif
		RETURN
		    
		    
		    
		    
		    
	ENDPROC


	PROTECTED PROCEDURE fontsize_access
		RETURN val(str(THIS.Object.Font.Size,10,5))
	ENDPROC


	PROTECTED PROCEDURE fontsize_assign
		LPARAMETERS vNewVal
		THIS.FontSize         = m.vNewVal
		THIS.Object.Font.Size = m.vNewVal
	ENDPROC


	PROTECTED PROCEDURE fontname_access
		RETURN THIS.Object.Font.Name
	ENDPROC


	PROTECTED PROCEDURE fontname_assign
		LPARAMETERS vNewVal
		THIS.FontName = m.vNewVal
		THIS.Object.Font.Name = m.vNewVal
	ENDPROC


	PROTECTED PROCEDURE fontbold_access
		RETURN THIS.Object.Font.Bold
	ENDPROC


	PROTECTED PROCEDURE fontbold_assign
		LPARAMETERS vNewVal
		THIS.FontBold = m.vNewVal
		THIS.Object.Font.Bold = m.vNewVal
	ENDPROC


	PROTECTED PROCEDURE fontitalic_access
		RETURN THIS.Object.Font.Italic
	ENDPROC


	PROTECTED PROCEDURE fontitalic_assign
		LPARAMETERS vNewVal
		THIS.FontItalic = m.vNewVal
		THIS.Object.Font.Italic = m.vNewVal
	ENDPROC


	PROTECTED PROCEDURE fontunderline_access
		RETURN THIS.Object.Font.Underline
	ENDPROC


	PROTECTED PROCEDURE fontunderline_assign
		LPARAMETERS vNewVal
		THIS.FontUnderline = m.vNewVal
		THIS.Object.Font.Underline = m.vNewVal
	ENDPROC


	PROCEDURE KeyPress
		*** ActiveX Control Event ***
		LPARAMETERS KeyAscii
		LOCAL ldNewDate, lnDay, lnMon, lnYr, ldDate, nKeyCode
		nKeyCode = KeyAscii
		ldDate = THIS.Object.Value
		if VarType(ldDate)='T'
		  ldDate = TTOD(ldDate)
		endif
		WAIT WINDOW NOWAIT str(nKeyCode)
		do case
		  case InList(nKeyCode,43,61) && +,=
		    KeyAscii = 0
		    NODEFAULT
		    THIS.object.Value = iif( empty(ldDate), Date(), ldDate+1 )
		    THIS.Change()
		    THIS.Refresh()
		    
		  case inList(nKeyCode,95,45) && -
		    KeyAscii = 0
		    NODEFAULT
		    THIS.object.Value = iif( empty(ldDate), Date(), ldDate-1 )
		    THIS.Change()
		    THIS.Refresh()
		    
		  * Inc/Dec by Month
		  case    Inlist(nKeyCode,91,123,93,125) && [ and ] key
		    KeyAscii = 0
		    NODEFAULT
		    if empty(ldDate) or isNull(ldDate)
		      ldNewDate = Date()
		    else
		      lnDay = Day(   ldDate )
		      lnMon = Month( ldDate )
		      lnYr  = Year(  ldDate )
		      if inList(nKeyCode,93,125) && ] key
		        if lnMon=12
		          lnMon = 1
		          lnYr  = lnYr+1
		        else
		          lnMon = lnMon + 1
		        endif
		      else && nKeyCode=91,123 && [ key
		        if lnMon=1
		          lnMon = 12
		          lnYr  = lnYr-1
		        else
		          lnMon = lnMon - 1
		        endif
		      endif
		      * Take care of days # 29,30,31 for months that are shorter
		      do while (lnDay > 28) ;
		               and Date(lnYr,lnMon,lnDay)={}
		        lnDay = lnDay - 1
		      enddo
		      ldNewDate = Date(lnYr,lnMon,lnDay)
		    endif
		    if type('ldNewDate')='D' and ldNewDate<>{}
		      THIS.object.Value = ldNewDate
		    endif
		    THIS.Change()
		    THIS.Refresh()

		  * Inc/Dec by Year
		  case    nKeyCode=123 ;
		       or nKeyCode=125 && { and } key
		    KeyAscii = 0
		    NODEFAULT
		    if empty(ldDate) or Isnull(ldDate)
		      ldNewDate = Date()
		    else
		      lnDay = Day(   ldDate )
		      lnMon = Month( ldDate )
		      lnYr  = Year(  ldDate )
		      if nKeyCode=125 && } key
		        lnYr  = lnYr+1
		      else && nKeyCode=123 && { key
		        lnYr  = lnYr-1
		      endif
		      * Take care of days # 29,30,31 for months that are shorter
		      do while (lnDay > 28) ;
		               and Date(lnYr,lnMon,lnDay)={}
		        lnDay = lnDay - 1
		      enddo
		      ldNewDate = Date(lnYr,lnMon,lnDay)
		    endif
		    if type('ldNewDate')='D' and ldNewDate<>{}
		      THIS.object.Value = ldNewDate
		    endif
		    THIS.Refresh()
		    THIS.Change()
		endcase
		  
		RETURN
		      
	ENDPROC


	PROCEDURE Init
		THIS.RealForeColor = THIS.CalendarForeColor
		RETURN
		    
		    
		    
		    
		    
	ENDPROC


	PROCEDURE Refresh
		*** ActiveX Control Method ***
		if type(THIS.vfpControlSource)='D'
		  if eval(THIS.vfpControlSource)={}
		    THIS.Object.Value = DATE()  && GTWv9.34.5 wgcs
		    THIS.Object.Value = .NULL.
		  else
		    THIS.Object.Value = eval(THIS.vfpControlSource)
		  endif
		endif
	ENDPROC


	PROCEDURE Change
		*** ActiveX Control Event ***
		if IsNull(THIS.Object.Value)
		  THISFORM.UpdateValue(THIS.vfpControlSource,{},THIS)
		  THIS.CalendarForeColor = THIS.CalendarBackColor
		else
		*v9.34   THISFORM.UpdateValue(THIS.vfpControlSource,THIS.Object.Value,THIS)
		  *GTv9.34..Make sure we return a DATE type
		  THISFORM.UpdateValue(THIS.vfpControlSource,TToD(THIS.Object.Value),THIS)
		  THIS.CalendarForeColor = THIS.RealForeColor
		endif
		THIS.AnyChange
		RETURN

		*TTv9.34 LOCAL lcVar, llMem
		*TTv9.34 lcVar = Upper(THIS.vfpControlSource)
		*TTv9.34 if type(lcVar)='D'
		*TTv9.34   if not '.' $ lcVar or ;
		*TTv9.34      Left(lcVar,2)='M.' or ;
		*TTv9.34      Left(lcVar,5)='THIS.' or ;
		*TTv9.34      Left(lcVar,9)='THISFORM.' 
		*TTv9.34     llMem = .T.
		*TTv9.34   else
		*TTv9.34     llMem = .F.
		*TTv9.34   endif
		*TTv9.34   if IsNull(THIS.Object.Value)
		*TTv9.34     if llMem
		*TTv9.34       &lcVar = {}
		*TTv9.34     else
		*TTv9.34       REPLACE &lcVar with {}
		*TTv9.34     endif
		*TTv9.34     THIS.CalendarForeColor = THIS.CalendarBackColor
		*TTv9.34   else
		*TTv9.34     if llMem
		*TTv9.34       &lcVar = THIS.Object.Value
		*TTv9.34     else
		*TTv9.34       REPLACE &lcVar with THIS.Object.Value
		*TTv9.34     endif
		*TTv9.34     THIS.CalendarForeColor = THIS.RealForeColor
		*TTv9.34   endif
		*TTv9.34 endif
		*TTv9.34 THIS.AnyChange
		*TTv9.34 RETURN
		    
		    
		    
		    
		    
	ENDPROC


	PROCEDURE Error
		LPARAMETERS nError, cMethod, nLine
		if nError=1429
		  * IGNORE
		*v9.24w   if THIS.CheckBox
		*v9.24w     THIS.Object.Value = .Null.
		*v9.24w   endif
		  RETURN
		else
		  PRIVATE pcClassError
		  pcClassError = 'ERROR'
		  lcErr = upper(On('ERROR'))
		  lcErr = StrTran(lcErr, 'ERROR()', 'nError')
		  lcErr = StrTran(lcErr, 'LINE()', 'nLine')
		  &lcErr
		  do case
		    case pcClassError='RETRY'
		      RETRY
		    case pcClassError='IGNORE'
		      RETURN
		  endcase
		  RETURN
		endif
		    
		    
		    
		    
		    
	ENDPROC


ENDDEFINE
*
*-- EndDefine: aasdatepicker
**************************************************

And, the Form's UpdateValue method is:

LPARAMETERS pcVarOrField, pvNewValue, poTHIS
LOCAL lnPos, lcAlias, lcField, lcProperty

lnPos = at('.', pcVarOrField)
lcAlias = upper( left(pcVarOrField, lnPos - 1) )

*TTv9.34..Object References take precedence over Aliases
if (lnPos > 0) and ;
   not (    lcAlias=='THISFORM' ;
         or lcAlias=='THIS'     ;
         or lcAlias=='M'        ;
         or TYPE(lcAlias) = 'O' )   && TTv9.34 wgcs..May be an object reference
  *TTv9.34..Added type equivalence checks and USED() check
  if used(lcAlias) and ; 
     ( ( type(pcVarOrField)=type('pvNewValue') ) ;
       or ( type(pcVarOrField)='M'  and type('pvNewValue')='C'  ) ;
       or ( type(pcVarOrField)$'DT' and type('pvNewValue')$'DT' ) ;
       or ( type(pcVarOrField)='Y'  and type('pvNewValue')='N'  ) ;
     ) && TTv9.34 wgcs
     
    *TTWv7.16w..Made this "IF" (value different) Seperate from above,
    *            some Alias.Field were falling into Else
    if not (pvNewValue == evaluate(pcVarOrField))
      lcField = substr(pcVarOrField, lnPos + 1)
      replace (lcField) with pvNewValue in (lcAlias)
    endif
  endif
else
  if lcAlias=='THIS'   && 7/22/99 wgcs..Resolve self reference  && GTv9.34.8 wgcs..changed "THIS." to "THIS"
    lcProperty = 'po'+pcVarOrField && 7/22/99 wgcs  && TTv9.34 wgcs
  else
    lcProperty = pcVarOrField
  endif
  &lcProperty = pvNewValue
endif

 

[IanWh]

Thanks for that. As I orginally suspected you are using the change event to write the value back to the field. Are we saying then that this defo doesn't work in vfp? If so I'll bite the bullet and implement a new class based on dtpicker as you have.

Just so long as I know I'm not losing it and this actually doesn't work!!

Thanks for you help
Ian