Calendar Control (Zelf maandkalender maken)

Status
Niet open voor verdere reacties.
Ligt eraan of het leuk is ;) Ik heb een iets uitgebreide versie met commentaar gemaakt die ik dan ergens op zet, zodat iedereen hiermee aan de slag kan. uiteindelijk was dit een uurtje of twee werk. Als ik makkelijk iets nuttigs kan toevoegen wil ik daar best eens naar kijken.
 
Beste wampier,

Wat dacht je bv van het volgende :

De button van de huidige kalenderdag in een feller kleurtje zetten ?

of nog straffer, als een bepaalde kalenderdag een feestdag is, de button in een ander kleurtje zetten, zodat dit beter opvalt. :)

gr. Jan
 
In principe is het geen probleem om markeringen aan te brengen. Echter is er geen lijst van feestdagen en die is ook niet eenvoudig in te voegen, daar die deels afhankelijk is van de stand van de maan. Niet alle 'officiële' dagen zijn ook vrij voor iedereen. Nu is hier wel een oplossing voor te verzinnen, maar wordt de oplossing wel een stuk minder algemeen.
 
ok, wampier

Kan je misschien voorlopig de huidige kalenderdag markeren?

IK heb zelf al wat zitten prutsen om dit te doen maar zonder suc6.

Ik heb ondertussen ook al wat het net afgeschuimd, en zal binnenkort misschien de oplossing hebben voor wat betreft de feestdagen.

Ik hou je op de hoogte. :thumb:

gr. Jan
 
Hierbij de highlight. Ik nogmaals de gehele code gepost, zodat ik ook alle comments mee kan posten voor geïnteresseerden

Code: 
Public Class calendar_picker
    '''''''''''''''''
    'fully dynamically build datepicker class
    'returns selected date
    '
    'typical use:
    '   dim MyCal As New calendar_picker()
    '
    '   MyDate = MyCal.Show()
    ' OR
    '   Mydate = Mycal.Show(x,y) 'add screen location to display instead of default
    '''''''''''''''''
    '
    'this code was written to show off some general concepts of dynamic control creation and the use of control arrays in particular
    'Any and all parts of this code may be copied and used freely
    '
    '''''''''''''''''
    'sample code to display below a textbox (referenced as textbox1 in the code below)
    '
    '   Dim a As Date
    '   Dim MyCal As New calendar_picker()
    '   Dim xcor As Integer = (Me.Width - Me.ClientSize.Width) / 2 'correct for bezel width
    '   Dim ycor As Integer = Me.Height - Me.ClientSize.Height - 1 * xcor 'correct for bezel width and height of titel bar
    '   a = MyCal.Show(Me.Location.X + TextBox1.Location.X + xcor, Me.Location.Y + TextBox1.Location.Y + TextBox1.Height + ycor)
    '
    Dim cp As New Form
    Dim buttons(6, 5) As Button 'array to hold and display the "days" in the calendar
    Dim backyear As New Button
    Dim forwardyear As New Button
    Dim backmonth As New Button
    Dim forwardmonth As New Button
    Dim year As New Button
    Dim month As New Button
    Dim RV As Date
    Dim Dmonth As Long
    Dim Dyear As Long
    Dim Dday As Long

    'some generic settings that can be used to customise the control
    Dim sundaylast As Boolean = True 'sets Sunday as last day of the week, else it's the first day
    Dim BC As System.Drawing.Color = Color.Black 'background color
    Dim SC As System.Drawing.Color = Color.DarkOrchid 'selectors color
    Dim CC As System.Drawing.Color = Color.Blue 'calendar buttons color
    Dim FC As System.Drawing.Color = Color.Black 'font color


    Sub New()

        'this section initialises the new form and adds the various controls
        'this allows the class te be dropped into any file without adding additional forms manually
        '
        'TIP:
        '   should you ever have to do something like this yourself:
        '   Add the fixed parts to a regular FORM
        '   Then go to PROJECT menu and select SHOW ALL FILES
        '   find the <yourFORM>.Designer.vb in your solution explorer
        '   Most of the code there can be pretty much copy pasted in here and further customised

        

        Me.cp.BackColor = BC
        Me.cp.Size = New Drawing.Size(240, 190)
        Me.cp.FormBorderStyle = FormBorderStyle.FixedDialog
        Me.cp.ControlBox = False

        'format the selection section
        'background
        Me.backyear.BackColor = SC
        Me.forwardyear.BackColor = SC
        Me.backmonth.BackColor = SC
        Me.forwardmonth.BackColor = SC
        Me.year.BackColor = SC
        Me.month.BackColor = SC

        'foreground / font
        Me.backyear.ForeColor = FC
        Me.forwardyear.ForeColor = FC
        Me.backmonth.ForeColor = FC
        Me.forwardmonth.ForeColor = FC
        Me.year.ForeColor = FC
        Me.month.ForeColor = FC

        'backbutton-year appearance and size
        Me.backyear.Location = New Point(10, 5)
        Me.backyear.FlatStyle = FlatStyle.Flat
        Me.backyear.Size = New System.Drawing.Size(61, 20)
        Me.backyear.FlatAppearance.BorderSize = 0

        'backbutton-month appearance and size
        Me.backmonth.Location = New Point(10, 30)
        Me.backmonth.FlatStyle = FlatStyle.Flat
        Me.backmonth.Size = New System.Drawing.Size(61, 20)
        Me.backmonth.FlatAppearance.BorderSize = 0

        'forwardbutton-year appearance and size
        Me.forwardyear.Location = New Point(165, 5)
        Me.forwardyear.FlatStyle = FlatStyle.Flat
        Me.forwardyear.Size = New System.Drawing.Size(61, 20)
        Me.forwardyear.FlatAppearance.BorderSize = 0

        'forwardbutton-month appearance and size
        Me.forwardmonth.Location = New Point(165, 30)
        Me.forwardmonth.FlatStyle = FlatStyle.Flat
        Me.forwardmonth.Size = New System.Drawing.Size(61, 20)
        Me.forwardmonth.FlatAppearance.BorderSize = 0

        'add arrows to the back and forward buttons
        Dim arrowdrawleft As New System.Drawing.Bitmap(50, 40)
        Dim arrowdrawright As New System.Drawing.Bitmap(50, 40)
        Dim left As Point() = {New Point(0, 19), New Point(50, 10), New Point(50, 27)} 'triangle left
        Dim right As Point() = {New Point(50, 19), New Point(0, 10), New Point(0, 27)} 'triangle right
        Dim blad As System.Drawing.Graphics 'object for image manipulation
        blad = System.Drawing.Graphics.FromImage(arrowdrawleft) 'import the arrowdrawleft bitmap
        blad.FillPolygon(Brushes.Black, left) 'draw the leftpointing triangle on the canvas
        Me.backmonth.Image = arrowdrawleft  'assign the left arrow to the button
        Me.backyear.Image = arrowdrawleft   'assign the left arrow to the button
        blad = System.Drawing.Graphics.FromImage(arrowdrawright) 'manipulate the rightpointing triangle canvas
        blad.FillPolygon(Brushes.Black, right) 'draw the rightpointing triangle on the canvas
        Me.forwardyear.Image = arrowdrawright   'assign the right pointing arrow to the button
        Me.forwardmonth.Image = arrowdrawright  'assign the right pointing arrow to the button

        blad.Dispose() 'image manipulation no longer needed

        'year "textbox" location and appearance
        '   prefer button over a real textbox, as textbox cannot easily be set to a fixed height
        Me.year.Location = New Point(76, 5)
        Me.year.FlatStyle = FlatStyle.Flat
        Me.year.FlatAppearance.BorderSize = 0
        Me.year.Size = New System.Drawing.Size(84, 20)
        Me.year.Font = New Font(Me.month.Font.Name, Me.month.Font.SizeInPoints, FontStyle.Bold, GraphicsUnit.Point)
        Me.year.Enabled = False

        'month "textbox" location and appearance
        Me.month.Location = New Point(76, 30)
        Me.month.FlatStyle = FlatStyle.Flat
        Me.month.FlatAppearance.BorderSize = 0
        Me.month.Size = New System.Drawing.Size(84, 20)
        Me.month.Font = New Font(Me.month.Font.Name, Me.month.Font.SizeInPoints, FontStyle.Bold, GraphicsUnit.Point)
        Me.month.Enabled = False

        'Add click-routines for the buttons
        AddHandler Me.backmonth.Click, AddressOf Me.DecMonth
        AddHandler Me.backyear.Click, AddressOf Me.DecYear
        AddHandler Me.forwardmonth.Click, AddressOf Me.IncMonth
        AddHandler Me.forwardyear.Click, AddressOf Me.IncYear

        'add all the selector controls to the form
        Me.cp.Controls.Add(Me.backyear)
        Me.cp.Controls.Add(Me.backmonth)
        Me.cp.Controls.Add(Me.forwardyear)
        Me.cp.Controls.Add(Me.forwardmonth)
        Me.cp.Controls.Add(Me.year)
        Me.cp.Controls.Add(Me.month)

        'add the calendar date buttons to the screen as a 7x6 matrix and format them
        For i As Long = 0 To 6
            For j As Long = 0 To 5
                Me.buttons(i, j) = New Button()
                Me.buttons(i, j).Size = New Drawing.Size(30, 20)
                Me.buttons(i, j).Location = New Point(10 + i * 31, 55 + 21 * j)
                Me.buttons(i, j).FlatStyle = FlatStyle.Popup
                Me.buttons(i, j).BackColor = CC
                Me.buttons(i, j).ForeColor = FC
                Me.buttons(i, j).Name = i.ToString + j.ToString
                AddHandler Me.buttons(i, j).Click, AddressOf Me.dateclicked
                Me.cp.Controls.Add(Me.buttons(i, j))
            Next j
        Next i

    End Sub

    Sub dateclicked(ByVal sender As System.Object, ByVal e As System.EventArgs)
        'handles clicking all of the calendar buttons to set the actual date
        Me.RV = DateAndTime.DateSerial(Dyear, Dmonth, Val(CType(sender, Button).Text)) 'set the selected date
        cp.DialogResult = DialogResult.OK 'close the form and allow program to go forward
    End Sub

    Sub DecMonth(ByVal sender As System.Object, ByVal e As System.EventArgs)
        'handles the month-back button click
        Dmonth = Dmonth - 1
        If Dmonth = 0 Then
            Dmonth = 12
            Dyear = Dyear - 1
        End If
        Me.BuildDisplay()
    End Sub
    Sub IncMonth(ByVal sender As System.Object, ByVal e As System.EventArgs)
        'handles the month-forward button click
        Dmonth = Dmonth + 1
        If Dmonth = 13 Then
            Dmonth = 1
            Dyear = Dyear + 1
        End If
        Me.BuildDisplay()
    End Sub
    Sub DecYear(ByVal sender As System.Object, ByVal e As System.EventArgs)
        'handles the year-back button click
        Dyear = Dyear - 1
        Me.BuildDisplay()
    End Sub
    Sub IncYear(ByVal sender As System.Object, ByVal e As System.EventArgs)
        'handles the year-forward button click
        Dyear = Dyear + 1
        Me.BuildDisplay()
    End Sub

    Public Function Show() As Date
        'the core interface start without additional parameters

        'set the form to todays date
        Me.Dmonth = Now().Month
        Me.Dyear = Now().Year
        Me.Dday = Now().Day
        'do the first display based on this date
        Me.BuildDisplay()
        'show the actual form
        Me.cp.ShowDialog()
        'return the choosen date
        Return Me.RV
    End Function

    Public Function Show(ByVal x As Long, ByVal y As Long) As Date
        'the core interface start with startposition

        'set the form to todays date
        Me.Dmonth = Now().Month
        Me.Dyear = Now().Year
        Me.Dday = Now().Day
        Me.cp.StartPosition = FormStartPosition.Manual
        Me.cp.Location = New Point(x, y)
        'do the first display based on this date
        Me.BuildDisplay()
        'show the actual form
        Me.cp.ShowDialog()
        'return the choosen date
        Return Me.RV
    End Function

    Sub BuildDisplay()

        'set the textual display
        Me.month.Text = MonthName(Dmonth)
        Me.year.Text = Dyear

        'clear buttons of text
        For i As Long = 0 To 6
            For j As Long = 0 To 5
                buttons(i, j).Text = ""
            Next j
        Next i

        'get base information for month

        Dim FD As Date
        Dim firstday As Integer
        Dim daysinmonth As Integer
        FD = DateAndTime.DateSerial(Dyear, Dmonth, 1)
        firstday = FD.DayOfWeek
        daysinmonth = Date.DaysInMonth(Dyear, Dmonth)

        'update day placement for sundayfirst / sundaylast
        If Me.sundaylast Then
            If firstday > 0 Then
                firstday = firstday - 1
            Else
                firstday = 6
            End If
        End If

        'fill the calendar
        Dim x As Integer
        Dim y As Integer
        For i As Integer = 0 To daysinmonth - 1
            x = (firstday + i) Mod 7
            y = Math.Truncate((firstday + i) / 7)
            buttons(x, y).Text = i + 1

            'highlight "today"
            If (i + 1) = Dday Then
                buttons(x, y).BackColor = Color.AntiqueWhite
            Else
                buttons(x, y).BackColor = cc
            End If
        Next i

        'hide empty buttons and display filled ones
        For i As Long = 0 To 6
            For j As Long = 0 To 5
                If buttons(i, j).Text = "" Then
                    buttons(i, j).Visible = False
                Else
                    buttons(i, j).Visible = True
                End If

            Next j
        Next i

    End Sub

End Class
 
Dag wampier,

Uw "highlight" code lijkt niet te werken? Maar geen probleem, ik heb ondertussen zelf al iets kunnen bewerkstelligen.;)

Onderstaande code (algoritme) bepaald de 5 veranderlijke feestdagen.

Code: 
 '
    'Berekenen op welke datum het Pasen zal zijn, voor eender welk jaar
    Private Function GetEasterDate(ByVal year As Integer) As Date
        Dim a As Integer
        Dim b As Integer
        Dim c As Integer
        Dim d As Integer
        Dim e As Integer
        Dim f As Integer
        Dim g As Integer
        Dim h As Integer
        Dim i As Integer
        Dim k As Integer
        Dim l As Integer
        Dim m As Integer
        Dim n As Integer
        Dim p As Integer
        If year < 1583 Then
            Err.Raise(5)
        Else
            ' Step 1: Divide the year by 19 and store the
            ' remainder in variable A.  Example: If the year
            ' is 2000, then A is initialized to 5.
            a = year Mod 19
            ' Step 2: Divide the year by 100.  Store the integer
            ' result in B and the remainder in C.
            b = year \ 100
            c = year Mod 100
            ' Step 3: Divide B (calculated above).  Store the
            ' integer result in D and the remainder in E.
            d = b \ 4
            e = b Mod 4
            ' Step 4: Divide (b+8)/25 and store the integer
            ' portion of the result in F.
            f = (b + 8) \ 25
            ' Step 5: Divide (b-f+1)/3 and store the integer
            ' portion of the result in G.
            g = (b - f + 1) \ 3
            ' Step 6: Divide (19a+b-d-g+15)/30 and store the
            ' remainder of the result in H.
            h = (19 * a + b - d - g + 15) Mod 30
            ' Step 7: Divide C by 4.  Store the integer result
            ' in I and the remainder in K.
            i = c \ 4
            k = c Mod 4
            ' Step 8: Divide (32+2e+2i-h-k) by 7.  Store the
            ' remainder of the result in L.
            l = (32 + 2 * e + 2 * i - h - k) Mod 7
            ' Step 9: Divide (a + 11h + 22l) by 451 and
            ' store the integer portion of the result in M.
            m = (a + 11 * h + 22 * l) \ 451
            ' Step 10: Divide (h + l - 7m + 114) by 31.  Store
            ' the integer portion of the result in N and the
            ' remainder in P.
            n = (h + l - 7 * m + 114) \ 31
            p = (h + l - 7 * m + 114) Mod 31
            ' At this point p+1 is the day on which Easter falls.
            ' n is 3 for March or 4 for April.
            Return DateSerial(year, n, p + 1)
        End If
    End Function


Vervolgens kon ik met weinig moeite de andere (Belgische) feestdagen aangeven

In de Sub "BuildDisplay" onder "fill the calendar" :


Code: 
 '
        'fill the calendar
        Dim x As Integer
        Dim y As Integer
        For i As Integer = 0 To daysinmonth - 1
            x = (firstday + i) Mod 7
            y = Math.Truncate((firstday + i) / 7)
            buttons(x, y).Text = i + 1
            '
            '***** TOEGEVOEGD ***********************************************************
            '
            'De datums bepalen v/d 5 veranderlijke (Belgische) Feestdagen
            'Vertrekkende vanaf "Pasen" (zie Functie "GetEasterDate")
            Dim Pasen As Date
            Pasen = GetEasterDate(Dyear)
            Dim Pasen2 As Date
            Pasen2 = GetEasterDate(Dyear).AddDays(1)
            Dim Hemelv As Date
            Hemelv = GetEasterDate(Dyear).AddDays(+39)
            Dim Pinkster As Date
            Pinkster = GetEasterDate(Dyear).AddDays(49)
            Dim Pinkster2 As Date
            Pinkster2 = GetEasterDate(Dyear).AddDays(50)
            'De datums v/d overige (vaste) Feestdagen opgeven
            Dim Nieuwjaar As Date = DateSerial(Dyear, 1, 1)
            Dim FvdArbeid As Date = DateSerial(Dyear, 5, 1)
            Dim Nationaal As Date = DateSerial(Dyear, 7, 21)
            Dim OLVhemelv As Date = DateSerial(Dyear, 8, 15)
            Dim AllerHeil As Date = DateSerial(Dyear, 11, 1)
            Dim Wapenstil As Date = DateSerial(Dyear, 11, 11)
            Dim Kerstmis As Date = DateSerial(Dyear, 12, 25)
            'De niet-officiële feestdagen opgeven
            Dim VlaamseFD As Date = DateSerial(Dyear, 7, 11)
            Dim Allerziel As Date = DateSerial(Dyear, 11, 2)
            'Andere (belangrijke) dagen opgeven
            Dim Driekoning As Date = DateSerial(Dyear, 1, 6)
            Dim Valentyn As Date = DateSerial(Dyear, 2, 14)
            Dim Haloween As Date = DateSerial(Dyear, 10, 31)
            Dim Sintklaas As Date = DateSerial(Dyear, 12, 6)
            Dim Kerstdag2 As Date = DateSerial(Dyear, 12, 26)
            '
            'De feestdagen tonen (Button in andere kleur)
            Dim Datum As Date
            Datum = buttons(x, y).Text & "/" & Dmonth & "/" & Dyear
            '
            If Datum = Nieuwjaar Or Datum = FvdArbeid Or Datum = Pasen Or Datum = Pasen2 Or Datum = Hemelv _
            Or Datum = Pinkster Or Datum = Pinkster2 Or Datum = Nationaal Or Datum = OLVhemelv Or Datum = AllerHeil _
            Or Datum = Wapenstil Or Datum = Kerstmis Or Datum = VlaamseFD Or Datum = Allerziel Or Datum = Driekoning _
            Or Datum = Valentyn Or Datum = Haloween Or Datum = Sintklaas Or Datum = Kerstdag2 Then
                buttons(x, y).BackColor = Color.Azure
            Else
                buttons(x, y).BackColor = Color.Bisque
            End If
            '
            'De huidige datum doen opvallen in kleur geel (Highlight today)            '
            If Datum = Format(Today, "dd/MM/yyyy") Then
                buttons(x, y).BackColor = Color.Yellow
            End If
            '****************************************************************************
        Next i
        '
        For i As Long = 0 To 6
            For j As Long = 0 To 5
                If buttons(i, j).Text = "" Then
                    buttons(i, j).Visible = False
                Else
                    buttons(i, j).Visible = True
                End If
            Next j
        Next i
        '
    End Sub


Hiermee ben ik bereikt wat ik wou en kan deze vraag op opgelost gezet worden.

Tenzij jij hiermee nog verder wil werken. Laat maar weten.

gr. Jan
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan