Hello !
J'ai un gros problème avec mon application. J'ai crée un calendrier. Il s'affiche parfaitement quand j'utilise un Form. Par contre j'ai une erreur que je n'arrive pas à résoudre si j'utilise ce calendrier dans un TabControl. Le code est pourtant identique...
Voilà le détail complet de l'erreur:
J'utilise :Citation:
L'exception System.TypeInitializationException n'a pas été gérée
Message="The type initializer for 'EasyBudget.mCalendar' threw an exception."
Source="EasyBudget"
TypeName="EasyBudget.mCalendar"
StackTrace:
at EasyBudget.mCalendar.showCalendar()
at EasyBudget.frmBudget.dtpMonth_ValueChanged(Object sender, EventArgs e) in D:\Visual Studio 2005\Projects\EasyBudget\frmBudget.vb:line 14
at System.Windows.Forms.DateTimePicker.OnValueChanged(EventArgs eventargs)
at System.Windows.Forms.DateTimePicker.set_Value(DateTime value)
at EasyBudget.frmBudget.initForm() in D:\Visual Studio 2005\Projects\EasyBudget\frmBudget.vb:line 8
at EasyBudget.frmBudget.frmBudget_Load(Object sender, EventArgs e) in D:\Visual Studio 2005\Projects\EasyBudget\frmBudget.vb:line 3
at System.Windows.Forms.Form.OnLoad(EventArgs e)
at System.Windows.Forms.Form.OnCreateControl()
at System.Windows.Forms.Control.CreateControl(Boolean fIgnoreVisible)
at System.Windows.Forms.Control.CreateControl()
at System.Windows.Forms.Control.WmShowWindow(Message& m)
at System.Windows.Forms.Control.WndProc(Message& m)
at System.Windows.Forms.ScrollableControl.WndProc(Message& m)
at System.Windows.Forms.ContainerControl.WndProc(Message& m)
at System.Windows.Forms.Form.WmShowWindow(Message& m)
at System.Windows.Forms.Form.WndProc(Message& m)
at System.Windows.Forms.Control.ControlNativeWindow.OnMessage(Message& m)
at System.Windows.Forms.Control.ControlNativeWindow.WndProc(Message& m)
at System.Windows.Forms.NativeWindow.DebuggableCallback(IntPtr hWnd, Int32 msg, IntPtr wparam, IntPtr lparam)
at System.Windows.Forms.SafeNativeMethods.ShowWindow(HandleRef hWnd, Int32 nCmdShow)
at System.Windows.Forms.Control.SetVisibleCore(Boolean value)
at System.Windows.Forms.Form.SetVisibleCore(Boolean value)
at System.Windows.Forms.Control.Show()
at EasyBudget.frmMain.cmdUserAdd_Click(Object sender, EventArgs e) in D:\Visual Studio 2005\Projects\EasyBudget\frmMain.vb:line 38
at System.Windows.Forms.Control.OnClick(EventArgs e)
at System.Windows.Forms.Button.OnClick(EventArgs e)
at System.Windows.Forms.Button.OnMouseUp(MouseEventArgs mevent)
at System.Windows.Forms.Control.WmMouseUp(Message& m, MouseButtons button, Int32 clicks)
at System.Windows.Forms.Control.WndProc(Message& m)
at System.Windows.Forms.ButtonBase.WndProc(Message& m)
at System.Windows.Forms.Button.WndProc(Message& m)
at System.Windows.Forms.Control.ControlNativeWindow.OnMessage(Message& m)
at System.Windows.Forms.Control.ControlNativeWindow.WndProc(Message& m)
at System.Windows.Forms.NativeWindow.DebuggableCallback(IntPtr hWnd, Int32 msg, IntPtr wparam, IntPtr lparam)
at System.Windows.Forms.UnsafeNativeMethods.DispatchMessageW(MSG& msg)
at System.Windows.Forms.Application.ComponentManager.System.Windows.Forms.UnsafeNativeMethods.IMsoComponentManager.FPushMessageLoop(Int32 dwComponentID, Int32 reason, Int32 pvLoopData)
at System.Windows.Forms.Application.ThreadContext.RunMessageLoopInner(Int32 reason, ApplicationContext context)
at System.Windows.Forms.Application.ThreadContext.RunMessageLoop(Int32 reason, ApplicationContext context)
at System.Windows.Forms.Application.Run(ApplicationContext context)
at Microsoft.VisualBasic.ApplicationServices.WindowsFormsApplicationBase.OnRun()
at Microsoft.VisualBasic.ApplicationServices.WindowsFormsApplicationBase.DoApplicationModel()
at Microsoft.VisualBasic.ApplicationServices.WindowsFormsApplicationBase.Run(String[] commandLine)
at EasyBudget.My.MyApplication.Main(String[] Args) in 17d14f5c-a337-4978-8281-53493378c1071.vb:line 81
at System.AppDomain._nExecuteAssembly(Assembly assembly, String[] args)
at System.AppDomain.ExecuteAssembly(String assemblyFile, Evidence assemblySecurity, String[] args)
at Microsoft.VisualStudio.HostingProcess.HostProc.RunUsersAssembly()
at System.Threading.ThreadHelper.ThreadStart_Context(Object state)
at System.Threading.ExecutionContext.Run(ExecutionContext executionContext, ContextCallback callback, Object state)
at System.Threading.ThreadHelper.ThreadStart()
Mon formulaire avec le TabControl :Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112 Public Class cControlArrayUtils 'Converts same type of controls on a form to a control 'array by using the notation ControlName_1, ControlName_2, 'where the _ can be replaced by any separator string Public Shared Function getControlArray(ByVal frm As Windows.Forms.Form, _ ByVal controlName As String, _ Optional ByVal separator As String = "") As System.Array Dim i As Short Dim startOfIndex As Short Dim alist As New ArrayList Dim controlType As System.Type Dim ctl As System.Windows.Forms.Control 'Dim ctrls() As System.Windows.Forms.Control Dim strSuffix As String Dim maxIndex As Short = -1 'Default 'Loop through all controls, looking for controls with the matching name pattern 'Find the highest indexed control For Each ctl In frm.Controls startOfIndex = ctl.Name.ToLower.IndexOf(controlName.ToLower & separator) If startOfIndex = 0 Then strSuffix = ctl.Name.Substring(controlName.Length) 'Check that the suffix is an integer (index of the array) If IsInteger(strSuffix) Then If Val(strSuffix) > maxIndex Then _ maxIndex = Val(strSuffix) 'Find the highest indexed Element End If End If Next ctl 'Add to the list of controls in correct order If maxIndex > -1 Then For i = 0 To maxIndex Dim aControl As Control = getControlFromName(frm, controlName, i, separator) If Not (aControl Is Nothing) Then 'Save the object Type (uses the last control found as the Type) controlType = aControl.GetType End If alist.Add(aControl) Next End If Return alist.ToArray(controlType) End Function 'Converts any type of like named controls on a form 'to a control array by using the notation ControlName_1, 'ControlName_2, where the _ can be replaced by any 'separator string Public Shared Function getMixedControlArray(ByVal frm As Windows.Forms.Form, ByVal controlName As String, _ Optional ByVal separator As String = "") As Control() Dim i As Short Dim startOfIndex As Short Dim alist As New ArrayList 'Dim controlType As System.Type Dim ctl As System.Windows.Forms.Control 'Dim ctrls() As System.Windows.Forms.Control Dim strSuffix As String Dim maxIndex As Short = -1 'Default 'Loop through all controls, looking for controls with the matching name pattern 'Find the highest indexed control For Each ctl In frm.Controls startOfIndex = ctl.Name.ToLower.IndexOf(controlName.ToLower & separator) If startOfIndex = 0 Then strSuffix = ctl.Name.Substring(controlName.Length) 'Check that the suffix is an integer(index of the array) If IsInteger(strSuffix) Then If Val(strSuffix) > maxIndex Then _ maxIndex = Val(strSuffix) 'Find the highest indexed Element End If End If Next ctl 'Add to the list of controls in correct order If maxIndex > -1 Then For i = 0 To maxIndex Dim aControl As Control = getControlFromName(frm, controlName, i, separator) alist.Add(aControl) Next End If Return alist.ToArray(GetType(Control)) End Function Private Shared Function getControlFromName(ByRef frm As Windows.Forms.Form, _ ByVal controlName As String, ByVal index As Short, _ ByVal separator As String) As System.Windows.Forms.Control controlName = controlName & separator & index For Each ctl As Control In frm.Controls If String.Compare(ctl.Name, controlName, True) = 0 Then Return ctl End If Next ctl Return Nothing 'Could not find this control by name End Function Private Shared Function IsInteger(ByVal Value As String) As Boolean If Value = "" Then Return False For Each chr As Char In Value If Not Char.IsDigit(chr) Then Return False End If Next Return True End Function End Class
Et le module de traitement :Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82 Public Class frmBudget Private Sub frmBudget_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load initForm() End Sub Private Sub initForm() 'Date par défaut des DateTimePicker Me.dtpMonth.Value = Today Me.dtpYear.Value = Today showCalendar() End Sub Private Sub dtpMonth_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles dtpMonth.ValueChanged showCalendar() End Sub Private Sub dtpYear_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles dtpYear.ValueChanged showCalendar() End Sub Private Sub ListBox_DoubleClick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ListBox1.DoubleClick, _ ListBox2.DoubleClick, ListBox3.DoubleClick, ListBox4.DoubleClick, ListBox5.DoubleClick, ListBox6.DoubleClick, _ ListBox7.DoubleClick, ListBox8.DoubleClick, ListBox9.DoubleClick, ListBox10.DoubleClick, ListBox11.DoubleClick, _ ListBox12.DoubleClick, ListBox13.DoubleClick, ListBox14.DoubleClick, ListBox15.DoubleClick, ListBox16.DoubleClick, _ ListBox17.DoubleClick, ListBox18.DoubleClick, ListBox19.DoubleClick, ListBox20.DoubleClick, ListBox21.DoubleClick, _ ListBox22.DoubleClick, ListBox23.DoubleClick, ListBox24.DoubleClick, ListBox25.DoubleClick, ListBox26.DoubleClick, _ ListBox27.DoubleClick, ListBox28.DoubleClick, ListBox29.DoubleClick, ListBox30.DoubleClick, ListBox31.DoubleClick, _ ListBox32.DoubleClick, ListBox33.DoubleClick, ListBox34.DoubleClick, ListBox35.DoubleClick, ListBox36.DoubleClick, _ ListBox37.DoubleClick, ListBox38.DoubleClick, ListBox39.DoubleClick, ListBox40.DoubleClick, ListBox41.DoubleClick, ListBox42.DoubleClick If lblLabels(setI(sender)).Text <> "" Then setDate(sender) frmOperation.ShowDialog() End If End Sub Private Sub ListBox_MouseEnter(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ListBox1.MouseEnter, _ ListBox2.MouseEnter, ListBox3.MouseEnter, ListBox4.MouseEnter, ListBox5.MouseEnter, ListBox6.MouseEnter, _ ListBox7.MouseEnter, ListBox8.MouseEnter, ListBox9.MouseEnter, ListBox10.MouseEnter, ListBox11.MouseEnter, _ ListBox12.MouseEnter, ListBox13.MouseEnter, ListBox14.MouseEnter, ListBox15.MouseEnter, ListBox16.MouseEnter, _ ListBox17.MouseEnter, ListBox18.MouseEnter, ListBox19.MouseEnter, ListBox20.MouseEnter, ListBox21.MouseEnter, _ ListBox22.MouseEnter, ListBox23.MouseEnter, ListBox24.MouseEnter, ListBox25.MouseEnter, ListBox26.MouseEnter, _ ListBox27.MouseEnter, ListBox28.MouseEnter, ListBox29.MouseEnter, ListBox30.MouseEnter, ListBox31.MouseEnter, _ ListBox32.MouseEnter, ListBox33.MouseEnter, ListBox34.MouseEnter, ListBox35.MouseEnter, ListBox36.MouseEnter, _ ListBox37.MouseEnter, ListBox38.MouseEnter, ListBox39.MouseEnter, ListBox40.MouseEnter, ListBox41.MouseEnter, ListBox42.MouseEnter Dim i As Integer = setI(sender) If lblLabels(i).Text <> "" Then If lstBoxs(i).BackColor <> Color.Gold Then lstBoxs(i).BackColor = Color.LightBlue Else lstBoxs(i).BackColor = Color.LightGoldenrodYellow End If End If End Sub Private Sub ListBox_MouseLeave(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ListBox1.MouseLeave, _ ListBox2.MouseLeave, ListBox3.MouseLeave, ListBox4.MouseLeave, ListBox5.MouseLeave, ListBox6.MouseLeave, _ ListBox7.MouseLeave, ListBox8.MouseLeave, ListBox9.MouseLeave, ListBox10.MouseLeave, ListBox11.MouseLeave, _ ListBox12.MouseLeave, ListBox13.MouseLeave, ListBox14.MouseLeave, ListBox15.MouseLeave, ListBox16.MouseLeave, _ ListBox17.MouseLeave, ListBox18.MouseLeave, ListBox19.MouseLeave, ListBox20.MouseLeave, ListBox21.MouseLeave, _ ListBox22.MouseLeave, ListBox23.MouseLeave, ListBox24.MouseLeave, ListBox25.MouseLeave, ListBox26.MouseLeave, _ ListBox27.MouseLeave, ListBox28.MouseLeave, ListBox29.MouseLeave, ListBox30.MouseLeave, ListBox31.MouseLeave, _ ListBox32.MouseLeave, ListBox33.MouseLeave, ListBox34.MouseLeave, ListBox35.MouseLeave, ListBox36.MouseLeave, _ ListBox37.MouseLeave, ListBox38.MouseLeave, ListBox39.MouseLeave, ListBox40.MouseLeave, ListBox41.MouseLeave, ListBox42.MouseLeave Dim i As Integer = setI(sender) If lblLabels(i).Text <> "" Then If lstBoxs(i).BackColor <> Color.LightGoldenrodYellow Then lstBoxs(i).BackColor = Color.White Else lstBoxs(i).BackColor = Color.Gold End If End If End Sub Private Sub frmBudget_FormClosing(ByVal sender As System.Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles MyBase.FormClosing If MessageBox.Show("Etes-vous sûr de vouloir de vouloir quitter le calendrier ?", "Exit", MessageBoxButtons.YesNo, MessageBoxIcon.Question) = DialogResult.Yes Then frmMain.Show() e.Cancel = False Else e.Cancel = True End If End Sub End Class
Une idée ? 8OCode:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145 Module mCalendar Public lstBoxs As ListBox() = cControlArrayUtils.getControlArray(frmBudget, "ListBox") Public lblLabels As Label() = cControlArrayUtils.getControlArray(frmBudget, "Label") Public Sub showCalendar() Dim iNb As Short Dim iMonth As Short Dim iYear As Short Dim iNbDay As Short Dim i As Short Dim d As Date 'Initialise les variable iMonth et iYear iMonth = Month(frmBudget.dtpMonth.Value) iYear = Year(frmBudget.dtpYear.Value) 'Initialise la variable iNbDay iNbDay = DayInMonth(iMonth, iYear) 'Définit le premier jour du mois Dim iFirst As Short Dim sTemp As String sTemp = CreateDate(1, iMonth, iYear) d = CDate(sTemp) iFirst = Weekday(d) 'Initialise les labels et les cases For i = 1 To 42 lblLabels(i).Text = "" lstBoxs(i).BackColor = Color.White Next 'Si le premier jour d'un mois est un dimanche If iFirst = 1 Then iFirst = 8 End If 'Numérote les cases du calendrier For i = iFirst - 1 To iNbDay - 2 + iFirst iNb = i - iFirst + 2 lblLabels(i).Text = Str(iNb) If iMonth = Today.Month And iYear = Today.Year And iNb = Today.Day Then lstBoxs(i).BackColor = Color.Gold End If Next 'Grise les cases du mois précédent For i = 1 To iFirst - 2 lstBoxs(i).BackColor = Color.LightGray Next 'Grise les cases du mois suivant For i = iNbDay - 1 + iFirst To 42 lstBoxs(i).BackColor = Color.LightGray Next End Sub ''' <summary> ''' DayInMonth ''' Retourne le nombre de jour qu'il y a dans un mois ''' </summary> ''' <param name="iMonth">le mois</param> ''' <param name="iYear">l'année</param> ''' <returns></returns> ''' <remarks></remarks> Function DayInMonth(ByRef iMonth As Short, ByRef iYear As Short) As Short If Month(frmBudget.dtpMonth.Value) = 2 Then If (iYear Mod 4 = 0) Then DayInMonth = 29 Else DayInMonth = 28 End If ElseIf (Month(frmBudget.dtpMonth.Value) = 4 Or Month(frmBudget.dtpMonth.Value) = 6 Or Month(frmBudget.dtpMonth.Value) = 9 Or Month(frmBudget.dtpMonth.Value) = 11) Then DayInMonth = 30 Else DayInMonth = 31 End If End Function ''' <summary> ''' intTo2Char ''' Convertit le jour d'une date de 1 digit en 2 digits ''' </summary> ''' <param name="i"></param> ''' <returns></returns> ''' <remarks></remarks> Function intTo2Char(ByRef i As Short) As String Select Case i Case 0 : intTo2Char = "00" Case 1 : intTo2Char = "01" Case 2 : intTo2Char = "02" Case 3 : intTo2Char = "03" Case 4 : intTo2Char = "04" Case 5 : intTo2Char = "05" Case 6 : intTo2Char = "06" Case 7 : intTo2Char = "07" Case 8 : intTo2Char = "08" Case 9 : intTo2Char = "09" Case Else intTo2Char = Str(i) End Select End Function Function CreateDate(ByRef iDay As Short, ByRef iMonth As Short, ByRef iYear As Short) As String Dim sTemp As String sTemp = intTo2Char(iDay) & "-" & intTo2Char(iMonth) sTemp = sTemp & Str(iYear) CreateDate = sTemp End Function Sub setDate(ByVal sender As System.Object) Dim i As Integer = setI(sender) Dim sDay As String = lblLabels(i).Text Dim sMonth As String = Month(frmBudget.dtpMonth.Value) Dim sYear As String = Year(frmBudget.dtpYear.Value) frmOperation.lblOperation.Text += " " + intTo2Char(sDay) + "/" + intTo2Char(sMonth) + "/" + sYear frmOperation.lblCase.Text = i End Sub Function setI(ByVal sender As System.Object) As Integer If Len((sender.Name)) > 8 Then setI = (Integer.Parse(Strings.Right((sender.Name), 2))) Else setI = (Integer.Parse(Strings.Right((sender.Name), 1))) End If End Function Public Sub saveOpToCalendar() Dim titleOp, amountOp As String Dim iCase As Integer With frmOperation titleOp = .txtType.Text amountOp = .txtAmount.Text iCase = .lblCase.Text End With With frmBudget lstBoxs(iCase).Items.Add(titleOp + " : " + amountOp) End With End Sub End Module