Calendar & clock
This code builds a french navigable calendar and a gdiplusX clock.
see the screenshots below.
the calendar uses a simple cursor.Its themed with random color(click on the shape).
the clock uses gdiplusX and a timer.The code asks to point to gdiplusX class to work.
*Important:*the code above is tested on visual foxpro 9 sp2-under windows 10 pro
Click on code to select [then copy] -click outside to deselect
*1*
*Begin code
publi yform
set classlib to locfile("gdiplusX","vcx") addi
yform=newObject("ycalendar")
release classlib "gdiplusX"
yform.show
read events
retu
*
DEFINE CLASS ycalendar AS form
BorderStyle = 2
Height = 328
Width = 746
ShowWindow = 2
showtips=.y.
AutoCenter = .T.
Caption = ""
MaxButton = .F.
BackColor = RGB(0,0,0)
Name = "Form1"
ADD OBJECT shape2 AS shape WITH ;
Top = 17, ;
Left = 294, ;
Height = 261, ;
Width = 276, ;
BorderStyle = 0, ;
BorderWidth = 0, ;
Curvature = 25, ;
BackColor = RGB(0,0,0), ;
Name = "Shape2"
ADD OBJECT shape1 AS shape WITH ;
Top = 32, ;
Left = 6, ;
Height = 259, ;
Width = 238, ;
BorderStyle = 0, ;
BorderWidth = 0, ;
Curvature = 25, ;
BackColor = RGB(255,255,174), ;
tooltiptext="click to change random theme",;
mousepointer=15,;
Name = "Shape1"
ADD OBJECT command1 AS commandbutton WITH ;
Top = 80, ;
Left = 13, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command1"
ADD OBJECT command2 AS commandbutton WITH ;
Top = 80, ;
Left = 44, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command2"
ADD OBJECT command3 AS commandbutton WITH ;
Top = 80, ;
Left = 75, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command3"
ADD OBJECT command4 AS commandbutton WITH ;
Top = 80, ;
Left = 106, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command4"
ADD OBJECT command5 AS commandbutton WITH ;
Top = 80, ;
Left = 137, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command5"
ADD OBJECT command6 AS commandbutton WITH ;
Top = 80, ;
Left = 169, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command6"
ADD OBJECT command7 AS commandbutton WITH ;
Top = 81, ;
Left = 201, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command7"
ADD OBJECT command8 AS commandbutton WITH ;
Top = 112, ;
Left = 13, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command8"
ADD OBJECT command9 AS commandbutton WITH ;
Top = 112, ;
Left = 44, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command9"
ADD OBJECT command10 AS commandbutton WITH ;
Top = 112, ;
Left = 75, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command10"
ADD OBJECT command11 AS commandbutton WITH ;
Top = 112, ;
Left = 106, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command11"
ADD OBJECT command12 AS commandbutton WITH ;
Top = 112, ;
Left = 137, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command12"
ADD OBJECT command13 AS commandbutton WITH ;
Top = 112, ;
Left = 169, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command13"
ADD OBJECT command14 AS commandbutton WITH ;
Top = 113, ;
Left = 201, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command14"
ADD OBJECT command15 AS commandbutton WITH ;
Top = 144, ;
Left = 13, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command15"
ADD OBJECT command16 AS commandbutton WITH ;
Top = 144, ;
Left = 44, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command16"
ADD OBJECT command17 AS commandbutton WITH ;
Top = 144, ;
Left = 75, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command17"
ADD OBJECT command18 AS commandbutton WITH ;
Top = 144, ;
Left = 106, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command18"
ADD OBJECT command19 AS commandbutton WITH ;
Top = 144, ;
Left = 137, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command19"
ADD OBJECT command20 AS commandbutton WITH ;
Top = 144, ;
Left = 169, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command20"
ADD OBJECT command21 AS commandbutton WITH ;
Top = 145, ;
Left = 201, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command21"
ADD OBJECT command22 AS commandbutton WITH ;
Top = 176, ;
Left = 13, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command22"
ADD OBJECT command23 AS commandbutton WITH ;
Top = 176, ;
Left = 44, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command23"
ADD OBJECT command24 AS commandbutton WITH ;
Top = 176, ;
Left = 75, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command24"
ADD OBJECT command25 AS commandbutton WITH ;
Top = 176, ;
Left = 106, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command25"
ADD OBJECT command26 AS commandbutton WITH ;
Top = 176, ;
Left = 137, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command26"
ADD OBJECT command27 AS commandbutton WITH ;
Top = 176, ;
Left = 169, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command27"
ADD OBJECT command28 AS commandbutton WITH ;
Top = 177, ;
Left = 201, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command28"
ADD OBJECT command29 AS commandbutton WITH ;
Top = 208, ;
Left = 13, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command29"
ADD OBJECT command30 AS commandbutton WITH ;
Top = 208, ;
Left = 44, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command30"
ADD OBJECT command31 AS commandbutton WITH ;
Top = 208, ;
Left = 75, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command31"
ADD OBJECT command32 AS commandbutton WITH ;
Top = 208, ;
Left = 106, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command32"
ADD OBJECT command33 AS commandbutton WITH ;
Top = 208, ;
Left = 137, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command33"
ADD OBJECT command34 AS commandbutton WITH ;
Top = 208, ;
Left = 169, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command34"
ADD OBJECT command35 AS commandbutton WITH ;
Top = 209, ;
Left = 201, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command35"
ADD OBJECT command36 AS commandbutton WITH ;
Top = 239, ;
Left = 13, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command36"
ADD OBJECT command37 AS commandbutton WITH ;
Top = 240, ;
Left = 44, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command37"
ADD OBJECT command38 AS commandbutton WITH ;
Top = 240, ;
Left = 75, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command38"
ADD OBJECT command39 AS commandbutton WITH ;
Top = 240, ;
Left = 106, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command39"
ADD OBJECT command40 AS commandbutton WITH ;
Top = 240, ;
Left = 137, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command40"
ADD OBJECT command41 AS commandbutton WITH ;
Top = 240, ;
Left = 169, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command41"
ADD OBJECT command42 AS commandbutton WITH ;
Top = 241, ;
Left = 201, ;
Height = 32, ;
Width = 32, ;
Caption = "", ;
SpecialEffect = 0, ;
Name = "Command42"
ADD OBJECT di AS commandbutton WITH ;
Top = 45, ;
Left = 13, ;
Height = 32, ;
Width = 32, ;
FontBold = .T., ;
Caption = "Di", ;
SpecialEffect = 2, ;
ForeColor = RGB(255,0,0), ;
Name = "di"
ADD OBJECT lu AS commandbutton WITH ;
Top = 45, ;
Left = 44, ;
Height = 32, ;
Width = 32, ;
FontBold = .T., ;
Caption = "Lu", ;
SpecialEffect = 2, ;
ForeColor = RGB(255,0,0), ;
Name = "lu"
ADD OBJECT ma AS commandbutton WITH ;
Top = 45, ;
Left = 75, ;
Height = 32, ;
Width = 32, ;
FontBold = .T., ;
Caption = "Ma", ;
SpecialEffect = 2, ;
ForeColor = RGB(255,0,0), ;
Name = "ma"
ADD OBJECT me AS commandbutton WITH ;
Top = 45, ;
Left = 106, ;
Height = 32, ;
Width = 32, ;
FontBold = .T., ;
Caption = "Me", ;
SpecialEffect = 2, ;
ForeColor = RGB(255,0,0), ;
Name = "me"
ADD OBJECT je AS commandbutton WITH ;
Top = 45, ;
Left = 138, ;
Height = 32, ;
Width = 32, ;
FontBold = .T., ;
Caption = "Je", ;
SpecialEffect = 2, ;
ForeColor = RGB(255,0,0), ;
Name = "je"
ADD OBJECT ve AS commandbutton WITH ;
Top = 45, ;
Left = 170, ;
Height = 32, ;
Width = 32, ;
FontBold = .T., ;
Caption = "Ve", ;
SpecialEffect = 2, ;
ForeColor = RGB(255,0,0), ;
Name = "ve"
ADD OBJECT yclock31 AS yclock3 WITH ;
Top = 48, ;
Left = 508, ;
Name = "Yclock31", ;
Imgcanvas1.Name = "Imgcanvas1", ;
Timer1.Name = "Timer1"
ADD OBJECT sa AS commandbutton WITH ;
Top = 45, ;
Left = 200, ;
Height = 32, ;
Width = 32, ;
FontBold = .T., ;
Caption = "Sa", ;
SpecialEffect = 2, ;
ForeColor = RGB(255,0,0), ;
Name = "sa"
ADD OBJECT spinner1 AS spinner WITH ;
FontBold = .T., ;
Anchor = 768, ;
BorderStyle = 0, ;
Height = 25, ;
KeyboardHighValue = 12, ;
KeyboardLowValue = 1, ;
Left = 68, ;
MousePointer = 15, ;
SpinnerHighValue = 12.00, ;
SpinnerLowValue = 1.00, ;
Top = 300, ;
Width = 49, ;
Name = "Spinner1"
ADD OBJECT spinner2 AS spinner WITH ;
FontBold = .T., ;
Anchor = 768, ;
BorderStyle = 0, ;
Height = 25, ;
KeyboardHighValue = 2100, ;
KeyboardLowValue = 1900, ;
Left = 128, ;
MousePointer = 15, ;
SpinnerHighValue = 2100.00, ;
SpinnerLowValue = 1900.00, ;
Top = 300, ;
Width = 86, ;
Name = "Spinner2"
ADD OBJECT label1 AS label WITH ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 10, ;
Anchor = 768, ;
BackStyle = 0, ;
Caption = "This day", ;
Height = 18, ;
Left = 3, ;
MousePointer = 15, ;
Top = 300, ;
Width = 55, ;
ForeColor = RGB(0,255,0), ;
Name = "Label1"
ADD OBJECT label2 AS label WITH ;
AutoSize = .F., ;
FontBold = .T., ;
FontSize = 12, ;
BackStyle = 0, ;
Caption = "", ;
Height = 18, ;
Left = 22, ;
Top = 7, ;
Width = 182, ;
ForeColor = RGB(0,255,0), ;
Name = "Label2"
ADD OBJECT image1 AS image WITH ;
Stretch = 2, ;
Height = 276, ;
Left = 246, ;
MousePointer = 15, ;
Top = 15, ;
Width = 240, ;
Name = "Image1"
ADD OBJECT label3 AS label WITH ;
FontSize = 36, ;
WordWrap = .T., ;
Alignment = 2, ;
Caption = "Label1", ;
Height = 228, ;
Left = 256, ;
Top = 51, ;
Width = 216, ;
ForeColor = RGB(128,0,64), ;
BackColor = RGB(255,128,64), ;
Name = "Label3"
PROCEDURE shape1.CLICK
this.backcolor=rgb(255*rand(),255*rand(),255*rand())
endproc
Procedure destroy
clea events
endproc
PROCEDURE yorder
Lparameters xdate
Sele ycurs
Zap
mois=Month(xdate)
If mois<=9
xmois="0"+Trans(mois)
Else
xmois=Trans(mois)
Endi
Local m.x
m.x=Ctod("01/"+m.xmois+"/"+Trans(Year(xdate)))
Y=Month(xdate)
Do Case
Case Y=1
N=31
Case Y=2
Try
aa=Ctod("29/02"+Year(xdate))
N=29
Catch
N=28
Endtry
Case Y=3
N=31
Case Y=4
N=30
Case Y=5
N=31
Case Y=6
N=30
Case Y=7
N=31
Case Y=8
N=31
Case Y=9
N=30
Case Y=10
N=31
Case Y=11
N=30
Case Y=12
N=31
Endcase
For i=1 To N
oo=Lower( Substr(Cdow(x+i-1),1,2))
Do Case
Case oo="di"
xpos=1
Case oo="lu"
xpos=2
Case oo="ma"
xpos=3
Case oo="me"
xpos=4
Case oo="je"
xpos=5
Case oo="ve"
xpos=6
Case oo="sa"
xpos=7
Endcase
Insert Into ycurs Values(x+i-1,Substr(Cdow(x+i-1),1,2) ,i ,xpos)
Endfor
Locate
Thisform.ycolor()
Locate
xpos=pos
Try
For i=1 To xpos-1
w=Eval("thisform.command"+Trans(i))
w.Caption=""
w.Enabled=.F.
w.DisabledBackColor=Rgb(128,128,128)
Endfor
Catch
Endtry
Scan
w=Eval("thisform.command"+Trans(xpos))
w.Caption=Trans(njour)
If Date=Date()
w.BackColor=255
Endi
xpos=xpos+1
Endscan
Try
For i=xpos To 42
w=Eval("thisform.command"+Trans(i))
w.Caption=""
w.Enabled=.F.
w.DisabledBackColor=Rgb(128,128,128)
Endfor
Catch
Endtry
Locate
With Thisform
.spinner1.Value=Month(Date)
.spinner2.Value=Year(Date)
Endwith
ENDPROC
PROCEDURE ycolor
With Thisform
.SetAll("caption","","commandbutton")
.di.Caption="Di"
.di.ForeColor=Rgb(0,0,255)
.lu.Caption="Lu"
.lu.ForeColor=Rgb(0,0,255)
.ma.Caption="Ma"
.ma.ForeColor=Rgb(0,0,255)
.me.Caption="Me"
.me.ForeColor=Rgb(0,0,255)
.je.Caption="Je"
.je.ForeColor=Rgb(0,0,255)
.ve.Caption="Ve"
.ve.ForeColor=Rgb(0,0,255)
.sa.Caption="Sa"
.sa.ForeColor=Rgb(0,0,255)
.SetAll("backcolor",Rgb(0,255,0),"commandbutton")
.SetAll("enabled",.T.,"commandbutton")
Endwith
ENDPROC
PROCEDURE my
LPARAMETERS nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
if !empty(loObject.caption)
thisform.ycolor()
local m.xdate,xmois,xyear
xmois=iif(thisform.spinner1.value<=9,"0"+trans(thisform.spinner1.value),trans(thisform.spinner1.value)) &&&
m.xdate=ctod("01/"+m.xmois+"/"+trans(thisform.spinner2.value))
thisform.yorder(m.xdate)
loObject.backcolor=rgb(0,255,255)
set date long
local uDate
m.uDate=xdate+val(loObject.caption)-1
thisform.label2.caption=dtoc(m.uDate)
thisform.label3.caption=dtoc(m.uDate)
else
thisform.label2.caption=""
thisform.label3.caption=dtoc(date())
endi
set date short
ENDPROC
PROCEDURE Init
set safe off
=sys(2002) &&set curs off
with thisform
.setall("specialeffect",0,"commandbutton")
.setall("Backcolor",rgb(0,255,0),"commandbutton")
.setall("mousepointer",15,"commandbutton")
endwith
local m.myvar &&small png image encoded
text to m.myvar noshow
iVBORw0KGgoAAAANSUhEUgAAAIIAAACNCAYAAAB7VaIoAAAABGdBTUEAAK/INwWK6QAAABl0RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAVuSURBVHja7JxNS2NnFMefm1xjre+DtlSKURAKOtjKoGQhKLNw7Qfooq4LdlNoP4G46KaLzizaoqvuxS9QmEVdOEwptdCCU19AGd+jxpeY3NtzwnMdTXJ9GbowN78fnIkxZ27A+5/z/59ngo7v+6YcjuN8Kw8HUmdlXp4tek5vhfSG3e+YCeegu7v7dSqVOo7FYpvj4+PnIo6X8v1f6Y1M71tUIeVK+GJpaSk9NTXlDw8P+/Pz835zc/PfIZeht0J6w+63K2oJFUlvb2/T6uqqSSQSpqury9TX13+cTqfpreDesPvtmlvo7+83MmpMR0eHaWhooDeCvbciI8PP5/OFUvr6+jL0Rqv3MiyGeUaQLvUxl8sZz/NMWOK86j/0Vl5viTWIf9TJQ0KqJhDJ6elpoXS8iMLUYD4Iuxi9D77Xk7qQympLiRBEAHrzm6TUTN6TqgtWy8PDQ7O7u1vwGlGYXrAr7M3pfdC9SSuErD1jOLTnDfrcDyaCiqBNakDqqdQnUu/rC3t7e2Ztbc00NTWZbDargnkW9ub0Puje51InUstSL6Re2X/sWyoQ19qBToIBUc83MzMznalUqlEuUBDJzs6OWV5eNp2dncZ1XbWLJ2FvTu/D7pUpkVtYWHg8MTExsLGxocL4zVpEWhVRa63gqYggOTY21hqIQNna2ipcUEeNKOvGwEHvw+7V+6r3d+rHn9UmRqUeSTVKxWM2GGou6BsZGWkOLjQ9PV143N7evrygho/Z2dmSN6W3cnovZAGo+3RQ73O3VKt1g4IQHOsVidra2stjp5aWlkuvWVlZMUdHR5o+zejoaMmb01s5vTWOYy7chGMXhQbrCLHAApxg9wwQUZj19XWzv79vNjc3zcnJiR5VmmQyWbKX0lthvW//TsIKwrkmhGL0QkNDQ6anp8e0tbWZubm5UE+ityJ749YNbhZCe3u7GRwcvNNxNL0V2esEFZw46cHEM8/znhiIPL+8OTKff9Ssn1H4yZ4nLMX4sYAxN39CCaoIt9z/WkG08Y3PRACsARACIAS4f1i8+hE1iHRaZCIA1gAIARACEBYhJCv6nCwC1gAIAcgIUCYjMBEAawCEAPfMCGE7JkQtJHCOAFgDIAS4X0bgHKFaIgIZAbAGQAhARgAmAiAEwBqA9RGwBkAI8L9nhDD/gIhlBH5RBmANwPoIJd7ARACsARACkBHA3OWIgIkACAGwBrZHJgJgDXA3awhLlBC5tYGJAFgDsDXA9a0BawCsAbAGKPYGJgJgDYAQgIwApRGBk0XAGuDu1hA2NiDy2yMTARACsDVU/drARACsAbAGuG0zZCIAQgCsobqtgYkAWAMgBLhnRghbLSBy+yMTAbAGYH2E6+sj1gBYAyAEICNA2ZDARACsAbAGKL7PTATAGgAhwH0yQph/QOS3RyYCIARACHBjRuAcoVpCAucIgDUAQgAyApSLCGQEwBoAIQAZAcpkBCYCYA2AEAAhwLuExSAwQtTTIgdKgDUAQgCEAO8QFjlZrJKsyC/KAKwBEAIgBLgtLhQJgYRYvUIolGu/8KTOMplMLh6Pu2wO0eVEb+3ZWV7+vFq+ToSs1IXU68XFxcy/8u1TdBBJ9L6+OvdN+q8/juXptlRGtRFMBBXCqdSLycnJ/i+/+76r9fFnjV5NgvwQtUB4kfX2//z96Ievv1qRp0tS+1YMnqM24DjOh/KkQyolNSKVlKrhRxc58nYSqAheSv2jTqBTIRBCrTx5JNVuH1ulGqQSUnEpxxZUdijM2wmgk+CN1KbUgbpCIATHbhCNtlQEKg7Xfh8RREMMeRsDjq0AzqVyBWu40hh8HbcVuzIJEEKEVkW7JQYbQ+G1/wQYAPwSdIuCih3HAAAAAElFTkSuQmCC
endtext
thisform.image1.pictureval=strconv(m.myvar,14)
for i=1 to 42
bindevent(eval( "thisform.command"+trans(i) ),"mousedown",thisform,"my")
endfor
thisform.yorder(date())
ENDPROC
PROCEDURE Load
Do Locfile("system.app",'app')
Set Date To French &&DMY ...can adapt for other langs
Create Cursor ycurs (Date d,nday c(2),njour i,pos i)
ENDPROC
PROCEDURE spinner1.InteractiveChange
local m.xdate,xmois,xyear
xmois=iif [this.value<=9,"0"+trans(this.value),trans(this.value)]
m.xdate=ctod("01/"+m.xmois+"/"+trans(thisform.spinner2.value))
thisform.yorder(m.xdate)
ENDPROC
PROCEDURE spinner1.Init
this.value=month(date())
ENDPROC
PROCEDURE spinner2.Init
this.value=year(date())
ENDPROC
PROCEDURE spinner2.InteractiveChange
local m.xdate,xmois,xyear
xmois=iif(thisform.spinner1.value<=9,"0"+trans(thisform.spinner1.value),trans(thisform.spinner1.value))
m.xdate=ctod("01/"+m.xmois+"/"+trans(this.value))
thisform.yorder(m.xdate)
ENDPROC
PROCEDURE label1.Click
thisform.yorder(date())
set date long
thisform.label2.caption=dtoc(date())
thisform.label3.caption=dtoc(date())
set date short
ENDPROC
PROCEDURE label2.Init
this.caption=cdow(date())+" "+dtoc(date())
ENDPROC
PROCEDURE image1.MouseDown
LPARAMETERS nButton, nShift, nXCoord, nYCoord
lnHandle0=thisform.hwnd
param1 = 274
param2 = 0xF012
DECLARE INTEGER ReleaseCapture IN WIN32API
DECLARE INTEGER SendMessage IN WIN32API INTEGER, INTEGER, INTEGER, INTEGER
bb=ReleaseCapture()
bb=SendMessage(lnHandle0, param1, param2,0)
ENDPROC
PROCEDURE label3.Init
set date long
this.caption=dtoc(date())
set date short
ENDPROC
ENDDEFINE
*
*GdilpusX clock class
DEFINE CLASS yclock3 AS container
Width = 218
Height = 206
BackStyle = 0
BorderWidth = 0
ispicture = ".F."
*-- XML Metadata pour les propriétés personnalisables
_memberdata = [<?xml version="1.0" encoding="Windows-1252" standalone="yes" ?> ] + CHR(13) + CHR(13) + [<VFPData>] + CHR(13) + CHR(13) + [<memberdata name="foomethod" type="method" display="fooMethod" favorites="True"/>] + CHR(13) + CHR(13) + [<memberdata name="yclock3" type="property" display="yclock3" favorites="True"/>] + CHR(13) + CHR(13) + [<memberdata name="_memberdata" type="property" display="_MemberData" favorites="True"/>] + CHR(13) + CHR(13) + [<memberdata name="baseclass" type="property" display="BaseClasS" favorites="True"/>] + CHR(13) + CHR(13) + [<memberdata name="error" type="method" display="eRRor" favorites="True"/>] + CHR(13) + CHR(13) + [</VFPData>]
isgraduation = .T.
istime = .T.
issound = .F.
Name = "yclock3"
ADD OBJECT imgcanvas1 AS imgcanvas WITH ;
Stretch = 2, ;
Height = 204, ;
Left = 0, ;
Top = 0, ;
Width = 216, ;
Name = "Imgcanvas1"
ADD OBJECT timer1 AS timer WITH ;
Top = 120, ;
Left = 24, ;
Height = 23, ;
Width = 23, ;
Interval = 1000, ;
Name = "Timer1"
PROCEDURE imgcanvas1.setup
this.drawWhenInvisible=.t.
this.rendermode=4
if file(this.parent.picture) and empty(this.picture)
this.picture=this.parent.picture
endi
this.stretch=2
this.left=0
this.top=0
this.width=this.parent.width
this.height=this.parent.height
ENDPROC
PROCEDURE imgcanvas1.beforedraw
with _screen.system.drawing
logfx=this.ogfx
this.clear(.color.transparent)
&&image background
try
if this.parent.isPicture=.t. and file(this.picture)
local loBmp as xfcBitmap
loBmp=.bitmap.fromfile(this.picture)
loGfx.drawimage(lobmp,0,0,this.width,this.height)
endi
catch
endtry
&& seconds
rs=0.15*this.width/2
tetas=val(substr(time(),7,2))*pi()/30
pen=.pen.new(.color.green,2)
logfx.translateTransform(this.width/2,0.75*this.height)
logfx.drawLine(pen,0,0,rs*cos(tetas-pi()/2),rs*sin(tetas-pi()/2) )
*graduations
pen=.pen.new(.color.gold,2)
for i=1 to 12
logfx.drawline(pen,0.45*2*rs*cos(i*pi()/6-pi()/2),0.45*2*rs*sin(i*pi()/6-pi()/2),0.55*2*rs*cos(i*pi()/6-pi()/2),0.55*2*rs*sin(i*pi()/6-pi()/2))
endfor
*petit rond secondes
loRect2=.rectangle.new(-3,-3,6,6)
br = .Drawing2D.LinearGradientBrush.New(loRect2,.color.black,.Color.gray,2)
loGfx.fillEllipse(br,loRect2)
pen=.pen.new(.color.green,2)
loGfx.drawEllipse(pen,loRect2)
loGfx.ResetTransform()
*12 clock graduations
local r,ymin,yhour,tetah,tetam,rh
logfx.translateTransform(this.width/2,this.height/2)
r=0.90*this.width
pen=.pen.new(.color.gold,2)
for i=1 to 12
logfx.drawline(pen,0.45*r*cos(i*pi()/6-pi()/2),0.45*r*sin(i*pi()/6-pi()/2),0.55*r*cos(i*pi()/6-pi()/2),0.55*r*sin(i*pi()/6-pi()/2))
endfor
if this.parent.isGraduation=.t.
*graduations secondaires
pen=.pen.new(.color.gold,1)
for i=1 to 60
logfx.drawline(pen,0.45*r*cos(i*pi()/30-pi()/2),0.45*r*sin(i*pi()/30-pi()/2),0.50*r*cos(i*pi()/30-pi()/2),0.50*r*sin(i*pi()/30-pi()/2))
endfor
endi
*aiguilles hour+min
ymin =val(substr(time(),4,2))
tetam=ymin*pi()/30
yhour=val(substr(time(),1,2))
if yhour>12
yhour=yhour-12
endi
tetah=(yhour+ymin/60)*pi()/6
rh=0.6*this.width/2
rm=0.75*this.width/2
pen=.pen.new(.color.red,4)
logfx.drawLine(pen,0,0,rh*cos(tetah-pi()/2),rh*sin(tetah-pi()/2) )
logfx.drawLine(pen,0,0,rm*cos(tetam-pi()/2),rm*sin(tetam-pi()/2) )
&&petit rond central
loRect1=.rectangle.new(-6,-6,12,12)
br = .Drawing2D.LinearGradientBrush.New(loRect1,.color.black,.Color.gray,2)
loGfx.fillEllipse(br,loRect1)
pen=.pen.new(.color.GREEN,1)
loGfx.drawEllipse(pen,loRect1)
loGfx.ResetTransform()
pen.dispose()
br.dispose()
loGfx.ResetTransform()
if this.parent.isTime=.t.
*texte
LOCAL loFont AS xfcFont
LOCAL loBrush AS xfcLinearGradientBrush
LOCAL loRectangleF As xfcRectangleF
LOCAL loSizeF AS xfcSizeF
ystring=time()
loFont = .Font.New["tahoma", 9, .FontStyle.BoldItalic] &&&
loSizeF = loGfx.MeasureString(ystring, loFont)
loRectangleF =_screen.system.Drawing.RectangleF.New((this.width-loSizeF.width)/2,this.height/2+loSizeF.height+5,loSizeF.Width, loSizeF.Height)
loBrush = .Drawing2D.LinearGradientBrush.New(loRectangleF,.Color.red,.Color.green,3)
loGfx.DrawString(ystring, loFont,loBrush, loRectangleF)
endi
if this.parent.isSound=.t.
*hour
if substr(time(),4,2)=="00" and substr(time(),7,2)=="00"
TRY
LOCAL lcBell
lcBell = SET("Bell")
SET BELL TO (ADDBS(GETENV('windir')))+"MEDIA\tada.WAV"
?? CHR(7)
SET BELL TO (lcBell)
CATCH
ENDTRY
endi
*1/2 hour
if substr(time(),4,2)=="30" and substr(time(),7,2)=="00"
TRY
LOCAL lcBell
lcBell = SET("Bell")
SET BELL TO (ADDBS(GETENV('windir')))+"MEDIA\tada.WAV"
?? CHR(7)
SET BELL TO (lcBell)
CATCH
ENDTRY
endi
endi
endwith
ENDPROC
PROCEDURE imgcanvas1.DragDrop
LPARAMETERS oSource, nXCoord, nYCoord
ENDPROC
PROCEDURE imgcanvas1.DblClick
this.parent.enabled=.t.
this.parent.timer1.enabled=.t.
ENDPROC
PROCEDURE timer1.Timer
if this.parent.enabled=.t.
this.enabled=.t.
this.parent.imgcanvas1.draw
else
this.enabled=.f.
endi
ENDPROC
ENDDEFINE
*End code
Click on code to select [then copy] -click outside to deselect
*2* confguring at runtime the monthview olecontrol calendar
*added on tuesday 8 march 2016
Publi yform
yform=Newobject("ymonthView")
yform.Show
Read Events
Retu
*
Define Class ymonthView As Form
BorderStyle = 0
Height = 360
Width = 621
ShowWindow = 2
AutoCenter = .T.
Caption = "Dynamic Monthview control properties"
MaxButton = .F.
BackColor = Rgb(212,208,200)
Name = "Form1"
Add Object shape1 As Shape With ;
Top = 12, ;
Left = 3, ;
Height = 325, ;
Width = 157, ;
BorderWidth = 2, ;
Curvature = 30, ;
Enabled = .F., ;
BackColor = Rgb(255,255,128), ;
Name = "Shape1"
Add Object olecontrol1 As OleControl With ;
OLECLASS="MSComCtl2.MonthView.2",;
Top = 60, ;
Left = 264, ;
Height = 178, ;
Width = 288, ;
Name = "Olecontrol1"
Add Object check1 As Checkbox With ;
Top = 24, ;
Left = 12, ;
Height = 17, ;
Width = 88, ;
AutoSize = .T., ;
Alignment = 0, ;
BackStyle = 0, ;
Caption = "Show weeks", ;
Style = 0, ;
Name = "Check1"
Add Object check2 As Checkbox With ;
Top = 60, ;
Left = 12, ;
Height = 17, ;
Width = 84, ;
AutoSize = .T., ;
Alignment = 0, ;
BackStyle = 0, ;
Caption = "Show today", ;
Style = 0, ;
value=1,;
Name = "Check2"
Add Object command1 As CommandButton With ;
Top = 96, ;
Left = 12, ;
Height = 25, ;
Width = 85, ;
Caption = "Backcolor", ;
Name = "Command1"
Add Object command2 As CommandButton With ;
Top = 130, ;
Left = 12, ;
Height = 25, ;
Width = 85, ;
Caption = "Forecolor", ;
Name = "Command2"
Add Object command3 As CommandButton With ;
Top = 163, ;
Left = 12, ;
Height = 25, ;
Width = 113, ;
Caption = "Month Backcolor", ;
Name = "Command3"
Add Object command4 As CommandButton With ;
Top = 192, ;
Left = 12, ;
Height = 25, ;
Width = 109, ;
Caption = "Start of week (1-7)", ;
Name = "Command4"
Add Object command5 As CommandButton With ;
Top = 228, ;
Left = 12, ;
Height = 25, ;
Width = 133, ;
Caption = "Title backcolor", ;
Name = "Command5"
Add Object command6 As CommandButton With ;
Top = 263, ;
Left = 12, ;
Height = 25, ;
Width = 133, ;
Caption = "Title forecolor", ;
Name = "Command6"
Add Object command7 As CommandButton With ;
Top = 302, ;
Left = 12, ;
Height = 25, ;
Width = 133, ;
Caption = "Trailing forecolor", ;
Name = "Command7"
Procedure Destroy
Clea Events
Endproc
Procedure olecontrol1.Init
With This
.BorderStyle=0
.appearence=0
.MousePointer=15
Endwith
Endproc
Procedure check1.Click
With Thisform.olecontrol1
.showWeekNumbers=!.showWeekNumbers
Endwith
Endproc
Procedure check2.Click
With Thisform.olecontrol1
.showToDay=!.showToDay
Endwith
Endproc
Procedure command1.Click
Local m.xcolor
m.xcolor=Getcolor()
If m.xcolor=-1
Return .F.
Endi
Thisform.olecontrol1.BackColor=m.xcolor
Endproc
Procedure command2.Click
Local m.xcolor
m.xcolor=Getcolor()
If m.xcolor=-1
Return .F.
Endi
Thisform.olecontrol1.ForeColor=m.xcolor
Endproc
Procedure command3.Click
Local m.xcolor
m.xcolor=Getcolor()
If m.xcolor=-1
Return .F.
Endi
Thisform.olecontrol1.Monthbackcolor=m.xcolor
Endproc
Procedure command4.Click
Local m.x
m.xs=Inputbox("Say start of week (1-7)","","2")
If ! Between(m.xs,1,7)
m.xs=2 &&default (monday)
Endi
Thisform.olecontrol1.startofWeek=m.xs
Endproc
Procedure command5.Click
Local m.xcolor
m.xcolor=Getcolor()
If m.xcolor=-1
Return .F.
Endi
Thisform.olecontrol1.Titlebackcolor=m.xcolor
Endproc
Procedure command6.Click
Local m.xcolor
m.xcolor=Getcolor()
If m.xcolor=-1
Return .F.
Endi
Thisform.olecontrol1.TitleForecolor=m.xcolor
Endproc
Procedure command7.Click
Local m.xcolor
m.xcolor=Getcolor()
If m.xcolor=-1
Return .F.
Endi
Thisform.olecontrol1.TrailingForecolor=m.xcolor
Endproc
Enddefine
*
*-- EndDefine: ymonthView
