Calendar & clock

Published on by Yousfi Benameur

 
 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


Calendar &amp; clock
Calendar &amp; clock
Calendar &amp; clock

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

 

Calendar &amp; clock
To be informed of the latest articles, subscribe:
Comment on this post