Calendar Control (Zelf maandkalender maken)

[Jan92]

Hallo,

Ik heb ooit eens code gevonden op een of andere website om een eigen, geprogrameerde maandkalender te maken.
Ik heb dit toen bewaard voor het geval het eens van pas zou komen en nu is de tijd gekomen dat ik het inderdaad kan gebruiken.
Deze code werkt voor 90% correct, maar bij het invullen van de dagen voor de maand februari van een schrikkeljaar, werkt het niet.
Mijn vraag bij deze is dus, kan iemand mij helpen deze code aan te passen want zelf heb ik te weinig kennis om de code volledig te
begrijpen en aan te passen. Alvast bedankt voor de interesse.
Het resultaat van deze code is volgende afbeelding:

Public Class UserMainForm
    Dim iMonth As Integer = -1
    Dim i As Integer = Now.Month
    Dim yearNr As Integer = 2012
    Dim ArrowRight As Boolean = False
    Dim ArrowLeft As Boolean = False
    Dim x1 As Date

    Public Function increment()

        If i = 0 Then
            i = i + 1
        ElseIf i = 13 Then
            i = 2
        Else
            i = i + 1
        End If

        Return i
    End Function


    Public Function decrement()

        If i = 0 Then
            i = i - 1
        ElseIf i = 1 Then
            i = 12
        Else
            i = i - 1
        End If

        Return i
    End Function



    Function HideEmptyButtons()


        If su1.Text = "" Then
            su1.Visible = False
        ElseIf su1.Text <> "" Then
            su1.Visible = True
        End If
        If su2.Text = "" Then
            su2.Visible = False
        ElseIf su2.Text <> "" Then
            su2.Visible = True
        End If
        If su3.Text = "" Then
            su3.Visible = False
        ElseIf su3.Text <> "" Then
            su3.Visible = True
        End If
        If su4.Text = "" Then
            su4.Visible = False
        ElseIf su4.Text <> "" Then
            su4.Visible = True
        End If
        If su5.Text = "" Then
            su5.Visible = False
        ElseIf su5.Text <> "" Then
            su5.Visible = True
        End If
        If su6.Text = "" Then
            su6.Visible = False
        ElseIf su6.Text <> "" Then
            su6.Visible = True
        End If
        If m1.Text = "" Then
            m1.Visible = False
        ElseIf m1.Text <> "" Then
            m1.Visible = True
        End If
        If m2.Text = "" Then
            m2.Visible = False
        ElseIf m2.Text <> "" Then
            m2.Visible = True
        End If
        If m3.Text = "" Then
            m3.Visible = False
        ElseIf m3.Text <> "" Then
            m3.Visible = True
        End If
        If m4.Text = "" Then
            m4.Visible = False
        ElseIf m4.Text <> "" Then
            m4.Visible = True
        End If
        If m5.Text = "" Then
            m5.Visible = False
        ElseIf m5.Text <> "" Then
            m5.Visible = True
        End If
        If m6.Text = "" Then
            m6.Visible = False
        ElseIf m6.Text <> "" Then
            m6.Visible = True
        End If
        If tu1.Text = "" Then
            tu1.Visible = False
        ElseIf tu1.Text <> "" Then
            tu1.Visible = True
        End If
        If tu2.Text = "" Then
            tu2.Visible = False
        ElseIf tu2.Text <> "" Then
            tu2.Visible = True
        End If
        If tu3.Text = "" Then
            tu3.Visible = False
        ElseIf tu3.Text <> "" Then
            tu3.Visible = True
        End If
        If tu4.Text = "" Then
            tu4.Visible = False
        ElseIf tu4.Text <> "" Then
            tu4.Visible = True
        End If
        If tu5.Text = "" Then
            tu5.Visible = False
        ElseIf tu5.Text <> "" Then
            tu5.Visible = True
        End If
        If tu6.Text = "" Then
            tu6.Visible = False
        ElseIf tu6.Text <> "" Then
            tu6.Visible = True
        End If
        If w1.Text = "" Then
            w1.Visible = False
        ElseIf w1.Text <> "" Then
            w1.Visible = True
        End If
        If w2.Text = "" Then
            w2.Visible = False
        ElseIf w2.Text <> "" Then
            w2.Visible = True
        End If
        If w3.Text = "" Then
            w3.Visible = False
        ElseIf w3.Text <> "" Then
            w3.Visible = True
        End If
        If w4.Text = "" Then
            w4.Visible = False
        ElseIf w4.Text <> "" Then
            w4.Visible = True
        End If
        If w5.Text = "" Then
            w5.Visible = False
        ElseIf w5.Text <> "" Then
            w5.Visible = True
        End If
        If w6.Text = "" Then
            w6.Visible = False
        ElseIf w6.Text <> "" Then
            w6.Visible = True
        End If
        If th1.Text = "" Then
            th1.Visible = False
        ElseIf th1.Text <> "" Then
            th1.Visible = True
        End If
        If th2.Text = "" Then
            th2.Visible = False
        ElseIf th2.Text <> "" Then
            th2.Visible = True
        End If
        If th3.Text = "" Then
            th3.Visible = False
        ElseIf th3.Text <> "" Then
            th3.Visible = True
        End If
        If th4.Text = "" Then
            th4.Visible = False
        ElseIf th4.Text <> "" Then
            th4.Visible = True
        End If
        If th5.Text = "" Then
            th5.Visible = False
        ElseIf th5.Text <> "" Then
            th5.Visible = True
        End If
        If th6.Text = "" Then
            th6.Visible = False
        ElseIf th6.Text <> "" Then
            th6.Visible = True
        End If
        If f1.Text = "" Then
            f1.Visible = False
        ElseIf f1.Text <> "" Then
            f1.Visible = True
        End If
        If f2.Text = "" Then
            f2.Visible = False
        ElseIf f2.Text <> "" Then
            f2.Visible = True
        End If
        If f3.Text = "" Then
            f3.Visible = False
        ElseIf f3.Text <> "" Then
            f3.Visible = True
        End If
        If f4.Text = "" Then
            f4.Visible = False
        ElseIf f4.Text <> "" Then
            f4.Visible = True
        End If
        If f5.Text = "" Then
            f5.Visible = False
        ElseIf f5.Text <> "" Then
            f5.Visible = True
        End If
        If f6.Text = "" Then
            f6.Visible = False
        ElseIf f6.Text <> "" Then
            f6.Visible = True
        End If
        If sa1.Text = "" Then
            sa1.Visible = False
        ElseIf sa1.Text <> "" Then
            sa1.Visible = True
        End If
        If sa2.Text = "" Then
            sa2.Visible = False
        ElseIf sa2.Text <> "" Then
            sa2.Visible = True
        End If
        If sa3.Text = "" Then
            sa3.Visible = False
        ElseIf sa3.Text <> "" Then
            sa3.Visible = True
        End If
        If sa4.Text = "" Then
            sa4.Visible = False
        ElseIf sa4.Text <> "" Then
            sa4.Visible = True
        End If
        If sa5.Text = "" Then
            sa5.Visible = False
        ElseIf sa5.Text <> "" Then
            sa5.Visible = True
        End If
        If sa6.Text = "" Then
            sa6.Visible = False
        ElseIf sa6.Text <> "" Then
            sa6.Visible = True
        End If
    End Function

    Private Sub MonthForward_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MonthForward.Click
        Dim DisplayedMonth = Now.Month
        DisplayedMonth = increment()
        ArrowRight = True
        Dim X = Now.AddDays((Now.Day - 1) * -1).AddMonths(i - Now.Month)
        Dim ldate As Date
        Dim Selected As Integer
        Dim bLeapYear As Boolean = Date.IsLeapYear(yearNr)


        On Error Resume Next
        Me.clearall()
        MonthName.Text = monthstr(ldate.Month)
        Dim fdate As DayOfWeek = GetFirstOfMonthDay(X)
        Dim idate As Integer = 1                                            
        Dim row As Integer = 1                                              

        Do
            getlabel(fdate, row).Text = idate
            If idate = Selected Then
                getlabel(fdate, row).Color = LCARS.LCARScolorStyles.PrimaryFunction 'sets de background color of the current day cell
            End If
            If fdate = DayOfWeek.Saturday Then
                row += 1                                                   
            End If
            fdate = tdate(fdate)                                            
            idate += 1                                                      
            If idate = Date.DaysInMonth((X).Year, (X).Month) + 1 Then    
                Exit Do
            End If
        Loop

        If (DisplayedMonth = 13) Then
            DisplayedMonth = 1
        End If
        If (DisplayedMonth = 1) And (ArrowRight = True) Then
            yearNr = yearNr + 1
        End If

        If DisplayedMonth = 1 Then
            MonthName.Text = "JANUARY"
        End If
        If DisplayedMonth = 2 Then
            MonthName.Text = "FEBRUARY"
        End If
        If DisplayedMonth = 3 Then
            MonthName.Text = "MARCH"
        End If
        If DisplayedMonth = 4 Then
            MonthName.Text = "APRIL"
        End If
        If DisplayedMonth = 5 Then
            MonthName.Text = "MAY"
        End If
        If DisplayedMonth = 6 Then
            MonthName.Text = "JUNE"
        End If
        If DisplayedMonth = 7 Then
            MonthName.Text = "JULY"
        End If
        If DisplayedMonth = 8 Then
            MonthName.Text = "AUGUST"
        End If
        If DisplayedMonth = 9 Then
            MonthName.Text = "SEPTEMBER"
        End If
        If DisplayedMonth = 10 Then
            MonthName.Text = "OCTOBER"
        End If
        If DisplayedMonth = 11 Then
            MonthName.Text = "NOVEMBER"
        End If
        If DisplayedMonth = 12 Then
            MonthName.Text = "DECEMBER"
        End If

        HideEmptyButtons()
        YearNumber.Text = yearNr
    End Sub


    Private Sub MonthBackward_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MonthBackward.Click
        Dim DisplayedMonth = Now.Month
        DisplayedMonth = decrement()
        ArrowLeft = True
        Dim X = Now.AddDays((Now.Day - 1) * -1).AddMonths(i - Now.Month)
        Dim ldate As Date
        Dim Selected As Integer

        On Error Resume Next
        Me.clearall()
        MonthName.Text = monthstr(ldate.Month)
        Dim fdate As DayOfWeek = GetFirstOfMonthDay(X)
        Dim idate As Integer = 1                                             
        Dim row As Integer = 1                                               
        Do
            getlabel(fdate, row).Text = idate
            If idate = Selected Then
                getlabel(fdate, row).Color = LCARS.LCARScolorStyles.PrimaryFunction 'sets de background color of the current day cell
            End If
            If fdate = DayOfWeek.Saturday Then
                row += 1                                                     
            End If
            fdate = tdate(fdate)                                            
            idate += 1                                                       
            If idate = Date.DaysInMonth((X).Year, (X).Month) + 1 Then   
                Exit Do
            End If
        Loop

        If (DisplayedMonth = 13) Then
            DisplayedMonth = 1
        End If
        If (DisplayedMonth = 12) And (ArrowLeft = True) Then
            yearNr = yearNr - 1
        End If

        If DisplayedMonth = 1 Then
            MonthName.Text = "JANUARY"
        End If
        If DisplayedMonth = 2 Then
            MonthName.Text = "FEBRUARY"
        End If
        If DisplayedMonth = 3 Then
            MonthName.Text = "MARCH"
        End If
        If DisplayedMonth = 4 Then
            MonthName.Text = "APRIL"
        End If
        If DisplayedMonth = 5 Then
            MonthName.Text = "MAY"
        End If
        If DisplayedMonth = 6 Then
            MonthName.Text = "JUNE"
        End If
        If DisplayedMonth = 7 Then
            MonthName.Text = "JULY"
        End If
        If DisplayedMonth = 8 Then
            MonthName.Text = "AUGUST"
        End If
        If DisplayedMonth = 9 Then
            MonthName.Text = "SEPTEMBER"
        End If
        If DisplayedMonth = 10 Then
            MonthName.Text = "OCTOBER"
        End If
        If DisplayedMonth = 11 Then
            MonthName.Text = "NOVEMBER"
        End If
        If DisplayedMonth = 12 Then
            MonthName.Text = "DECEMBER"
        End If
        HideEmptyButtons()
        YearNumber.Text = yearNr
    End Sub



    Function dYear()
        Dim a = Now.AddYears(-1)
        x1 = a - 1
        Return x1
    End Function


    Private Sub YearBackward_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles YearBackward.Click
        yearNr = yearNr - 1
        YearNumber.Text = yearNr

        Dim DisplayedMonth = Now.Month
        Dim ldate As Date
        Dim Selected As Integer

        On Error Resume Next
        Me.clearall()
        MonthName.Text = monthstr(ldate.Month)
        Dim fdate As DayOfWeek = GetFirstOfMonthDay(x1)
        Dim idate As Integer = 1                                             
        Dim row As Integer = 1                                               
        Do
            getlabel(fdate, row).Text = idate
            If idate = Selected Then
                getlabel(fdate, row).Color = LCARS.LCARScolorStyles.PrimaryFunction 
            End If
            If fdate = DayOfWeek.Saturday Then
                row += 1                                                    
            End If
            fdate = tdate(fdate)                                             
            idate += 1                                                      
            If idate = Date.DaysInMonth((x1).Year, (x1).Month) + 1 Then    
                Exit Do
            End If
        Loop

        If (DisplayedMonth = 13) Then
            DisplayedMonth = 1
        End If
        If (DisplayedMonth = 1) And (ArrowRight = True) Then
            yearNr = yearNr + 1
        End If

        If DisplayedMonth = 1 Then
            MonthName.Text = "JANUARY"
        End If
        If DisplayedMonth = 2 Then
            MonthName.Text = "FEBRUARY"
        End If
        If DisplayedMonth = 3 Then
            MonthName.Text = "MARCH"
        End If
        If DisplayedMonth = 4 Then
            MonthName.Text = "APRIL"
        End If
        If DisplayedMonth = 5 Then
            MonthName.Text = "MAY"
        End If
        If DisplayedMonth = 6 Then
            MonthName.Text = "JUNE"
        End If
        If DisplayedMonth = 7 Then
            MonthName.Text = "JULY"
        End If
        If DisplayedMonth = 8 Then
            MonthName.Text = "AUGUST"
        End If
        If DisplayedMonth = 9 Then
            MonthName.Text = "SEPTEMBER"
        End If
        If DisplayedMonth = 10 Then
            MonthName.Text = "OCTOBER"
        End If
        If DisplayedMonth = 11 Then
            MonthName.Text = "NOVEMBER"
        End If
        If DisplayedMonth = 12 Then
            MonthName.Text = "DECEMBER"
        End If

        HideEmptyButtons()
    End Sub

    Private Sub YearForward_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles YearForward.Click
        yearNr = yearNr + 1
        YearNumber.Text = yearNr
    End Sub


    Public Sub ReloadCal(ByVal ldate As Date, ByVal Selected As Integer)
        On Error Resume Next
        Me.clearall()
        MonthName.Text = monthstr(ldate.Month)
        Dim fdate As DayOfWeek = GetFirstOfMonthDay(ldate)
        Dim idate As Integer = 1                                             
        Dim row As Integer = 1                                               
        Do
            getlabel(fdate, row).Text = idate
            If idate = Selected Then
                getlabel(fdate, row).Color = LCARS.LCARScolorStyles.PrimaryFunction 
            End If
            If fdate = DayOfWeek.Saturday Then
                row += 1                                                    
            End If
            fdate = tdate(fdate)                                            
            idate += 1                                                       
            If idate = Date.DaysInMonth((ldate).Year, (ldate).Month) + 1 Then   
                Exit Do
            End If
        Loop
    End Sub


    Sub clearall()
        su1.Text = ""
        su2.Text = ""
        su3.Text = ""
        su4.Text = ""
        su5.Text = ""
        su6.Text = ""

        m1.Text = ""
        m2.Text = ""
        m3.Text = ""
        m4.Text = ""
        m5.Text = ""
        m6.Text = ""

        tu1.Text = ""
        tu2.Text = ""
        tu3.Text = ""
        tu4.Text = ""
        tu5.Text = ""
        tu6.Text = ""

        w1.Text = ""
        w2.Text = ""
        w3.Text = ""
        w4.Text = ""
        w5.Text = ""
        w6.Text = ""

        th1.Text = ""
        th2.Text = ""
        th3.Text = ""
        th4.Text = ""
        th5.Text = ""
        th6.Text = ""

        f1.Text = ""
        f2.Text = ""
        f3.Text = ""
        f4.Text = ""
        f5.Text = ""
        f6.Text = ""

        sa1.Text = ""
        sa2.Text = ""
        sa3.Text = ""
        sa4.Text = ""
        sa5.Text = ""
        sa6.Text = ""
    End Sub

    Function getlabel(ByVal day As DayOfWeek, ByVal row As Integer) As LCARS.Controls.FlatButton
        Select Case day
            Case DayOfWeek.Sunday
                Select Case row
                    Case 1
                        Return su1
                    Case 2
                        Return su2
                    Case 3
                        Return su3
                    Case 4
                        Return su4
                    Case 5
                        Return su5
                    Case 6
                        Return su6
                End Select
            Case DayOfWeek.Monday
                Select Case row
                    Case 1
                        Return m1
                    Case 2
                        Return m2
                    Case 3
                        Return m3
                    Case 4
                        Return m4
                    Case 5
                        Return m5
                    Case 6
                        Return m6
                End Select
            Case DayOfWeek.Tuesday
                Select Case row
                    Case 1
                        Return tu1
                    Case 2
                        Return tu2
                    Case 3
                        Return tu3
                    Case 4
                        Return tu4
                    Case 5
                        Return tu5
                    Case 6
                        Return tu6
                End Select
            Case DayOfWeek.Wednesday
                Select Case row
                    Case 1
                        Return w1
                    Case 2
                        Return w2
                    Case 3
                        Return w3
                    Case 4
                        Return w4
                    Case 5
                        Return w5
                    Case 6
                        Return w6
                End Select
            Case DayOfWeek.Thursday
                Select Case row
                    Case 1
                        Return th1
                    Case 2
                        Return th2
                    Case 3
                        Return th3
                    Case 4
                        Return th4
                    Case 5
                        Return th5
                    Case 6
                        Return th6
                End Select
            Case DayOfWeek.Friday
                Select Case row
                    Case 1
                        Return f1
                    Case 2
                        Return f2
                    Case 3
                        Return f3
                    Case 4
                        Return f4
                    Case 5
                        Return f5
                    Case 6
                        Return f6
                End Select
            Case DayOfWeek.Saturday
                Select Case row
                    Case 1
                        Return sa1
                    Case 2
                        Return sa2
                    Case 3
                        Return sa3
                    Case 4
                        Return sa4
                    Case 5
                        Return sa5
                    Case 6
                        Return sa6
                End Select
        End Select
    End Function

    Private Function GetFirstOfMonthDay(ByVal ThisDay As Date) As DayOfWeek
        Dim tday As DayOfWeek = ThisDay.DayOfWeek
        Dim tint As Integer = ThisDay.Day
        If tint = 1 Then
            Return tday
            Exit Function
        End If
        Do
            tint -= 1
            tday = ydate(tday)
            If tint = 1 Then Exit Do
        Loop
        Return tday
    End Function

    Private Function ydate(ByVal tday As DayOfWeek) As DayOfWeek
        Dim rday As DayOfWeek
        Select Case tday
            Case DayOfWeek.Sunday
                rday = DayOfWeek.Saturday
            Case DayOfWeek.Monday
                rday = DayOfWeek.Sunday
            Case DayOfWeek.Tuesday
                rday = DayOfWeek.Monday
            Case DayOfWeek.Wednesday
                rday = DayOfWeek.Tuesday
            Case DayOfWeek.Thursday
                rday = DayOfWeek.Wednesday
            Case DayOfWeek.Friday
                rday = DayOfWeek.Thursday
            Case DayOfWeek.Saturday
                rday = DayOfWeek.Friday
        End Select
        Return rday
    End Function

    Private Function tdate(ByVal tday As DayOfWeek) As DayOfWeek
        Dim rday As DayOfWeek
        Select Case tday
            Case DayOfWeek.Sunday
                rday = DayOfWeek.Monday
            Case DayOfWeek.Monday
                rday = DayOfWeek.Tuesday
            Case DayOfWeek.Tuesday
                rday = DayOfWeek.Wednesday
            Case DayOfWeek.Wednesday
                rday = DayOfWeek.Thursday
            Case DayOfWeek.Thursday
                rday = DayOfWeek.Friday
            Case DayOfWeek.Friday
                rday = DayOfWeek.Saturday
            Case DayOfWeek.Saturday
                rday = DayOfWeek.Sunday
        End Select
        Return rday
    End Function

    Public Function monthstr(ByVal month As Integer) As String
        Select Case month
            Case 1
                Return "January"
            Case 2
                Return "Febuary"
            Case 3
                Return "March"
            Case 4
                Return "April"
            Case 5
                Return "May"
            Case 6
                Return "June"
            Case 7
                Return "July"
            Case 8
                Return "August"
            Case 9
                Return "September"
            Case 10
                Return "October"
            Case 11
                Return "November"
            Case 12
                Return "December"
        End Select
    End Function


    Private Sub UserMainForm_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        ReloadCal(Date.Today, Date.Today.Day)
        YearNumber.Text = Now.Year
        HideEmptyButtons()

     End Sub

End Class

 

[Maximvdw]

Heb je de volledige code (ook met design files met labels, ..)

Je kan is proberen bij je MonthForward/Back. om na Me.Controls.Clear() te zorgen dat je
de "getlabel(..) van de dag die er niet mag zijn, deze label.visible = false. doet.

Loopt het fout met het selecteren van die dag, of met het tonen (word de dag getoond die er niet mag zijn)?

gr,
Maxim

 

[Jan92]

Hallo, Maximvdw

Bedankt voor uw reactie

Alle labels en buttons werden aangemaakt in design form, dus geen code hiervoor.
Ik denk ook dat je de vraag niet goed begrepen hebt.
De weergave van de dagnummers werken perfect voor elke mogelijke maand en jaar, met uitzondering van de februari maanden in een schrikkeljaar.
Dus de labels die niet moeten zichbaar zijn, zijn ook niet zichbaar.
Maar als ik via de buttons "forward" of "backwards" bv naar de maand februari van 2012 of februari 2016 ga, zouden er dus 29 dagen moeten getoond worden, gezien dit schrikkeljaren (Leapyear) zijn maar er worden toch maar 28 dagen getoond.
Het gaat er hem dus niet om van labels onzichbaar te maken maar om voor die schrikkeljaren een label extra te tonen.
En het is juist het concept van die "Getlabels" die ik niet begrijp.
Tevens staat er in de button-code bij de "montforward" click event de regel "Dim bLeapYear As Boolean = Date.IsLeapYear(yearNr)" maar ik zie verder in de code nergens een verwijzing naar die "bLeapYear as Boolean" ?

groetjes, Jan

 

[wampier]

Ik vind het altijd sympathiek als mensen code gratis delen, maar delen van deze code zijn werkelijk tenenkrommend.

tenzij "Date.DaysInMonth()" het verkeerde aantal dagen teruggeeft zou het echter wel goed moeten gaan

 

[Jan92]

Welkom wampier

Ik kan je zeker geen ongelijk geven betreffende deze code, maar zoals ik al opmerkte, deze komt niet van mijzelf.
Ik probeerde er enkel de fouten uit te halen, maar zonder suc6, daarom zoek ik hulp bij gevorderde programmeurs.
De fout die ik er probeer uit te halen heeft enkel betrekking op de schrikkeljaren en voor zover ik de code kan
doorgronden, is er hierop geen kontrole.? Tevens heb ik nu pas ontdekt dat er in de functie voor het schrikkeljaar
een fout weergegeven wordt.

Function dYear()
        Dim x1 As Date
        Dim a = Now.AddYears(-1)
        x1 = a - 1
        Return x1
    End Function

Ik krijg hier de foutmelding "Operator '-' is not defined for types 'Date' and 'Integer'
Dus, x1 = a - 1 werkt niet.

gr, Jan

 

[wampier]

Ik vermoed dat hier ergens inderdaad de fout zal zitten. Zoals ik al aangaf de "daysinmonth" functie zou in principe correct de schrikkeljaren af moeten vangen, tenzij die gevoerd wordt met het verkeerde jaar.

Je kunt een messagebox of debug toevoegen en kijken of de datum die gevraagd wordt in een februari wel overeenkomt met het echte jaar

 

[Jan92]

Beste wampier

Misschien kan je met het volgende iets aanvangen om mij verder te helpen:
Ik heb eens de systeemkalender gewijzigd naar februari 2012 en vervolgens nog naar enkele andere schrikkeljaren (2016,2020,2024)
en telkens ik dan het progje run in debug mode, werkt alles wèl correct en krijg ik telkens 29 dagen in de maanden februari.
Maar wat ik infeite wil is dat dit altijd zo is, zelfs als het jaar v/d systeemkalender geen schrikkeljaar is, en ik met de buttons navigeer
naar een schrikkeljaar, dat ik dan toch 29 dagen heb in februari.
gr. Jan

 

[wampier]

Zoals ik al aangaf er gaat ergens iets fout met het doorgeven van de gewenste datum. Heb je ergens nog de volledige source inclusief de resources? Het is zo moeilijk door de sources lopen.

 

[Jan92]

Huh? Wat is dat voor zever van "btwhs6bnsj" ?

Beste wampier,
Ik begrijp je vraag niet goed.. recources ?
Als je daarmee bedoeld, de oorspronkelijk code zoals ik ze gevonden heb op het internet,
dan is alle code die ik hier gezet heb de volledige recource.
Anders moet je even verduidelijken.
gr. Jan

 

[wampier]

de resources bevatten ook de buttons en het form etc.

 

[Jan92]

@ wampier

Sorry, alles is aangemaakt in design mode.

Als je het zelf allemaal eens wil uittesten vrees ik dat je het zelf zal moeten aanmaken.

42 labels rangschikken in 7 kolommen en 6 rijen voor de dagnummers

1 label voor weergave v/d maand, 1 label voor weergave v/h jaar en 4 buttons voor navigatie van jaar en maand

Volgens deze code, staat de zondag echter als eerste dag v/d week (kolom 1) en zaterdag (kolom 6) als laatste!

De namen voor de daglabels zijn vervolgens, su1, su2, enz... (Dit is terug te vinden in de code)

Ook de benamingen van de andere labels en buttons...

gr. Jan

 

[MartinJM]

Hoi,

Als je in de solution explorer drukt op het knopje "Show All Files", dan op het plusje naast de formnaam drukt en dan dubbelklikt op [formnaam].designer.vb, dan staat daar de code die de designer heeft gemaakt.

Die kunnen wij dan gebruiken om snel het form na te maken.

MartinJM

 

[wampier]

Zie opmerking martin. Als ik het zelf na ga maken, maak ik het wel helemaal opnieuw . Als je namelijk de buttons dynamisch maakt met een matrix kun je vrij de begindag e.d. instellen en kun je zeer eenvoudig alles leegmaken en vullen.

 

[Jan92]

@MartinJM
Bedankt zeg, weeral iets bijgeleerd.
Hierbij de code:

<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()> _
Partial Class Form1
    Inherits System.Windows.Forms.Form

    'Form overrides dispose to clean up the component list.
    <System.Diagnostics.DebuggerNonUserCode()> _
    Protected Overrides Sub Dispose(ByVal disposing As Boolean)
        Try
            If disposing AndAlso components IsNot Nothing Then
                components.Dispose()
            End If
        Finally
            MyBase.Dispose(disposing)
        End Try
    End Sub

    'Required by the Windows Form Designer
    Private components As System.ComponentModel.IContainer

    'NOTE: The following procedure is required by the Windows Form Designer
    'It can be modified using the Windows Form Designer.  
    'Do not modify it using the code editor.
    <System.Diagnostics.DebuggerStepThrough()> _
    Private Sub InitializeComponent()
        Me.MonthName = New System.Windows.Forms.TextBox
        Me.YearNumber = New System.Windows.Forms.TextBox
        Me.MonthForward = New System.Windows.Forms.Button
        Me.MonthBackward = New System.Windows.Forms.Button
        Me.su1 = New System.Windows.Forms.TextBox
        Me.su2 = New System.Windows.Forms.TextBox
        Me.su3 = New System.Windows.Forms.TextBox
        Me.su4 = New System.Windows.Forms.TextBox
        Me.su5 = New System.Windows.Forms.TextBox
        Me.su6 = New System.Windows.Forms.TextBox
        Me.m1 = New System.Windows.Forms.TextBox
        Me.m2 = New System.Windows.Forms.TextBox
        Me.m3 = New System.Windows.Forms.TextBox
        Me.m4 = New System.Windows.Forms.TextBox
        Me.m5 = New System.Windows.Forms.TextBox
        Me.m6 = New System.Windows.Forms.TextBox
        Me.tu1 = New System.Windows.Forms.TextBox
        Me.tu2 = New System.Windows.Forms.TextBox
        Me.tu3 = New System.Windows.Forms.TextBox
        Me.tu4 = New System.Windows.Forms.TextBox
        Me.tu5 = New System.Windows.Forms.TextBox
        Me.tu6 = New System.Windows.Forms.TextBox
        Me.w1 = New System.Windows.Forms.TextBox
        Me.w2 = New System.Windows.Forms.TextBox
        Me.w3 = New System.Windows.Forms.TextBox
        Me.w4 = New System.Windows.Forms.TextBox
        Me.w5 = New System.Windows.Forms.TextBox
        Me.w6 = New System.Windows.Forms.TextBox
        Me.th1 = New System.Windows.Forms.TextBox
        Me.th2 = New System.Windows.Forms.TextBox
        Me.th3 = New System.Windows.Forms.TextBox
        Me.th4 = New System.Windows.Forms.TextBox
        Me.th5 = New System.Windows.Forms.TextBox
        Me.th6 = New System.Windows.Forms.TextBox
        Me.f1 = New System.Windows.Forms.TextBox
        Me.f2 = New System.Windows.Forms.TextBox
        Me.f3 = New System.Windows.Forms.TextBox
        Me.f4 = New System.Windows.Forms.TextBox
        Me.f5 = New System.Windows.Forms.TextBox
        Me.f6 = New System.Windows.Forms.TextBox
        Me.sa1 = New System.Windows.Forms.TextBox
        Me.sa2 = New System.Windows.Forms.TextBox
        Me.sa3 = New System.Windows.Forms.TextBox
        Me.sa4 = New System.Windows.Forms.TextBox
        Me.sa5 = New System.Windows.Forms.TextBox
        Me.sa6 = New System.Windows.Forms.TextBox
        Me.TextBox1 = New System.Windows.Forms.TextBox
        Me.TextBox2 = New System.Windows.Forms.TextBox
        Me.TextBox3 = New System.Windows.Forms.TextBox
        Me.TextBox4 = New System.Windows.Forms.TextBox
        Me.TextBox5 = New System.Windows.Forms.TextBox
        Me.TextBox6 = New System.Windows.Forms.TextBox
        Me.TextBox7 = New System.Windows.Forms.TextBox
        Me.YearBackward = New System.Windows.Forms.Button
        Me.YearForward = New System.Windows.Forms.Button
        Me.SuspendLayout()
        '
        'MonthName
        '
        Me.MonthName.Location = New System.Drawing.Point(439, 39)
        Me.MonthName.Name = "MonthName"
        Me.MonthName.Size = New System.Drawing.Size(100, 20)
        Me.MonthName.TabIndex = 0
        '
        'YearNumber
        '
        Me.YearNumber.Location = New System.Drawing.Point(439, 13)
        Me.YearNumber.Name = "YearNumber"
        Me.YearNumber.Size = New System.Drawing.Size(100, 20)
        Me.YearNumber.TabIndex = 1
        '
        'MonthForward
        '
        Me.MonthForward.Location = New System.Drawing.Point(548, 37)
        Me.MonthForward.Name = "MonthForward"
        Me.MonthForward.Size = New System.Drawing.Size(75, 23)
        Me.MonthForward.TabIndex = 2
        Me.MonthForward.Text = "MNext"
        Me.MonthForward.UseVisualStyleBackColor = True
        '
        'MonthBackward
        '
        Me.MonthBackward.Location = New System.Drawing.Point(363, 37)
        Me.MonthBackward.Name = "MonthBackward"
        Me.MonthBackward.Size = New System.Drawing.Size(70, 23)
        Me.MonthBackward.TabIndex = 3
        Me.MonthBackward.Text = "MPrev"
        Me.MonthBackward.UseVisualStyleBackColor = True
        '
        'su1
        '
        Me.su1.Location = New System.Drawing.Point(363, 90)
        Me.su1.Name = "su1"
        Me.su1.Size = New System.Drawing.Size(32, 20)
        Me.su1.TabIndex = 6
        '
        'su2
        '
        Me.su2.Location = New System.Drawing.Point(363, 116)
        Me.su2.Name = "su2"
        Me.su2.Size = New System.Drawing.Size(32, 20)
        Me.su2.TabIndex = 7
        '
        'su3
        '
        Me.su3.Location = New System.Drawing.Point(363, 142)
        Me.su3.Name = "su3"
        Me.su3.Size = New System.Drawing.Size(32, 20)
        Me.su3.TabIndex = 8
        '
        'su4
        '
        Me.su4.Location = New System.Drawing.Point(363, 168)
        Me.su4.Name = "su4"
        Me.su4.Size = New System.Drawing.Size(32, 20)
        Me.su4.TabIndex = 9
        '
        'su5
        '
        Me.su5.Location = New System.Drawing.Point(363, 194)
        Me.su5.Name = "su5"
        Me.su5.Size = New System.Drawing.Size(32, 20)
        Me.su5.TabIndex = 10
        '
        'su6
        '
        Me.su6.Location = New System.Drawing.Point(363, 220)
        Me.su6.Name = "su6"
        Me.su6.Size = New System.Drawing.Size(32, 20)
        Me.su6.TabIndex = 11
        '
        'm1
        '
        Me.m1.Location = New System.Drawing.Point(401, 90)
        Me.m1.Name = "m1"
        Me.m1.Size = New System.Drawing.Size(32, 20)
        Me.m1.TabIndex = 12
        '
        'm2
        '
        Me.m2.Location = New System.Drawing.Point(401, 116)
        Me.m2.Name = "m2"
        Me.m2.Size = New System.Drawing.Size(32, 20)
        Me.m2.TabIndex = 13
        '
        'm3
        '
        Me.m3.Location = New System.Drawing.Point(401, 142)
        Me.m3.Name = "m3"
        Me.m3.Size = New System.Drawing.Size(32, 20)
        Me.m3.TabIndex = 14
        '
        'm4
        '
        Me.m4.Location = New System.Drawing.Point(401, 168)
        Me.m4.Name = "m4"
        Me.m4.Size = New System.Drawing.Size(32, 20)
        Me.m4.TabIndex = 15
        '
        'm5
        '
        Me.m5.Location = New System.Drawing.Point(401, 194)
        Me.m5.Name = "m5"
        Me.m5.Size = New System.Drawing.Size(32, 20)
        Me.m5.TabIndex = 16
        '
        'm6
        '
        Me.m6.Location = New System.Drawing.Point(401, 220)
        Me.m6.Name = "m6"
        Me.m6.Size = New System.Drawing.Size(32, 20)
        Me.m6.TabIndex = 17
        '
        'tu1
        '
        Me.tu1.Location = New System.Drawing.Point(439, 90)
        Me.tu1.Name = "tu1"
        Me.tu1.Size = New System.Drawing.Size(32, 20)
        Me.tu1.TabIndex = 18
        '
        'tu2
        '
        Me.tu2.Location = New System.Drawing.Point(439, 116)
        Me.tu2.Name = "tu2"
        Me.tu2.Size = New System.Drawing.Size(32, 20)
        Me.tu2.TabIndex = 19
        '
        'tu3
        '
        Me.tu3.Location = New System.Drawing.Point(439, 142)
        Me.tu3.Name = "tu3"
        Me.tu3.Size = New System.Drawing.Size(32, 20)
        Me.tu3.TabIndex = 20
        '
        'tu4
        '
        Me.tu4.Location = New System.Drawing.Point(439, 168)
        Me.tu4.Name = "tu4"
        Me.tu4.Size = New System.Drawing.Size(32, 20)
        Me.tu4.TabIndex = 21
        '
        'tu5
        '
        Me.tu5.Location = New System.Drawing.Point(439, 194)
        Me.tu5.Name = "tu5"
        Me.tu5.Size = New System.Drawing.Size(32, 20)
        Me.tu5.TabIndex = 22
        '
        'tu6
        '
        Me.tu6.Location = New System.Drawing.Point(439, 220)
        Me.tu6.Name = "tu6"
        Me.tu6.Size = New System.Drawing.Size(32, 20)
        Me.tu6.TabIndex = 23
        '
        'w1
        '
        Me.w1.Location = New System.Drawing.Point(477, 90)
        Me.w1.Name = "w1"
        Me.w1.Size = New System.Drawing.Size(32, 20)
        Me.w1.TabIndex = 24
        '
        'w2
        '
        Me.w2.Location = New System.Drawing.Point(477, 116)
        Me.w2.Name = "w2"
        Me.w2.Size = New System.Drawing.Size(32, 20)
        Me.w2.TabIndex = 25
        '
        'w3
        '
        Me.w3.Location = New System.Drawing.Point(477, 142)
        Me.w3.Name = "w3"
        Me.w3.Size = New System.Drawing.Size(32, 20)
        Me.w3.TabIndex = 26
        '
        'w4
        '
        Me.w4.Location = New System.Drawing.Point(477, 168)
        Me.w4.Name = "w4"
        Me.w4.Size = New System.Drawing.Size(32, 20)
        Me.w4.TabIndex = 27
        '
        'w5
        '
        Me.w5.Location = New System.Drawing.Point(477, 194)
        Me.w5.Name = "w5"
        Me.w5.Size = New System.Drawing.Size(32, 20)
        Me.w5.TabIndex = 28
        '
        'w6
        '
        Me.w6.Location = New System.Drawing.Point(477, 220)
        Me.w6.Name = "w6"
        Me.w6.Size = New System.Drawing.Size(32, 20)
        Me.w6.TabIndex = 29
        '
        'th1
        '
        Me.th1.Location = New System.Drawing.Point(515, 90)
        Me.th1.Name = "th1"
        Me.th1.Size = New System.Drawing.Size(32, 20)
        Me.th1.TabIndex = 30
        '
        'th2
        '
        Me.th2.Location = New System.Drawing.Point(515, 116)
        Me.th2.Name = "th2"
        Me.th2.Size = New System.Drawing.Size(32, 20)
        Me.th2.TabIndex = 31
        '
        'th3
        '
        Me.th3.Location = New System.Drawing.Point(515, 142)
        Me.th3.Name = "th3"
        Me.th3.Size = New System.Drawing.Size(32, 20)
        Me.th3.TabIndex = 32
        '
        'th4
        '
        Me.th4.Location = New System.Drawing.Point(515, 168)
        Me.th4.Name = "th4"
        Me.th4.Size = New System.Drawing.Size(32, 20)
        Me.th4.TabIndex = 33
        '
        'th5
        '
        Me.th5.Location = New System.Drawing.Point(515, 194)
        Me.th5.Name = "th5"
        Me.th5.Size = New System.Drawing.Size(32, 20)
        Me.th5.TabIndex = 34
        '
        'th6
        '
        Me.th6.Location = New System.Drawing.Point(515, 220)
        Me.th6.Name = "th6"
        Me.th6.Size = New System.Drawing.Size(32, 20)
        Me.th6.TabIndex = 35
        '
        'f1
        '
        Me.f1.Location = New System.Drawing.Point(553, 90)
        Me.f1.Name = "f1"
        Me.f1.Size = New System.Drawing.Size(32, 20)
        Me.f1.TabIndex = 36
        '
        'f2
        '
        Me.f2.Location = New System.Drawing.Point(553, 116)
        Me.f2.Name = "f2"
        Me.f2.Size = New System.Drawing.Size(32, 20)
        Me.f2.TabIndex = 37
        '
        'f3
        '
        Me.f3.Location = New System.Drawing.Point(553, 142)
        Me.f3.Name = "f3"
        Me.f3.Size = New System.Drawing.Size(32, 20)
        Me.f3.TabIndex = 38
        '
        'f4
        '
        Me.f4.Location = New System.Drawing.Point(553, 168)
        Me.f4.Name = "f4"
        Me.f4.Size = New System.Drawing.Size(32, 20)
        Me.f4.TabIndex = 39
        '
        'f5
        '
        Me.f5.Location = New System.Drawing.Point(553, 194)
        Me.f5.Name = "f5"
        Me.f5.Size = New System.Drawing.Size(32, 20)
        Me.f5.TabIndex = 40
        '
        'f6
        '
        Me.f6.Location = New System.Drawing.Point(553, 220)
        Me.f6.Name = "f6"
        Me.f6.Size = New System.Drawing.Size(32, 20)
        Me.f6.TabIndex = 41
        '
        'sa1
        '
        Me.sa1.Location = New System.Drawing.Point(591, 90)
        Me.sa1.Name = "sa1"
        Me.sa1.Size = New System.Drawing.Size(32, 20)
        Me.sa1.TabIndex = 42
        '
        'sa2
        '
        Me.sa2.Location = New System.Drawing.Point(591, 116)
        Me.sa2.Name = "sa2"
        Me.sa2.Size = New System.Drawing.Size(32, 20)
        Me.sa2.TabIndex = 43
        '
        'sa3
        '
        Me.sa3.Location = New System.Drawing.Point(591, 142)
        Me.sa3.Name = "sa3"
        Me.sa3.Size = New System.Drawing.Size(32, 20)
        Me.sa3.TabIndex = 44
        '
        'sa4
        '
        Me.sa4.Location = New System.Drawing.Point(591, 168)
        Me.sa4.Name = "sa4"
        Me.sa4.Size = New System.Drawing.Size(32, 20)
        Me.sa4.TabIndex = 45
        '
        'sa5
        '
        Me.sa5.Location = New System.Drawing.Point(591, 194)
        Me.sa5.Name = "sa5"
        Me.sa5.Size = New System.Drawing.Size(32, 20)
        Me.sa5.TabIndex = 46
        '
        'sa6
        '
        Me.sa6.Location = New System.Drawing.Point(591, 220)
        Me.sa6.Name = "sa6"
        Me.sa6.Size = New System.Drawing.Size(32, 20)
        Me.sa6.TabIndex = 47
        '
        'TextBox1
        '
        Me.TextBox1.Location = New System.Drawing.Point(363, 64)
        Me.TextBox1.Name = "TextBox1"
        Me.TextBox1.Size = New System.Drawing.Size(32, 20)
        Me.TextBox1.TabIndex = 48
        Me.TextBox1.Text = "SU"
        Me.TextBox1.TextAlign = System.Windows.Forms.HorizontalAlignment.Center
        '
        'TextBox2
        '
        Me.TextBox2.Location = New System.Drawing.Point(401, 64)
        Me.TextBox2.Name = "TextBox2"
        Me.TextBox2.Size = New System.Drawing.Size(32, 20)
        Me.TextBox2.TabIndex = 49
        Me.TextBox2.Text = "MO"
        Me.TextBox2.TextAlign = System.Windows.Forms.HorizontalAlignment.Center
        '
        'TextBox3
        '
        Me.TextBox3.Location = New System.Drawing.Point(439, 64)
        Me.TextBox3.Name = "TextBox3"
        Me.TextBox3.Size = New System.Drawing.Size(32, 20)
        Me.TextBox3.TabIndex = 50
        Me.TextBox3.Text = "TU"
        Me.TextBox3.TextAlign = System.Windows.Forms.HorizontalAlignment.Center
        '
        'TextBox4
        '
        Me.TextBox4.Location = New System.Drawing.Point(477, 65)
        Me.TextBox4.Name = "TextBox4"
        Me.TextBox4.Size = New System.Drawing.Size(32, 20)
        Me.TextBox4.TabIndex = 51
        Me.TextBox4.Text = "WE"
        Me.TextBox4.TextAlign = System.Windows.Forms.HorizontalAlignment.Center
        '
        'TextBox5
        '
        Me.TextBox5.Location = New System.Drawing.Point(515, 65)
        Me.TextBox5.Name = "TextBox5"
        Me.TextBox5.Size = New System.Drawing.Size(32, 20)
        Me.TextBox5.TabIndex = 52
        Me.TextBox5.Text = "TH"
        Me.TextBox5.TextAlign = System.Windows.Forms.HorizontalAlignment.Center
        '
        'TextBox6
        '
        Me.TextBox6.Location = New System.Drawing.Point(553, 64)
        Me.TextBox6.Name = "TextBox6"
        Me.TextBox6.Size = New System.Drawing.Size(32, 20)
        Me.TextBox6.TabIndex = 53
        Me.TextBox6.Text = "FR"
        Me.TextBox6.TextAlign = System.Windows.Forms.HorizontalAlignment.Center
        '
        'TextBox7
        '
        Me.TextBox7.Location = New System.Drawing.Point(591, 64)
        Me.TextBox7.Name = "TextBox7"
        Me.TextBox7.Size = New System.Drawing.Size(32, 20)
        Me.TextBox7.TabIndex = 54
        Me.TextBox7.Text = "SA"
        Me.TextBox7.TextAlign = System.Windows.Forms.HorizontalAlignment.Center
        '
        'YearBackward
        '
        Me.YearBackward.Location = New System.Drawing.Point(363, 11)
        Me.YearBackward.Name = "YearBackward"
        Me.YearBackward.Size = New System.Drawing.Size(70, 23)
        Me.YearBackward.TabIndex = 55
        Me.YearBackward.Text = "YPrev"
        Me.YearBackward.UseVisualStyleBackColor = True
        '
        'YearForward
        '
        Me.YearForward.Location = New System.Drawing.Point(548, 11)
        Me.YearForward.Name = "YearForward"
        Me.YearForward.Size = New System.Drawing.Size(75, 23)
        Me.YearForward.TabIndex = 56
        Me.YearForward.Text = "YNext"
        Me.YearForward.UseVisualStyleBackColor = True
        '
        'Form1
        '
        Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
        Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
        Me.ClientSize = New System.Drawing.Size(1094, 566)
        Me.Controls.Add(Me.YearForward)
        Me.Controls.Add(Me.YearBackward)
        Me.Controls.Add(Me.TextBox7)
        Me.Controls.Add(Me.TextBox6)
        Me.Controls.Add(Me.TextBox5)
        Me.Controls.Add(Me.TextBox4)
        Me.Controls.Add(Me.TextBox3)
        Me.Controls.Add(Me.TextBox2)
        Me.Controls.Add(Me.TextBox1)
        Me.Controls.Add(Me.sa6)
        Me.Controls.Add(Me.sa5)
        Me.Controls.Add(Me.sa4)
        Me.Controls.Add(Me.sa3)
        Me.Controls.Add(Me.sa2)
        Me.Controls.Add(Me.sa1)
        Me.Controls.Add(Me.f6)
        Me.Controls.Add(Me.f5)
        Me.Controls.Add(Me.f4)
        Me.Controls.Add(Me.f3)
        Me.Controls.Add(Me.f2)
        Me.Controls.Add(Me.f1)
        Me.Controls.Add(Me.th6)
        Me.Controls.Add(Me.th5)
        Me.Controls.Add(Me.th4)
        Me.Controls.Add(Me.th3)
        Me.Controls.Add(Me.th2)
        Me.Controls.Add(Me.th1)
        Me.Controls.Add(Me.w6)
        Me.Controls.Add(Me.w5)
        Me.Controls.Add(Me.w4)
        Me.Controls.Add(Me.w3)
        Me.Controls.Add(Me.w2)
        Me.Controls.Add(Me.w1)
        Me.Controls.Add(Me.tu6)
        Me.Controls.Add(Me.tu5)
        Me.Controls.Add(Me.tu4)
        Me.Controls.Add(Me.tu3)
        Me.Controls.Add(Me.tu2)
        Me.Controls.Add(Me.tu1)
        Me.Controls.Add(Me.m6)
        Me.Controls.Add(Me.m5)
        Me.Controls.Add(Me.m4)
        Me.Controls.Add(Me.m3)
        Me.Controls.Add(Me.m2)
        Me.Controls.Add(Me.m1)
        Me.Controls.Add(Me.su6)
        Me.Controls.Add(Me.su5)
        Me.Controls.Add(Me.su4)
        Me.Controls.Add(Me.su3)
        Me.Controls.Add(Me.su2)
        Me.Controls.Add(Me.su1)
        Me.Controls.Add(Me.MonthBackward)
        Me.Controls.Add(Me.MonthForward)
        Me.Controls.Add(Me.YearNumber)
        Me.Controls.Add(Me.MonthName)
        Me.Name = "Form1"
        Me.Text = "Form1"
        Me.ResumeLayout(False)
        Me.PerformLayout()

    End Sub
    Friend WithEvents MonthName As System.Windows.Forms.TextBox
    Friend WithEvents YearNumber As System.Windows.Forms.TextBox
    Friend WithEvents MonthForward As System.Windows.Forms.Button
    Friend WithEvents MonthBackward As System.Windows.Forms.Button
    Friend WithEvents su1 As System.Windows.Forms.TextBox
    Friend WithEvents su2 As System.Windows.Forms.TextBox
    Friend WithEvents su3 As System.Windows.Forms.TextBox
    Friend WithEvents su4 As System.Windows.Forms.TextBox
    Friend WithEvents su5 As System.Windows.Forms.TextBox
    Friend WithEvents su6 As System.Windows.Forms.TextBox
    Friend WithEvents m1 As System.Windows.Forms.TextBox
    Friend WithEvents m2 As System.Windows.Forms.TextBox
    Friend WithEvents m3 As System.Windows.Forms.TextBox
    Friend WithEvents m4 As System.Windows.Forms.TextBox
    Friend WithEvents m5 As System.Windows.Forms.TextBox
    Friend WithEvents m6 As System.Windows.Forms.TextBox
    Friend WithEvents tu1 As System.Windows.Forms.TextBox
    Friend WithEvents tu2 As System.Windows.Forms.TextBox
    Friend WithEvents tu3 As System.Windows.Forms.TextBox
    Friend WithEvents tu4 As System.Windows.Forms.TextBox
    Friend WithEvents tu5 As System.Windows.Forms.TextBox
    Friend WithEvents tu6 As System.Windows.Forms.TextBox
    Friend WithEvents w1 As System.Windows.Forms.TextBox
    Friend WithEvents w2 As System.Windows.Forms.TextBox
    Friend WithEvents w3 As System.Windows.Forms.TextBox
    Friend WithEvents w4 As System.Windows.Forms.TextBox
    Friend WithEvents w5 As System.Windows.Forms.TextBox
    Friend WithEvents w6 As System.Windows.Forms.TextBox
    Friend WithEvents th1 As System.Windows.Forms.TextBox
    Friend WithEvents th2 As System.Windows.Forms.TextBox
    Friend WithEvents th3 As System.Windows.Forms.TextBox
    Friend WithEvents th4 As System.Windows.Forms.TextBox
    Friend WithEvents th5 As System.Windows.Forms.TextBox
    Friend WithEvents th6 As System.Windows.Forms.TextBox
    Friend WithEvents f1 As System.Windows.Forms.TextBox
    Friend WithEvents f2 As System.Windows.Forms.TextBox
    Friend WithEvents f3 As System.Windows.Forms.TextBox
    Friend WithEvents f4 As System.Windows.Forms.TextBox
    Friend WithEvents f5 As System.Windows.Forms.TextBox
    Friend WithEvents f6 As System.Windows.Forms.TextBox
    Friend WithEvents sa1 As System.Windows.Forms.TextBox
    Friend WithEvents sa2 As System.Windows.Forms.TextBox
    Friend WithEvents sa3 As System.Windows.Forms.TextBox
    Friend WithEvents sa4 As System.Windows.Forms.TextBox
    Friend WithEvents sa5 As System.Windows.Forms.TextBox
    Friend WithEvents sa6 As System.Windows.Forms.TextBox
    Friend WithEvents TextBox1 As System.Windows.Forms.TextBox
    Friend WithEvents TextBox2 As System.Windows.Forms.TextBox
    Friend WithEvents TextBox3 As System.Windows.Forms.TextBox
    Friend WithEvents TextBox4 As System.Windows.Forms.TextBox
    Friend WithEvents TextBox5 As System.Windows.Forms.TextBox
    Friend WithEvents TextBox6 As System.Windows.Forms.TextBox
    Friend WithEvents TextBox7 As System.Windows.Forms.TextBox
    Friend WithEvents YearBackward As System.Windows.Forms.Button
    Friend WithEvents YearForward As System.Windows.Forms.Button

End Class

@wampier
"Als je het zelf zou namaken"?
Mag ik dan hopen dat je inderdaad een (betere) versie zal aanmaken?

gr. Jan

 

[wampier]

Ik zal me er vanmiddag eens aan wagen. kijken of ik een volledig dynamische klasse kan bouwen als uitdaging

EDIT:

voorlopig resultaat. Omdat het form volledig dynamisch is gebouwd is de "NEW" subroutine nogal lang. De onderste routine (builddisplay) is eigenlijk alles wat nodig is om je originele code te vervangen (29 regels code, iets wat efficiënter )

Public Class calender_picker

    'fully dynamically build datepicker class
    'returns selected date
    'typical use:
    '   dim MyCal As New calender_picker()
    '   MyDate = MyCal.Show()
    Dim cp As New Form
    Dim buttons(6, 5) As Button
    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
    Dim sundaylast As Boolean = True


    Sub New()

        Dim BC As System.Drawing.Color = Color.Black 'background color
        Dim SC As System.Drawing.Color = Color.BlueViolet 'selectors color
        Dim CC As System.Drawing.Color = Color.Blue 'calender buttons color
        Dim FC As System.Drawing.Color = Color.Black 'font color

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

        Me.backyear.BackColor = SC
        Me.forwardyear.BackColor = SC
        Me.backmonth.BackColor = SC
        Me.forwardmonth.BackColor = SC
        Me.year.BackColor = SC
        Me.month.BackColor = SC

        Me.backyear.ForeColor = FC
        Me.forwardyear.ForeColor = FC
        Me.backmonth.ForeColor = FC
        Me.forwardmonth.ForeColor = FC
        Me.year.ForeColor = FC
        Me.month.ForeColor = FC

        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

        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

        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

        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

        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)}
        Dim right As Point() = {New Point(50, 19), New Point(0, 10), New Point(0, 27)}
        Dim blad As System.Drawing.Graphics
        blad = System.Drawing.Graphics.FromImage(arrowdrawleft)
        blad.FillPolygon(Brushes.Black, left)
        Me.backmonth.Image = arrowdrawleft
        Me.backyear.Image = arrowdrawleft
        blad = System.Drawing.Graphics.FromImage(arrowdrawright)
        blad.FillPolygon(Brushes.Black, right)
        Me.forwardyear.Image = arrowdrawright
        Me.forwardmonth.Image = arrowdrawright
        
        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

        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

        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

        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)

        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)
        Me.RV = DateAndTime.DateSerial(Dyear, Dmonth, Val(CType(sender, Button).Text))
        cp.DialogResult = DialogResult.OK
    End Sub

    Sub DecMonth(ByVal sender As System.Object, ByVal e As System.EventArgs)
        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)
        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)
        Dyear = Dyear - 1
        Me.BuildDisplay()
    End Sub
    Sub IncYear(ByVal sender As System.Object, ByVal e As System.EventArgs)
        Dyear = Dyear + 1
        Me.BuildDisplay()
    End Sub

    Public Function Show() As Date
        Me.Dmonth = Now().Month
        Me.Dyear = Now().Year
        Me.Dday = Now().Day
        Me.BuildDisplay()
        Me.cp.ShowDialog()
        Return Me.RV
    End Function
    Sub BuildDisplay()

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

        'clear buttons and 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 calender
        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
        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

End Class

 

[Jan92]

Hallo, wampier

Hartelijk dank voor je inzet. :thumb:

Het zal wel aan mij liggen maar toen ik jou code eens wou uittesten kreeg ik 2 foutmeldingen :








Ik heb dus een nieuw project (WindowsForm) aangemaakt met als titel calender_picker

Voor alle zekerheid de windows form zelf ook calender_picker genoemd en vervolgens jou volledig code in de code form gezet.

Wat deed ik verkeerd?

gr. Jan

 

[wampier]

In principe kan mijn code onder de FORM. Maak een gewoon project. vervolgens krijg je de class "form1" etc. ga helemaal naar onderen en plak deze class onder de form class.

 

[Jan92]

ok, wampier

Dit heb ik net gedaan. Ik krijg geen fouten meer maar... als ik debug heb ik enkel een lege form ?

gr. Jan

 

[wampier]

Je kunt op je gewone form bijvoorbeeld een button aanmaken met daarin deze code:

   dim MyDate as Date
   dim MyCal As New calender_picker()
   MyDate = MyCal.Show()
   MessageBox.Show(MyDate)

 

[Jan92]

Beste wampier

Oef! Eindelijk wat ik wou zien. Een mooi kalendertje die ook de schrikkeljaren correct weergeeft. :thumb:

Super bedankt voor al je inspanningen. Ik zou deze vraag dus op opgelost zetten tenzij...

je het ziet zitten om dit projectje naar een hoger niveau te tillen? Dan heb ik wel nog wat uitdagingen voor jou.

Laat maar iets weten.

gr. Jan