Datetime Class & Listbox Checkboxes 1

craigsboyd · Jul 19, 2003

I've added a couple more FAQs:

[ol][li]A Better Datetime Entry Control
faq184-3913

[/li][li]Simulating checkboxes in a listbox
faq184-3911[/li][/ol]

Slighthaze = NULL

[ul][li]FAQ184-2483
An excellent guide to getting a fast and accurate response to your questions in this forum.[/li][/ul]

darrellblackhawk · Jul 20, 2003

Hey SlightHaze:

I've been working on a calendar class for the same reason.

Here's the first draft:

[tt]
CLEAR
PRIVATE dVar
dVar = NULL
oForm = CREATEOBJECT("frmCalendar","dVar&quot

oForm.SHOW()
READ EVENTS
? dVar

DEFINE CLASS frmCalendar AS FORM
DOCREATE = .T.
AUTOCENTER = .T.
SCALEMODE = 3
MINBUTTON = .F.
MAXBUTTON = .F.
BORDERSTYLE = 2
CAPTION = "Non-ActiveX Calendar"
cVar = ""
dRetDate = DATE()

ADD OBJECT calendar AS calendar

PROCEDURE INIT
LPARAM lcIndirVar
THIS.cVar = lcIndirVar
THIS.HEIGHT = THIS.calendar.HEIGHT
THIS.WIDTH = THIS.calendar.WIDTH
ENDPROC

PROCEDURE DESTROY
THIS.dRetDate = THIS.Calendar.dCurDate
CLEAR EVENTS
ENDPROC

PROCEDURE UNLOAD
LOCAL lcIndirVar
lcIndirVar = THIS.cVar
&lcIndirVar = THIS.dRetDate
ENDPROC
ENDDEFINE

**************************************************
*-- Class: calendar (c:\dev\classes\vfp\dateclasses.vcx)
*-- ParentClass: container
*-- BaseClass: container
*-- Time Stamp: 07/20/03 12:54:04 AM
*
DEFINE CLASS calendar AS CONTAINER
WIDTH = 207
HEIGHT = 250
BACKSTYLE = 0
NAME = "calendar"
dcurdate = .F.

ADD OBJECT lblmonth AS LABEL WITH ;
AUTOSIZE = .T., ;
FONTSIZE = 12, ;
BACKSTYLE = 0, ;
CAPTION = "Month", ;
HEIGHT = 21, ;
LEFT = 36, ;
TOP = 2, ;
WIDTH = 44, ;
NAME = "lblMonth"

ADD OBJECT lblyear AS LABEL WITH ;
AUTOSIZE = .T., ;
FONTSIZE = 12, ;
BACKSTYLE = 0, ;
BORDERSTYLE = 0, ;
CAPTION = "Year", ;
HEIGHT = 21, ;
LEFT = 36, ;
TOP = 24, ;
WIDTH = 34, ;
BACKCOLOR = RGB(236,233,216), ;
NAME = "lblYear"

ADD OBJECT lblToday AS LABEL WITH ;
AUTOSIZE = .T., ;
FONTSIZE = 12, ;
BACKSTYLE = 0, ;
CAPTION = "Today", ;
HEIGHT = 21, ;
LEFT = 158, ;
TOP = 4, ;
WIDTH = 45, ;
NAME = "lblToday"

ADD OBJECT line1 AS LINE WITH ;
HEIGHT = 0, ;
LEFT = 0, ;
TOP = 84, ;
WIDTH = 204, ;
NAME = "Line1"

ADD OBJECT line2 AS LINE WITH ;
HEIGHT = 0, ;
LEFT = 0, ;
TOP = 108, ;
WIDTH = 204, ;
NAME = "Line2"

ADD OBJECT line3 AS LINE WITH ;
HEIGHT = 0, ;
LEFT = 0, ;
TOP = 220, ;
WIDTH = 204, ;
NAME = "Line3"

ADD OBJECT lblcurdate AS LABEL WITH ;
AUTOSIZE = .T., ;
FONTSIZE = 10, ;
BACKSTYLE = 0, ;
CAPTION = "Selected date shows here", ;
HEIGHT = 18, ;
LEFT = 5, ;
TOP = 226, ;
WIDTH = 152, ;
NAME = "lblCurDate"

ADD OBJECT lblmonrev AS LABEL WITH ;
AUTOSIZE = .F., ;
FONTBOLD = .T., ;
FONTNAME = "Arial Black", ;
ALIGNMENT = 2, ;
BACKSTYLE = 0, ;
BORDERSTYLE = 1, ;
CAPTION = "<", ;
HEIGHT = 17, ;
LEFT = 6, ;
TOP = 3, ;
WIDTH = 12, ;
NAME = "lblMonRev"

ADD OBJECT lblmonfwd AS LABEL WITH ;
AUTOSIZE = .F., ;
FONTBOLD = .T., ;
FONTNAME = "Arial Black", ;
ALIGNMENT = 2, ;
BACKSTYLE = 0, ;
BORDERSTYLE = 1, ;
CAPTION = ">", ;
HEIGHT = 17, ;
LEFT = 21, ;
TOP = 3, ;
WIDTH = 12, ;
NAME = "lblMonFwd"

ADD OBJECT lblyearrev AS LABEL WITH ;
AUTOSIZE = .F., ;
FONTBOLD = .T., ;
FONTNAME = "Arial Black", ;
ALIGNMENT = 2, ;
BACKSTYLE = 0, ;
BORDERSTYLE = 1, ;
CAPTION = "<", ;
HEIGHT = 17, ;
LEFT = 6, ;
TOP = 25, ;
WIDTH = 12, ;
NAME = "lblYearRev"

ADD OBJECT lblyearfwd AS LABEL WITH ;
AUTOSIZE = .F., ;
FONTBOLD = .T., ;
FONTNAME = "Arial Black", ;
ALIGNMENT = 2, ;
BACKSTYLE = 0, ;
BORDERSTYLE = 1, ;
CAPTION = ">", ;
HEIGHT = 17, ;
LEFT = 21, ;
TOP = 25, ;
WIDTH = 12, ;
NAME = "lblYearFwd"

PROCEDURE INIT
LOCAL i,j,k,lcLabel,o
LOCAL lnTop,lnLeft
#DEFINE MonTop 50
#DEFINE DowTop 88
#DEFINE DayTop 112
#DEFINE StartLeft 10
#DEFINE ColStep 28

lnTop = MonTop
lnLeft = StartLeft
k = 0

* Add Month labels
FOR i = 1 TO 12
lcLabel = "lblMon"+TRANSFORM(i)
THIS.ADDOBJECT(lcLabel,"monlabel",i)
o = "this."+lcLabel
o = &o
WITH o
.FONTNAME = "courier new"
.WIDTH = 24
.HEIGHT = 24
.ALIGNMENT = 1
.TOP = lnTop
.LEFT = lnLeft+1 && Nudge right to center
.VISIBLE = .T.
.BACKSTYLE = 0
.CAPTION = .PARENT.aMonths[ i ]
.AUTOSIZE = .T.
ENDWITH
IF i == 6
lnLeft = StartLeft
lnTop = lnTop + 16
ELSE
lnLeft = lnLeft + ColStep+4 && Increase spacing for month labels
ENDIF
NEXT

lnLeft = StartLeft
lnTop = DowTop

* Add Day of week labels
FOR i = 1 TO 7
lcLabel = "lblDOW"+TRANSFORM(i)
THIS.ADDOBJECT(lcLabel,"DayOfWeek&quot

o = "this."+lcLabel
o = &o
WITH o
.FONTNAME = "courier new"
.WIDTH = 24
.HEIGHT = 16
.ALIGNMENT = 2
.TOP = lnTop
.LEFT = lnLeft-2 && Nudge left to center over days
.VISIBLE = .T.
.BACKSTYLE = 0
.CAPTION = .PARENT.aDow[ i ]
ENDWITH
lnLeft = lnLeft + ColStep
NEXT

* Add Day of Month labels
lnLeft = StartLeft
lnTop = DayTop

FOR i = 1 TO 6
FOR j = 1 TO 7
lcLabel = "lblDay"+TRANSFORM(k)
THIS.ADDOBJECT(lcLabel,"calday&quot

o = "this."+lcLabel
o = &o
WITH o
.FONTNAME = "courier new"
.WIDTH = 16
.HEIGHT = 16
.ALIGNMENT = 1
.TOP = lnTop
.LEFT = lnLeft
.VISIBLE = .T.
.BACKSTYLE = 0
ENDWITH

k = k + 1

IF MOD(k,7)==0
lnTop = lnTop + 18
lnLeft = StartLeft
ELSE
lnLeft = lnLeft + ColStep
ENDIF

NEXT
NEXT
THIS.SetDate(DATE())
ENDPROC

PROCEDURE setdate
LPARAM ldSetDate
#DEFINE HiLight RGB(10,0,255)
#DEFINE LowLight RGB(0,0,0)
WITH THIS
.dCurDate = ldSetDate

.lblMonth.CAPTION = CMONTH(ldSetDate)
.lblYear.CAPTION = TRANSFORM(YEAR(ldSetDate))
.lblMonth.AUTOSIZE = .T.
.lblYear.AUTOSIZE = .T.

LOCAL lnDay, lnFirstDOW, ldCurDate, i, o, k, lnSetDay

lnDay = 1
lnSetDay = DAY(ldSetDate)

k = 0
lnFirstDOW = ;
DOW(CTOD(TRANSFORM(MONTH(ldSetDate)) + "/01/" + ;
TRANSFORM(YEAR(ldSetDate))),1)

FOR i = 1 TO 42
o = ".lblDay"+TRANSFORM(k)
o = &o
ldCurDate = ;
CTOD(TRANSFORM(MONTH(ldSetDate)) + "/" + ;
TRANSFORM(lnDay) + "/" + ;
TRANSFORM(YEAR(ldSetDate)))

o.CAPTION = IIF(i>=lnFirstDOW .AND. !EMPTY(ldCurDate),TRANSFORM(lnDay),"&quot

o.FORECOLOR = IIF(lnDay<>lnSetDay,LowLight,HiLight)

o.BORDERSTYLE = ;
IIF(CTOD(TRANSFORM(MONTH(ldSetDate)) + "/" + ;
o.CAPTION+"/"+TRANSFORM(YEAR(ldSetDate)))<>DATE(),0,1)

k = k + 1

IF i>=lnFirstDOW
lnDay = lnDay + 1
ENDIF
NEXT

FOR i = 1 TO 12
o = ".lblMon"+TRANSFORM(i)
o = &o
o.FORECOLOR = IIF(MONTH(ldSetDate)<>o.nIndex,LowLight,HiLight)
NEXT

.lblCurDate.CAPTION = ;
CDOW(ldSetDate) + " " + ;
CMONTH(ldSetDate) + " " + ;
TRANSFORM(DAY(ldSetDate)) + ", " + ;
TRANSFORM(YEAR(ldSetDate))

FOR i = 1 TO 7
o = ".lblDow"+TRANSFORM(i)
o = &o
o.FORECOLOR = IIF(DOW(ldSetDate)<>i,LowLight,HiLight)
NEXT

ENDWITH
ENDPROC

PROCEDURE lblmonrev.CLICK
LOCAL ldNextDate
ldNextDate = GOMONTH(THIS.PARENT.dCurDate,-1)
THIS.PARENT.SetDate(ldNextDate)
ENDPROC

PROCEDURE lblmonfwd.CLICK
LOCAL ldNextDate
ldNextDate = GOMONTH(THIS.PARENT.dCurDate,1)
THIS.PARENT.SetDate(ldNextDate)
ENDPROC

PROCEDURE lblyearrev.CLICK
LOCAL ldNextDate, lnDownDay
ldNextDate = CTOD("//&quot

lnDownDay = 0
DO WHILE EMPTY(ldNextDate)
ldNextDate = CTOD( ;
TRANSFORM(MONTH(THIS.PARENT.dCurDate)) + "/" + ;
TRANSFORM(DAY(THIS.PARENT.dCurDate)-lnDownDay) + "/" + ;
TRANSFORM(YEAR(THIS.PARENT.dCurDate)-1) ;
)
lnDownDay = lnDownDay + 1 && Compensates for hitting a month with an invalid day
ENDDO
THIS.PARENT.SetDate(ldNextDate)
ENDPROC

PROCEDURE lblyearfwd.CLICK
LOCAL ldNextDate, lnDownDay
ldNextDate = CTOD("//&quot

lnDownDay = 0
DO WHILE EMPTY(ldNextDate)
ldNextDate = CTOD( ;
TRANSFORM(MONTH(THIS.PARENT.dCurDate)) + "/" + ;
TRANSFORM(DAY(THIS.PARENT.dCurDate)-lnDownDay) + "/" + ;
TRANSFORM(YEAR(THIS.PARENT.dCurDate)+1) ;
)
lnDownDay = lnDownDay + 1 && Compensates for hitting a month with an invalid day
ENDDO
THIS.PARENT.SetDate(ldNextDate)
ENDPROC

PROCEDURE lblToday.CLICK
THIS.PARENT.SetDate(DATE())
ENDPROC
ENDDEFINE
*
*-- EndDefine: calendar
**************************************************

**************************************************
*-- Class: calday (c:\dev\classes\vfp\dateclasses.vcx)
*-- ParentClass: label
*-- BaseClass: label
*-- Time Stamp: 07/19/03 11:36:02 PM
*
DEFINE CLASS calday AS LABEL
CAPTION = "Label1"
HEIGHT = 17
WIDTH = 40
NAME = "calday"

PROCEDURE CLICK
IF !EMPTY(THIS.CAPTION)
LOCAL ldSetDate
ldSetDate = THIS.PARENT.dCurDate
ldSetDate = TRANSFORM(MONTH(ldSetDate))+ "/"+ ;
THIS.CAPTION +"/"+;
TRANSFORM(YEAR(ldSetDate))

ldSetDate = CTOD(ldSetDate)
THIS.PARENT.SetDate(ldSetDate)
ENDIF
ENDPROC
ENDDEFINE
*
*-- EndDefine: calday
**************************************************

**************************************************
*-- Class: monlabel (c:\dev\classes\vfp\dateclasses.vcx)
*-- ParentClass: label
*-- BaseClass: label
*-- Time Stamp: 07/19/03 11:45:02 PM
*
DEFINE CLASS monlabel AS LABEL
CAPTION = "Label1"
HEIGHT = 17
WIDTH = 40
NAME = "monlabel"
nindex = .F.

PROCEDURE INIT
LPARAM lnIndex
THIS.nIndex = lnIndex
IF !pemstatus(THIS.PARENT,"aMonths",5)
THIS.PARENT.ADDPROPERTY("aMonths[12]&quot

LOCAL i
#DEFINE Months "Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec"
ALINES(THIS.PARENT.aMonths,STRTRAN(Months,",",CHR(13)))
ENDIF
ENDPROC

PROCEDURE CLICK
LOCAL ldNextDate, lnDownDay
ldNextDate = CTOD("//&quot

lnDownDay = 0

DO WHILE EMPTY(ldNextDate)
ldNextDate = CTOD( ;
TRANSFORM(THIS.nIndex) + "/" + ;
TRANSFORM(DAY(THIS.PARENT.dCurDate)-lnDownDay) + "/" + ;
TRANSFORM(YEAR(THIS.PARENT.dCurDate)) ;
)
lnDownDay = lnDownDay + 1 && Compensates for hitting a month with an invalid day
ENDDO
THIS.PARENT.SetDate(ldNextDate)
ENDPROC
ENDDEFINE
*
*-- EndDefine: monlabel
**************************************************

**************************************************
*-- Class: dayofweek (c:\dev\classes\vfp\dateclasses.vcx)
*-- ParentClass: label
*-- BaseClass: label
*-- Time Stamp: 07/19/03 11:36:02 PM
*
DEFINE CLASS DAYOFWEEK AS LABEL
CAPTION = "Label1"
HEIGHT = 17
WIDTH = 40
NAME = "dayofweek"

PROCEDURE INIT
IF !pemstatus(THIS.PARENT,"aDow",5)
THIS.PARENT.ADDPROPERTY("aDow[7]&quot

LOCAL i
#DEFINE DAYOFWEEK "Sun,Mon,Tue,Wed,Thu,Fri,Sat"
ALINES(THIS.PARENT.aDow,STRTRAN(DAYOFWEEK,",",CHR(13)))
ENDIF
ENDPROC

PROCEDURE CLICK
LOCAL lnDow, lnThisDow
lnDow = DOW(THIS.PARENT.dCurDate)
lnThisDow = ASCAN(THIS.PARENT.aDow,THIS.CAPTION)
THIS.PARENT.SetDate(THIS.PARENT.dCurDate+lnThisDow-lnDow)
ENDPROC
ENDDEFINE
*
*-- EndDefine: dayofweek
**************************************************

[/tt]

'We all must do the hard bits so when we get bit we know where to bite'

craigsboyd · Jul 20, 2003

darrellblackhawk,

Liked the calendar - star. You should create a FAQ with it.

Slighthaze = NULL

[ul][li]FAQ184-2483
An excellent guide to getting a fast and accurate response to your questions in this forum.[/li][/ul]

craigsboyd · Jul 20, 2003

darrellblackhawk,

PROCEDURE lblyearrev.CLICK
LOCAL ldNextDate
ldNextDate = GOMONTH(THIS.PARENT.dCurDate,-12)
THIS.PARENT.SetDate(ldNextDate)
ENDPROC

PROCEDURE lblyearfwd.CLICK
LOCAL ldNextDate
ldNextDate = GOMONTH(THIS.PARENT.dCurDate,12)
THIS.PARENT.SetDate(ldNextDate)
ENDPROC

Slighthaze = NULL

[ul][li]FAQ184-2483
An excellent guide to getting a fast and accurate response to your questions in this forum.[/li][/ul]

darrellblackhawk · Jul 20, 2003

Thanks SlightHaze.

I was trying to remember that, but I went with the hard way.

Darrell

'We all must do the hard bits so when we get bit we know where to bite'

craigsboyd · Jul 20, 2003

Can anybody see the images that I posted in the 2 FAQs I listed above? Seems I am having a problem or tek-tips is having a problem since the images aren't showing for some members. Any feedback on this would be appreciated so I can figure out if I need to move them to a different webserver. Thanks.

Slighthaze = NULL

[ul][li]FAQ184-2483
An excellent guide to getting a fast and accurate response to your questions in this forum.[/li][/ul]

darrellblackhawk · Jul 20, 2003

SlightHaze:

I see the images fine.

Darrell

'We all must do the hard bits so when we get bit we know where to bite'

craigsboyd · Jul 21, 2003

Thanks Darrell.

For anyone who might be wondering why I didn't just check it myself...the router/NAT that I sit behind will not allow me to loopback to it's IP Address. Though I can see my website and everything, I am doing it with a loopback 127.0.0.1 rather than the way anyone else sees it coming to the webserver from the WAN IP. So, sometimes if something is messed up I need to enlist some volunteer(s) to check it out. Now I should probably post an example of doing something with your IP Address or a Webserver via VFP so this thread doesn't get deleted do to non-technical content. [smile]

Slighthaze = NULL

[ul][li]FAQ184-2483
An excellent guide to getting a fast and accurate response to your questions in this forum.[/li][/ul]

nisney · Jul 21, 2003

Dear Slighthaze,

I was attracted by your nice images on datetime entry control, but after i copy and paste to test it, it return below's error:

Ambiguous date/datetime constant.Use the format:
{^yyyy-mm-dd....}

What's your date format, i should "Set date ??"

rgds

jhall251 · Jul 21, 2003

rgds - try

SET STRICTDATE TO 0

hth

Joe Halloran

craigsboyd · Jul 21, 2003

nisney,

Thanks for posting the question, I hadn't even thought of that. I am so use to running with strict date off these days. jhalloran has correctly provided you with the answer. I may edit the FAQ to accomodate other date settings. There is still some work to be done, but I felt that it was a good enough start to post.

Slighthaze = NULL

[ul][li]FAQ184-2483
An excellent guide to getting a fast and accurate response to your questions in this forum.[/li][/ul]

DSummZZZ · Jul 22, 2003

slighthaze,

Images? What images?
I don't see any images in any of your posts.

-Dave S.-
[cheers]

Even more Fox stuff at:

http://www.davesummers.net/foxprolinks.htm

Neil Toulouse · Jul 22, 2003

I don't see the images on the two FAQs you posted above either, but on the big list of FAQs you posted a couple of days ago I did see the images on the 'Chat' client one!

Neil

"I like work. It fascinates me. I can sit and look at it for hours..."

craigsboyd · Jul 22, 2003

The images should be in most of my FAQs (not all) ...I don't understand and I am beginning to think there is a glitch with Tek-tips TGML parser... odd that they show up some times and not others...I have checked everything I can check at this end. Who knows, I feel kinda bad about it though cause the images I felt added a lot to the FAQs. You can see at a glance what you are getting with the code posted.

Slighthaze = NULL

[ul][li]FAQ184-2483
An excellent guide to getting a fast and accurate response to your questions in this forum.[/li][/ul]

craigsboyd · Jul 22, 2003

If anyone else can see or not see the images please let me know...I am deciding whether to contact Tek-Tips management about it.

Slighthaze = NULL

[ul][li]FAQ184-2483
An excellent guide to getting a fast and accurate response to your questions in this forum.[/li][/ul]

Neil Toulouse · Jul 23, 2003

Hi SlighHaze!

"I feel kinda bad about it though cause the images I felt added a lot to the FAQs."

... I agree with your sentiments entirely

It made wonder why no-one had done it before as it does make such a big difference being able to quickly see what the end result of the FAQ is. And it makes this site look even more professionsal!

I hope you get to resolve it.

Neil

"I like work. It fascinates me. I can sit and look at it for hours..."

craigsboyd · Jul 23, 2003

FatSlug and others,

I believe that I have double-checked everything at my end that can possibly be checked. If anyone says that they still can't see the images in my FAQs (not all of them have images but most do) then I will mention this in an email to Tek-Tips management.

Slighthaze = NULL

[ul][li]FAQ184-2483
An excellent guide to getting a fast and accurate response to your questions in this forum.[/li][/ul]

SAMPR · Apr 1, 2004

darrelblackhawk calendar
I cant get your calendar to work. Help
I copy the code, run it as a prg...
pryellowpages@prtc.net

rgbean · Apr 1, 2004

SAMPR,
You are correct this code can't be run as shown - it's simply a "hint" of what the VCX would look like. Darrel used the "View Class Code" button in the Class Browser, and it doesn't always create compilable code. (It has problems with containers in particular!) In fact, it really isn't meant to!

If you want to create a working file, you'll need to create an empty class add all the objects and then cut and paste the code into the appropriate methods and verify that all the properties are set properly.

Since Tek-Tips doesn't have a download storage capability, this is just suppose to help you learn the concepts - not always provide you with working code. Remember, the majority of the TT forums aren't for "coders"!

Rick

terosoft · Apr 1, 2004

The image containers on the FAQs appear as broken to me, so I tried to copy the URL and open the image directly from the browser (URL:

http://craigsboyd.sytes.net/datetime.gif

) and receive a timeout error.
It seems to me that the problem is on your personal server, not Tek-Tips one.

Gerardo Czajkowski

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Datetime Class &amp; Listbox Checkboxes 1

IS-IT--Management

Programmer

IS-IT--Management

IS-IT--Management

Programmer

IS-IT--Management

Programmer

IS-IT--Management

MIS

Programmer

IS-IT--Management

Programmer

Programmer

IS-IT--Management

IS-IT--Management

Programmer

IS-IT--Management

Programmer

Programmer

Programmer

Similar threads

Log in

Part and Inventory Search

Sponsor

Datetime Class & Listbox Checkboxes 1