· 7 years ago · Jan 17, 2019, 04:10 PM
1Imports System.IO
2
3
4Public Class U_Generate_Html_Page
5
6
7 Public U_Db_Database_Log_Events_Local As U_Db_Database_Log_Events
8
9 Public Structure Type_Curve_Data
10 '*******************************************************************************
11 '**** Structure générale des données d'un point d'une courbe *****
12 '*******************************************************************************
13 Dim DateTime As Date
14 Dim State As U_Db_Database_Log_Events.Type_Etat_Courbe_Html
15 Dim Label1 As String
16 Dim Label2 As String
17 Dim Success As Boolean
18 Dim Value As Double
19 End Structure
20
21
22
23 '**************************************************************************
24 '**** Structure regroupant les données d'une courbe *********
25 '**************************************************************************
26 Public Structure St_Collection_Curve_Data
27 Dim Count As Integer
28 Dim Title As String
29 Dim Table_Data As Type_Curve_Data()
30 End Structure
31
32 Public Zone_Curve_Data As St_Collection_Curve_Data
33 Public Zone_Overall_Curve_Data As St_Collection_Curve_Data
34
35
36
37
38 Const header As String = "<div style='padding-left: 150px; top: 0px; background-color:#FFFFFF;' width='100%' border='0' cellspacing='0' cellpadding='0' class='horizontalNav'><table cellspacing='0' cellpadding='0' width='100%' class='Menu1' id='Menu1' style='background-color:#FFFFFF;' border='0'><tbody><tr><td onmouseout='leaveLayer(this); applyStyle(this.id, "normal");' onmouseover='deployLayer(this);' id='Cell1_1' class='normal'><table cellspacing='0' cellpadding='0' class='Menu1_roundTop'><tbody><tr><td class='top' style='background-color: #FFFFFF;'> </td></tr></tbody></table><table cellspacing='0' cellpadding='0' class='Menu1_content'><tbody><tr><td class='padding'> </td><td valign='top'><a target='_self' href='http://unity-intranets/iqfirmware/iqfw_lv1/index.htm?platform='>Home</a></td><td class='padding'> </td></tr></tbody></table></td><td class='menuSeparator'> </td><td onmouseout='leaveLayer(this); applyStyle(this.id, "normal");' onmouseover='deployLayer(this);' id='Cell1_2' class='normal'><table cellspacing='0' cellpadding='0' class='Menu1_roundTop'><tbody><tr><td class='top' style='background-color: #FFFFFF;'> </td></tr></tbody></table><table cellspacing='0' cellpadding='0' class='Menu1_content'><tbody><tr><td class='padding'> </td><td valign='top'><a target='_self' href='javascript: void(0)'>Team</a></td><td class='padding'> </td></tr></tbody></table></td><td class='menuSeparator'> </td><td onmouseout='leaveLayer(this); applyStyle(this.id, "normal");' onmouseover='deployLayer(this);' id='Cell1_3' class='normal'><table cellspacing='0' cellpadding='0' class='Menu1_roundTop'><tbody><tr><td class='top' style='background-color: #FFFFFF;'> </td></tr></tbody></table><table cellspacing='0' cellpadding='0' class='Menu1_content'><tbody><tr><td class='padding'> </td><td valign='top'><a target='_self' href='javascript: void(0)'>Integration</a></td><td class='padding'> </td></tr></tbody></table></td><td class='menuSeparator'> </td><td onmouseout='leaveLayer(this); applyStyle(this.id, "normal");' onmouseover='deployLayer(this);' id='Cell1_4' class='normal'><table cellspacing='0' cellpadding='0' class='Menu1_roundTop'><tbody><tr><td class='top' style='background-color: #FFFFFF;'> </td></tr></tbody></table><table cellspacing='0' cellpadding='0' class='Menu1_content'><tbody><tr><td class='padding'> </td><td valign='top'><a target='_self' href='http://unity-intranets/iqfirmware/Tools/Tools.htm?platform='>Tools</a></td><td class='padding'> </td></tr></tbody></table></td><td class='menuSeparator'> </td><td onmouseout='leaveLayer(this); applyStyle(this.id, "normal");' onmouseover='deployLayer(this);' id='Cell1_5' class='normal'><table cellspacing='0' cellpadding='0' class='Menu1_roundTop'><tbody><tr><td class='top' style='background-color: #FFFFFF;'> </td></tr></tbody></table><table cellspacing='0' cellpadding='0' class='Menu1_content'><tbody><tr><td class='padding'> </td><td valign='top'><a target='_self' href='http://unity-intranets/iqfirmware/Documents/documents_.htm?platform='>Documents</a></td><td class='padding'> </td></tr></tbody></table></td><td class='menuSeparator'> </td><td onmouseout='leaveLayer(this); applyStyle(this.id, "normal");' onmouseover='deployLayer(this);' id='Cell1_6' class='normal'><table cellspacing='0' cellpadding='0' class='Menu1_roundTop'><tbody><tr><td class='top' style='background-color: #FFFFFF;'> </td></tr></tbody></table><table cellspacing='0' cellpadding='0' class='Menu1_content'><tbody><tr><td class='padding'> </td><td valign='top'><a target='_self' href='javascript: void(0)'>Links</a></td><td class='padding'> </td></tr></tbody></table></td><td class='menuSeparator'> </td></tr></tbody></table></div><iframe src='about:blank' frameborder='0' style='visibility:hidden;display:none;' id='iFrame' background='#EAEAEA'></iframe>"
39
40 Dim Flag_Extension, Flag_Number_Int As Boolean
41 Dim all_data As String = ""
42 Dim all_history_data As String = ""
43 Dim all_event As String = ""
44 Dim nb_test_html As Integer = 0
45 Dim nb_all_test As Integer = 0
46 Dim current_time_elapsed As String = ""
47
48 Private Sub Form1_Load() Handles MyBase.Load
49 Button1.PerformClick()
50 End Sub
51
52 Private Sub Button4_Click(sender As System.Object, e As System.EventArgs) Handles Button4.Click
53 On Error GoTo Errhandler_Avec_Diagnostic
54
55 'on limite l'affichage à 4 tests maximum
56 If (nb_test_html >= 4) Then
57 Button1.PerformClick()
58 nb_test_html = 0
59 End If
60
61
62 'En mode auto on va créer la page d'index qui permettra d'accéder à la liste des tests, la page dashboard qui contiendra un graphique javascript généré par l'outil et la page data qui elle contiendra les valeurs relevées permettant la génération du graph sur le dashboard
63 '----- Creation de la page index.html -------
64 U_Memo_Txt_Mirror2.Memo1_Text = "index.html"
65 U_Create_File1.Check_And_Create_File_With_Path(U_Memo_Txt_Mirror1.Memo1_Text.ToString, U_Memo_Txt_Mirror2.Memo1_Text.ToString)
66 Button4.BackColor = U_Create_File1.Button3.BackColor
67 Call Check_File_Extension(U_Memo_Txt_Mirror2.Memo1_Text.ToString)
68 Call Create_File_Html(U_Memo_Txt_Mirror1.Memo1_Text.ToString & "\" & U_Memo_Txt_Mirror2.Memo1_Text.ToString, Flag_Extension, U_Memo_Txt_Mirror2.Memo1_Text)
69 TextBox1.AppendText(TimeOfDay.Hour.ToString + ":" + TimeOfDay.Minute.ToString + ":" + TimeOfDay.Second.ToString + " -> Création du fichier " + U_Memo_Txt_Mirror2.Memo1_Text.ToString + " réussie !" + vbCrLf)
70
71
72 '----- Creation de la page dashboard.html -------
73
74 U_Memo_Txt_Mirror2.Memo1_Text = "dashboard.html"
75 U_Create_File1.Check_And_Create_File_With_Path(U_Memo_Txt_Mirror1.Memo1_Text.ToString, U_Memo_Txt_Mirror2.Memo1_Text.ToString)
76 Button4.BackColor = U_Create_File1.Button3.BackColor
77 Call Check_File_Extension(U_Memo_Txt_Mirror2.Memo1_Text.ToString)
78 Call Create_File_Html(U_Memo_Txt_Mirror1.Memo1_Text.ToString & "\" & U_Memo_Txt_Mirror2.Memo1_Text.ToString, Flag_Extension, U_Memo_Txt_Mirror2.Memo1_Text)
79 TextBox1.AppendText(TimeOfDay.Hour.ToString + ":" + TimeOfDay.Minute.ToString + ":" + TimeOfDay.Second.ToString + " -> Création du fichier " + U_Memo_Txt_Mirror2.Memo1_Text.ToString + " réussie !" + vbCrLf)
80
81 '----- Creation de la page data.html -------
82
83 U_Memo_Txt_Mirror2.Memo1_Text = "data.html"
84 U_Create_File1.Check_And_Create_File_With_Path(U_Memo_Txt_Mirror1.Memo1_Text.ToString, U_Memo_Txt_Mirror2.Memo1_Text.ToString)
85 Button4.BackColor = U_Create_File1.Button3.BackColor
86 Call Check_File_Extension(U_Memo_Txt_Mirror2.Memo1_Text.ToString)
87 Call Create_File_Html(U_Memo_Txt_Mirror1.Memo1_Text.ToString & "\" & U_Memo_Txt_Mirror2.Memo1_Text.ToString, Flag_Extension, U_Memo_Txt_Mirror2.Memo1_Text)
88 TextBox1.AppendText(TimeOfDay.Hour.ToString + ":" + TimeOfDay.Minute.ToString + ":" + TimeOfDay.Second.ToString + " -> Création du fichier " + U_Memo_Txt_Mirror2.Memo1_Text.ToString + " réussie !" + vbCrLf)
89
90
91 '----- Editions avec archivage du test sur index.html -------
92 'TODO update index.html
93 'créer le tableau dynamique
94 U_Memo_Txt_Mirror2.Memo1_Text = "index.html"
95 Call Create_Table_Html(U_Memo_Txt_Mirror1.Memo1_Text.ToString & "\" & U_Memo_Txt_Mirror2.Memo1_Text.ToString)
96 TextBox1.AppendText(TimeOfDay.Hour.ToString + ":" + TimeOfDay.Minute.ToString + ":" + TimeOfDay.Second.ToString + " -> Update du fichier index.html réussi !" + vbCrLf)
97
98
99 Exit Sub
100
101 '-------------------------------------------------------------------------------
102 '------------ Traitement des erreurs ----------
103 '-------------------------------------------------------------------------------
104Errhandler_Avec_Diagnostic:
105 Call U_Msg_Local1.Affiche_Erreur("Create File")
106 Resume Next
107 '------------ Fin traitement des erreurs ------------
108
109 End Sub
110
111 Private Sub Check_File_Extension(Extension As String)
112 On Error GoTo Errhandler_Avec_Diagnostic
113
114 Dim prst_char, Extension_Final As String
115 Extension_Final = ""
116 Dim nb_char As Integer
117 For nb_char = 1 To Len(Extension)
118 prst_char = Mid(Extension, nb_char, 1)
119 If (prst_char = ".") Then
120 For nb_char_prst = nb_char To Len(Extension)
121 prst_char = Mid(Extension, nb_char_prst, 1)
122 Extension_Final = Extension_Final + prst_char
123 Next nb_char_prst
124 Exit For
125 Else
126 End If
127 Next nb_char
128 If (Extension_Final = ".html" Or Extension_Final = ".HTML") Then
129 TextBox1.AppendText(TimeOfDay.Hour.ToString + ":" + TimeOfDay.Minute.ToString + ":" + TimeOfDay.Second.ToString + " -> Extension correcte !" + vbCrLf)
130 Flag_Extension = True
131 Else
132 TextBox1.AppendText(TimeOfDay.Hour.ToString + ":" + TimeOfDay.Minute.ToString + ":" + TimeOfDay.Second.ToString + " -> Extension incorrecte !" + vbCrLf)
133 Flag_Extension = False
134 End If
135 Exit Sub
136
137 '-------------------------------------------------------------------------------
138 '------------ Traitement des erreurs ----------
139 '-------------------------------------------------------------------------------
140Errhandler_Avec_Diagnostic:
141 Call U_Msg_Local1.Affiche_Erreur("Check Extension")
142 Resume Next
143 '------------ Fin traitement des erreurs ------------
144 End Sub
145
146 Private Sub Create_File_Html(File_Html As String, Flag_File As Boolean, type_file As String)
147
148 On Error GoTo Errhandler_Avec_Diagnostic
149 'copie des css et images necessaire pour l'entète de la page html
150 Dim exePath As String = System.IO.Path.GetDirectoryName( _
151 System.Reflection.Assembly.GetExecutingAssembly().CodeBase)
152 exePath = exePath.Substring(6)
153
154 'on copie tous les fichiers sources en local pour ne pas dépendre d'un quelconque accès réseau pour afficher la page
155 If (File.Exists("cgi00.css")) Then
156 File.Copy(Path.Combine(exePath, "cgi00.css"), Path.Combine(U_Memo_Txt_Mirror1.Memo1_Text.ToString, "cgi00.css"), True)
157 End If
158 If (File.Exists("StyleSheet.css")) Then
159 File.Copy(Path.Combine(exePath, "StyleSheet.css"), Path.Combine(U_Memo_Txt_Mirror1.Memo1_Text.ToString, "StyleSheet.css"), True)
160 End If
161 If (File.Exists("export.css")) Then
162 File.Copy(Path.Combine(exePath, "export.css"), Path.Combine(U_Memo_Txt_Mirror1.Memo1_Text.ToString, "export.css"), True)
163 End If
164 If (File.Exists("amstock.js")) Then
165 File.Copy(Path.Combine(exePath, "amstock.js"), Path.Combine(U_Memo_Txt_Mirror1.Memo1_Text.ToString, "amstock.js"), True)
166 End If
167 If (File.Exists("export.min.js")) Then
168 File.Copy(Path.Combine(exePath, "export.min.js"), Path.Combine(U_Memo_Txt_Mirror1.Memo1_Text.ToString, "export.min.js"), True)
169 End If
170 If (File.Exists("signature.gif")) Then
171 File.Copy(Path.Combine(exePath, "signature.gif"), Path.Combine(U_Memo_Txt_Mirror1.Memo1_Text.ToString, "signature.gif"), True)
172 End If
173 If (File.Exists("chart-icon2.gif")) Then
174 File.Copy(Path.Combine(exePath, "chart-icon2.gif"), Path.Combine(U_Memo_Txt_Mirror1.Memo1_Text.ToString, "chart-icon2.gif"), True)
175 End If
176 If (File.Exists("amcharts.js")) Then
177 File.Copy(Path.Combine(exePath, "amcharts.js"), Path.Combine(U_Memo_Txt_Mirror1.Memo1_Text.ToString, "amcharts.js"), True)
178 End If
179 If (File.Exists("light.js")) Then
180 File.Copy(Path.Combine(exePath, "light.js"), Path.Combine(U_Memo_Txt_Mirror1.Memo1_Text.ToString, "light.js"), True)
181 End If
182 If (File.Exists("serial.js")) Then
183 File.Copy(Path.Combine(exePath, "serial.js"), Path.Combine(U_Memo_Txt_Mirror1.Memo1_Text.ToString, "serial.js"), True)
184 End If
185
186 Dim folderIE As String = Path.GetDirectoryName(U_Memo_Txt_Mirror1.Memo1_Text.ToString + "\amcharts\images\") 'pour la compatibilité IE
187 Dim folder As String = Path.GetDirectoryName(U_Memo_Txt_Mirror1.Memo1_Text.ToString + "\images\") 'autres browser
188 Dim folder_history As String = Path.GetDirectoryName(U_Memo_Txt_Mirror1.Memo1_Text.ToString + "\history\")
189 If Not Directory.Exists(folderIE) Then
190 Directory.CreateDirectory(folderIE)
191 End If
192 If Not Directory.Exists(folder) Then
193 Directory.CreateDirectory(folder)
194 End If
195 If Not Directory.Exists(folder_history) Then
196 Directory.CreateDirectory(folder_history)
197 End If
198 If (File.Exists("lens.svg")) Then
199 File.Copy(Path.Combine(exePath, "lens.svg"), Path.Combine(folderIE, "lens.svg"), True)
200 File.Copy(Path.Combine(exePath, "lens.svg"), Path.Combine(folder, "lens.svg"), True)
201 End If
202 If (File.Exists("lens.png")) Then
203 File.Copy(Path.Combine(exePath, "lens.png"), Path.Combine(folderIE, "lens.png"), True)
204 End If
205 If (File.Exists("dragIconRoundBig.svg")) Then
206 File.Copy(Path.Combine(exePath, "dragIconRoundBig.svg"), Path.Combine(folderIE, "dragIconRoundBig.svg"), True)
207 File.Copy(Path.Combine(exePath, "dragIconRoundBig.svg"), Path.Combine(folder, "dragIconRoundBig.svg"), True)
208 End If
209 If (File.Exists("dragIconRoundBig.png")) Then
210 File.Copy(Path.Combine(exePath, "dragIconRoundBig.png"), Path.Combine(folderIE, "dragIconRoundBig.png"), True)
211 End If
212
213
214 Dim Page_Title As String = U_Memo_Txt_Mirror3.Memo1_Text.ToString
215 Dim Heading As String = U_Memo_Txt_Mirror4.Memo1_Text.ToString
216
217 Call Verify_Html_Parameters(U_Memo_Txt_Mirror3.Memo1_Text.ToString, U_Memo_Txt_Mirror4.Memo1_Text.ToString)
218 Call Index_Test_String(U_Memo_Txt_Mirror6.Memo1_Text.ToString)
219
220 If (Flag_Number_Int = True) Then
221 U_Memo_Txt_Mirror6.UCtl_Text_BackColor = Color.GreenYellow
222 If (Flag_File = True) Then
223
224 'si on veut auto refresh la page html
225 Dim Refreshing_html As String = ""
226 If (U_Memo_Check_Mirror2.CheckBox1.Checked) Then
227 Refreshing_html = "<META HTTP-EQUIV='Refresh' CONTENT='" & CStr(CInt(U_Memo_Txt_Mirror5.Memo1_Text) / 1000) & "'; URL='#'>"
228 End If
229
230
231 Select Case type_file
232 ' ####################### PAGE INDEX.HTML ###############################
233 Case "index.html"
234 Dim File_write_html As System.IO.StreamWriter
235 File_write_html = My.Computer.FileSystem.OpenTextFileWriter(File_Html, False)
236 'entete de la page:charge les feuilles de style,scripts et bandeau au formalisme du site intranet Schneider
237
238 File_write_html.WriteLine("<html>" & vbCrLf & "<head>" & vbCrLf & "<title>" & vbCrLf & Page_Title & vbCrLf & "</title>" & vbCrLf &
239 "<LINK REL='stylesheet' TYPE='text/css' HREF='cgi00.css' />" & vbCrLf & "<LINK REL='stylesheet' TYPE='text/css' HREF='StyleSheet.css' />" & vbCrLf & Refreshing_html & "</head>" & vbCrLf & "<body><img alt='Unity Integration' src='signature.gif' style='position: absolute; left: 0px; top: 0px;'>" & vbCrLf & header & "<span id='myBody'><p class='title'><a name='top'>Supervisor</a></p></span><br/><br/><div id='gammeTabs' align='center' style='cursor: pointer; font-size: 14pt;'><span id='link_CPU' style='font-size: 140%; color: rgb(255, 255, 255); background-color: rgb(189, 255, 130);'><a href='index.html'>Home</a></span> <span id='link_BOOT' style='font-size: 100%; background-color: white;'><a href='dashboard.html'><img src='chart-icon2.gif' border='0'> Dashboard test auto</a></span> </div>" & vbCrLf & "<br/><br/><table class='invsbl' align='CENTER' width='1200'><tbody><tr><td class='invsbl'><i><span style='padding-left: 10px; font-size: 10pt;'><table class='invsbl' align='CENTER' width='1200'><tbody><tr><td class='header' align='CENTER' colspan='4' width='22%'>Test name</td><td class='header' width='7%' align='CENTER'>Project Version <span style='cursor: pointer;'></span></td><td class='header' width='7%' align='CENTER'>Status<span style='cursor: pointer;'></span></td><td class='header' width='7%' align='CENTER'>Results<span style='cursor: pointer;'></span></td><td class='header' width='48%' align='CENTER'>Description <span style='cursor: pointer;'></span></td></tr><tr id='1'><td class='section' colspan='8' id='colspan1'>IR" & U_Memo_Txt_Mirror4.Memo1_Text.ToString & "</td></tr>")
240 File_write_html.Close()
241 Dim time_elapsed As TimeSpan
242 Dim jsgraph As String = ""
243 Dim jsevent As String = ""
244 Dim d_date As Date = Now
245 Threading.Thread.Sleep(2000)
246 'stocke les temps de génération de la page dans data.html
247 Calculate_jsGraph_Html(d_date, time_elapsed, jsgraph, jsevent, "index")
248 Dim sourceData As String = New System.Net.WebClient().DownloadString(U_Memo_Txt_Mirror1.Memo1_Text.ToString & "\" & "data.html")
249 If (sourceData.Length = 0) Then
250 If (all_data.Length = 0) Then
251 all_data = all_data & jsgraph
252 Else
253 all_data = all_data & "," & jsgraph
254 End If
255 If (all_event.Length = 0) Then
256 all_event = all_event & jsevent
257 Else
258 all_event = all_event & "," & jsevent
259 End If
260 Else
261 all_data = all_data & "," & jsgraph
262 all_event = all_event & "," & jsevent
263 End If
264 If (all_history_data.Length > 0) Then
265 all_history_data = all_history_data & "," & jsgraph
266 Else
267 all_history_data = jsgraph
268 End If
269 ' ####################### PAGE DASHBOARD.HTML ###############################
270 Case "dashboard.html"
271 Dim File_write_html As System.IO.StreamWriter
272 File_write_html = My.Computer.FileSystem.OpenTextFileWriter(File_Html, False)
273 'entete du fichier
274 File_write_html.WriteLine("<html>" & vbCrLf & "<head>" & vbCrLf & "<title>" & vbCrLf & "Dashboard test-auto" & vbCrLf & "</title>" & vbCrLf &
275 "<LINK REL='stylesheet' TYPE='text/css' HREF='cgi00.css' />" & vbCrLf & "<LINK REL='stylesheet' TYPE='text/css' HREF='StyleSheet.css' />" & vbCrLf & Refreshing_html & vbCrLf & "<!-- amCharts javascript sources -->" & vbCrLf & "<script type='text/javascript' src='amcharts.js'></script>" & vbCrLf & "<script type='text/javascript' src='serial.js'></script>" & vbCrLf & "<script type='text/javascript' src='light.js'></script>" & vbCrLf & "<script src='amstock.js'></script>" & vbCrLf & "<script src='export.min.js'></script>" & vbCrLf & "<link rel='stylesheet' href='export.css' type='text/css' media='all' />" & vbCrLf & "<!-- Styles -->" & vbCrLf & "<style>#chartdiv {width: 98%;margin-left:10px;margin-right:10px;height: 500px;}</style>")
276 File_write_html.Close()
277
278 Dim time_elapsed As TimeSpan
279 Dim jsgraph As String = ""
280 Dim jsevent As String = ""
281 Threading.Thread.Sleep(1000)
282 Dim d_date As Date = Now
283 Threading.Thread.Sleep(4000) 'on ralentis la génération de la page pour que ce soit plus visible dans le dashboard
284 'calcul du temps de génération de la page
285 Calculate_jsGraph_Html(d_date, time_elapsed, jsgraph, jsevent, "dashboard")
286
287 Dim sourceData As String = New System.Net.WebClient().DownloadString(U_Memo_Txt_Mirror1.Memo1_Text.ToString & "\" & "data.html")
288
289 If (sourceData.Length = 0) Then
290 If (all_data.Length = 0) Then
291 all_data = all_data & jsgraph
292 Else
293 all_data = all_data & "," & jsgraph
294 End If
295 If (all_event.Length = 0) Then
296 all_event = all_event & jsevent
297 Else
298 all_event = all_event & "," & jsevent
299 End If
300 Else
301 all_data = all_data & "," & jsgraph
302 all_event = all_event & "," & jsevent
303 End If
304 If (all_history_data.Length > 0) Then
305 all_history_data = all_history_data & "," & jsgraph
306 Else
307 all_history_data = jsgraph
308 End If
309 Dim stringjsgraph As String = Nothing
310 's'il n'y a aucune data de stockée dans le fichier data.html c'est que c'est la première fois que l'on génère la page donc on charge le buffer sinon on affiche le contenu des valeurs de la page data.html
311 stringjsgraph = "<script type='text/javascript'>" & vbCrLf & "var chartData1=[];generateChartData();function generateChartData(){chartData1.push(" & all_data
312
313 File_write_html = My.Computer.FileSystem.OpenTextFileWriter(File_Html, True)
314 File_write_html.WriteLine(stringjsgraph & ")}var chart=AmCharts.makeChart('chartdiv',{type:'stock',theme:'light',dataDateFormat:'YYYY-MM-DD HH:NN:SS',categoryAxis:{minPeriod:'ss',parseDates:!0},categoryAxesSettings:{minPeriod:'ss',parseDates:!0},dataSets:[{color:'#b0de09',fieldMappings:[{fromField:'value',toField:'value'},{fromField:'volume',toField:'volume'}],dataProvider:chartData1,categoryField:'date',stockEvents:[" & all_event & "]}],panels:[{stockGraphs:[{id:'g1',lineThickness:5,valueField:'value'}],stockLegend:{valueTextRegular:' ',markerType:'none'}}],chartScrollbarSettings:{graph:'g1',position:'top'},chartCursorSettings:{valueBalloonsEnabled:!0,graphBulletSize:1,valueLineBalloonEnabled:!0,valueLineEnabled:!0,valueLineAlpha:.5},periodSelector:{position:'top',dateFormat:'YYYY-MM-DD,JJ:NN',inputFieldWidth:150,periods:[{period:'MAX',label:'MAX'}]},panelsSettings:{usePrefixes:!0},'export':{enabled:!0,position:'bottom-right'}});" & vbCrLf & "</script>" & vbCrLf & "</head>" & vbCrLf & "<body><img alt='Unity Integration' src='signature.gif' style='position: absolute; left: 0px; top: 0px;'>" & vbCrLf & header & "<span id='myBody'><p class='title'><a name='top'>Supervisor</a></p></span><br/><br/><div id='gammeTabs' align='center' style='cursor: pointer; font-size: 14pt;'><span id='link_CPU' style='font-size: 100%; background-color: white;'><a href='index.html'>Home</a></span> <span id='link_BOOT' style='font-size: 140%; color: rgb(255, 255, 255); background-color: rgb(189, 255, 130);' ><a href='dashboard.html'><img src='chart-icon2.gif' border='0'> Dashboard test auto</a></span> </div>" & vbCrLf & "<br/><br/> <div id='chartdiv' style='width: 100%; height: 400px; background-color: #FFFFFF;' ></div>" & vbCrLf & "<br/>File generated in " & time_elapsed.TotalMilliseconds.ToString() & " milliseconds " & vbCrLf & "<br/><div align='center'> This page was generated on " & Date.Now.ToString & "</div>" & vbCrLf & "</body>" & vbCrLf & "</html>")
315 File_write_html.Close()
316 nb_test_html = nb_test_html + 1
317 nb_all_test = nb_all_test + 1
318
319 '############################### archivage de la page du test #####################################
320
321 Dim current_day As Integer = Date.Now.Day
322 Dim current_month_str As String = Date.Now.Month.ToString
323 If (current_month_str.Length = 1) Then
324 current_month_str = "0" + current_month_str
325 End If
326 Dim current_year As Integer = Date.Now.Year
327 Dim current_hour_str As String = Date.Now.Hour.ToString
328 If (current_hour_str.Length = 1) Then
329 current_hour_str = "0" + current_hour_str
330 End If
331 Dim current_min_str As String = Date.Now.Minute.ToString
332 If (current_min_str.Length = 1) Then
333 current_min_str = "0" + current_min_str
334 End If
335 Dim current_sec As Integer = Date.Now.Second
336
337 Dim backup_file = U_Memo_Txt_Mirror1.Memo1_Text.ToString & "\history\dashboard_" & current_year.ToString & current_month_str & current_day.ToString & current_hour_str & current_min_str & current_sec.ToString & ".html"
338
339 File_write_html = My.Computer.FileSystem.OpenTextFileWriter(backup_file, True)
340 File_write_html.WriteLine("<html>" & vbCrLf & "<head>" & vbCrLf & "<title>" & vbCrLf & "Dashboard test-auto" & vbCrLf & "</title>" & vbCrLf &
341 "<LINK REL='stylesheet' TYPE='text/css' HREF='../cgi00.css' />" & vbCrLf & "<LINK REL='stylesheet' TYPE='text/css' HREF='../StyleSheet.css' />" & vbCrLf & Refreshing_html & vbCrLf & "<!-- amCharts javascript sources -->" & vbCrLf & "<script type='text/javascript' src='../amcharts.js'></script>" & vbCrLf & "<script type='text/javascript' src='../serial.js'></script>" & vbCrLf & "<script type='text/javascript' src='../light.js'></script>" & vbCrLf & "<script src='../amstock.js'></script>" & vbCrLf & "<script src='../export.min.js'></script>" & vbCrLf & "<link rel='stylesheet' href='../export.css' type='text/css' media='all' />" & vbCrLf & "<!-- Styles -->" & vbCrLf & "<style>#chartdiv {width: 98%;margin-left:10px;margin-right:10px;height: 500px;}</style>" & "<script type='text/javascript'>" & vbCrLf & "var chartData1=[];generateChartData();function generateChartData(){chartData1.push(" & all_history_data & ")}var chart=AmCharts.makeChart('chartdiv',{type:'stock',theme:'light',dataDateFormat:'YYYY-MM-DD HH:NN:SS',categoryAxis:{minPeriod:'ss',parseDates:!0},categoryAxesSettings:{minPeriod:'ss',parseDates:!0},dataSets:[{color:'#b0de09',fieldMappings:[{fromField:'value',toField:'value'},{fromField:'volume',toField:'volume'}],dataProvider:chartData1,categoryField:'date',stockEvents:[" & all_event & "]}],panels:[{stockGraphs:[{id:'g1',lineThickness:5,valueField:'value'}],stockLegend:{valueTextRegular:' ',markerType:'none'}}],chartScrollbarSettings:{graph:'g1',position:'top'},chartCursorSettings:{valueBalloonsEnabled:!0,graphBulletSize:1,valueLineBalloonEnabled:!0,valueLineEnabled:!0,valueLineAlpha:.5},periodSelector:{position:'top',dateFormat:'YYYY-MM-DD,JJ:NN',inputFieldWidth:150,periods:[{period:'MAX',label:'MAX'}]},panelsSettings:{usePrefixes:!0},'export':{enabled:!0,position:'bottom-right'}});" & vbCrLf & "</script>" & vbCrLf & "</head>" & vbCrLf & "<body><img alt='Unity Integration' src='../signature.gif' style='position: absolute; left: 0px; top: 0px;'>" & vbCrLf & header & "<span id='myBody'><p class='title'><a name='top'>Supervisor</a></p></span>" & vbCrLf & "<br/><br/> <div id='chartdiv' style='width: 100%; height: 400px; background-color: #FFFFFF;' ></div>" & vbCrLf & "<br/>File generated in " & time_elapsed.TotalMilliseconds.ToString() & " milliseconds " & vbCrLf & "<br/><div align='center'> This page was generated on " & Date.Now.ToString & "</div>" & vbCrLf & "</body>" & vbCrLf & "</html>")
342 File_write_html.Close()
343 all_history_data = ""
344 current_time_elapsed = time_elapsed.TotalMilliseconds.ToString()
345 ' ####################### PAGE DATA.HTML ###############################
346 Case "data.html"
347 Dim File_write_html As System.IO.StreamWriter
348 File_write_html = My.Computer.FileSystem.OpenTextFileWriter(File_Html, False)
349 File_write_html.WriteLine(all_data)
350 File_write_html.Close()
351 End Select
352
353
354 TextBox1.AppendText(TimeOfDay.Hour.ToString + ":" + TimeOfDay.Minute.ToString + ":" + TimeOfDay.Second.ToString + " -> Fichier rempli !" + vbCrLf)
355 Else
356 TextBox1.AppendText(TimeOfDay.Hour.ToString + ":" + TimeOfDay.Minute.ToString + ":" + TimeOfDay.Second.ToString + " -> Fichier non rempli !" + vbCrLf)
357 End If
358 Else
359 U_Memo_Txt_Mirror6.UCtl_Text_BackColor = Color.OrangeRed
360 TextBox1.AppendText(TimeOfDay.Hour.ToString + ":" + TimeOfDay.Minute.ToString + ":" + TimeOfDay.Second.ToString + " -> Nombre de lignes entrées incorrect !" + vbCrLf)
361 End If
362
363 Exit Sub
364
365 '-------------------------------------------------------------------------------
366 '------------ Traitement des erreurs ----------
367 '-------------------------------------------------------------------------------
368Errhandler_Avec_Diagnostic:
369 Call U_Msg_Local1.Affiche_Erreur("Create File Html")
370 Resume Next
371 '------------ Fin traitement des erreurs ------------
372 End Sub
373
374 Private Sub Verify_Html_Parameters(param1 As String, param2 As String)
375 On Error GoTo Errhandler_Avec_Diagnostic
376
377 If (param1 = "") Then
378 U_Memo_Txt_Mirror3.UCtl_Text_BackColor = Color.Yellow
379 Else
380 U_Memo_Txt_Mirror3.UCtl_Text_BackColor = Color.GreenYellow
381 End If
382 If (param2 = "") Then
383 U_Memo_Txt_Mirror4.UCtl_Text_BackColor = Color.Yellow
384 Else
385 U_Memo_Txt_Mirror4.UCtl_Text_BackColor = Color.GreenYellow
386 End If
387 Exit Sub
388
389 '-------------------------------------------------------------------------------
390 '------------ Traitement des erreurs ----------
391 '-------------------------------------------------------------------------------
392Errhandler_Avec_Diagnostic:
393 Call U_Msg_Local1.Affiche_Erreur("Index Test String")
394 Resume Next
395 '------------ Fin traitement des erreurs ------------
396 End Sub
397
398 Private Sub Index_Test_String(Index As String)
399 On Error GoTo Errhandler_Avec_Diagnostic
400
401 If (Val(Index) = 0) Then
402 Flag_Number_Int = False
403 Else
404 Flag_Number_Int = True
405 End If
406 Exit Sub
407
408 '-------------------------------------------------------------------------------
409 '------------ Traitement des erreurs ----------
410 '-------------------------------------------------------------------------------
411Errhandler_Avec_Diagnostic:
412 Call U_Msg_Local1.Affiche_Erreur("Index Test String")
413 Resume Next
414 '------------ Fin traitement des erreurs ------------
415 End Sub
416
417 Private Sub Create_Table_Html(File_Html As String)
418 On Error GoTo Errhandler_Avec_Diagnostic
419
420 Dim number_test_played = Directory.GetFiles(U_Memo_Txt_Mirror1.Memo1_Text.ToString & "\history", "*.html")
421
422 Dim test_name = "Test"
423 Dim test_version = "/"
424 Dim test_status = "<font color='green'>OK</font>"
425 Dim test_results = current_time_elapsed
426 Dim test_description = "Generation dynamical HTML page "
427
428 Dim Table_html As String = ""
429 For cpt_ligne = 1 To number_test_played.Length
430 Table_html = Table_html & vbCrLf & "<tr id='1.1." & number_test_played.Length.ToString & "'><td class='invsbl' style='width: 15px;'> </td><td class='invsbl' style='width: 15px;'> </td><td id='colspan1.1.1' colspan='2'>" & test_name & " " & cpt_ligne.ToString & "</td><td class='colspan1.1.1' align='center' width='7%'>" & test_version & "</td><td class='colspan1.1.1' align='center' width='7%'>" & test_status & "</td><td class='colspan1.1.1' align='center' width='7%'>" & test_results & "</td><td class='colspan1.1.1' align='left' width='48%'><warn>" & test_description & "<a href='\\wsfr30004\PROJECTS\CTRL_Projets\0_FW_Development_Process_Access\100_FwTools\1_Tool_TESTAUTO\12_HTML_Supervisor\multichart\history\" & System.IO.Path.GetFileName(number_test_played(cpt_ligne - 1).ToString) & "' target='_blank'>Result graph</a></warn></td></tr>"
431
432 Next cpt_ligne
433
434 Dim File_write_html As System.IO.StreamWriter
435 File_write_html = My.Computer.FileSystem.OpenTextFileWriter(File_Html, True)
436 File_write_html.WriteLine(Table_html & vbCrLf & "<tr><td class='invsbl' style='width: 15px;'></td><td class='invsbl' style='width: 15px;'></td><td class='invsbl' style='width: 15px;'></td><td class='invsbl' style='width:200px;'></td></tr></tbody></table><div id='light' class='white_content' align='center'></div><div id='fade' class='black_overlay'></div></span></i></td></tr></tbody></table><div align='center'> This page was generated on " & Date.Now.ToString & "</div>" & vbCrLf & "</body>" & vbCrLf & "</html>")
437 File_write_html.Close()
438
439
440 'Dim Nb_ligne, cpt_ligne As Integer
441 'Dim Table_html As String = ""
442 'Nb_ligne = CInt(Val(U_Memo_Txt_Mirror6.Memo1_Text.ToString))
443 'For cpt_ligne = 1 To Nb_ligne
444 ' Table_html = Table_html & vbCrLf & "<tr id='1.1." & Nb_ligne.ToString & "'><td class='invsbl' style='width: 15px;'> </td><td class='invsbl' style='width: 15px;'> </td><td id='colspan1.1.1' colspan='2'>" & test_name & cpt_ligne & "</td><td class='colspan1.1.1' align='center' width='7%'>" & test_version & cpt_ligne & "</td><td class='colspan1.1.1' align='center' width='7%'>" & test_status & cpt_ligne & "</td><td class='colspan1.1.1' align='center' width='7%'>" & test_results & cpt_ligne & "</td><td class='colspan1.1.1' align='left' width='48%'><warn>" & test_description & cpt_ligne & "</warn></td></tr>"
445
446 'Next cpt_ligne
447
448 'Dim File_write_html As System.IO.StreamWriter
449 'File_write_html = My.Computer.FileSystem.OpenTextFileWriter(File_Html, True)
450 'File_write_html.WriteLine(Table_html & vbCrLf & "<tr><td class='invsbl' style='width: 15px;'></td><td class='invsbl' style='width: 15px;'></td><td class='invsbl' style='width: 15px;'></td><td class='invsbl' style='width:200px;'></td></tr></tbody></table><div id='light' class='white_content' align='center'></div><div id='fade' class='black_overlay'></div></span></i></td></tr></tbody></table><div align='center'> This page was generated on " & Date.Now.ToString & "</div>" & vbCrLf & "</body>" & vbCrLf & "</html>")
451 'File_write_html.Close()
452
453 Exit Sub
454 '-------------------------------------------------------------------------------
455 '------------ Traitement des erreurs ----------
456 '-------------------------------------------------------------------------------
457Errhandler_Avec_Diagnostic:
458 Call U_Msg_Local1.Affiche_Erreur("Create_Table_Html")
459 Resume Next
460 '------------ Fin traitement des erreurs ------------
461 End Sub
462
463 Public Sub Calculate_jsGraph_Html(d_date As Date, ByRef d_Result As TimeSpan, ByRef string_data As String, ByRef string_event As String, ByVal type As String)
464 On Error GoTo Errhandler_Avec_Diagnostic
465 'stockage des valeurs pour construire le graph javascript dynamiquement
466 d_Result = (Now - d_date)
467
468 Dim current_day As Integer = Date.Now.Day
469 Dim current_month_str As String = Date.Now.Month.ToString
470 If (current_month_str.Length = 1) Then
471 current_month_str = "0" + current_month_str
472 End If
473 Dim current_year As Integer = Date.Now.Year
474 Dim current_hour_str As String = Date.Now.Hour.ToString
475 If (current_hour_str.Length = 1) Then
476 current_hour_str = "0" + current_hour_str
477 End If
478 Dim current_min_str As String = Date.Now.Minute.ToString
479 If (current_min_str.Length = 1) Then
480 current_min_str = "0" + current_min_str
481 End If
482 Dim current_sec As Integer = Date.Now.Second
483
484 Dim delay_sec As Integer = d_Result.Seconds
485
486 Select Case type
487 Case "index"
488 For i = 0 To delay_sec
489 If (i = 0) Then
490 string_data = string_data & "{'date':'" & current_year.ToString & "-" & current_month_str & "-" & current_day.ToString & " " & current_hour_str & ":" & current_min_str & ":" & (current_sec - delay_sec).ToString & "','value':0},"
491 string_data = string_data & "{'date':'" & current_year.ToString & "-" & current_month_str & "-" & current_day.ToString & " " & current_hour_str & ":" & current_min_str & ":" & (current_sec - delay_sec).ToString & "','value':1},"
492 ElseIf (i = delay_sec) Then
493 string_data = string_data & "{'date':'" & current_year.ToString & "-" & current_month_str & "-" & current_day.ToString & " " & current_hour_str & ":" & current_min_str & ":" & current_sec.ToString & "','value':1},"
494 string_data = string_data & "{'date':'" & current_year.ToString & "-" & current_month_str & "-" & current_day.ToString & " " & current_hour_str & ":" & current_min_str & ":" & current_sec.ToString & "','value':0}"
495 string_event = string_event & "{'date':'" & current_year.ToString & "-" & current_month_str & "-" & current_day.ToString & " " & current_hour_str & ":" & current_min_str & ":" & current_sec.ToString & "',type:'text',backgroundColor:'#85CDE6',graph:'g1',text:'END smoke test 1'}"
496 Else
497 string_data = string_data & "{'date':'" & current_year.ToString & "-" & current_month_str & "-" & current_day.ToString & " " & current_hour_str & ":" & current_min_str & ":" & (current_sec - delay_sec + i).ToString & "','value':1},"
498 End If
499 Next
500 Case "dashboard"
501 For i = 0 To delay_sec
502 If (i = 0) Then
503 string_data = string_data & "{'date':'" & current_year.ToString & "-" & current_month_str & "-" & current_day.ToString & " " & current_hour_str & ":" & current_min_str & ":" & (current_sec - delay_sec).ToString & "','value':0},"
504 string_data = string_data & "{'date':'" & current_year.ToString & "-" & current_month_str & "-" & current_day.ToString & " " & current_hour_str & ":" & current_min_str & ":" & (current_sec - delay_sec).ToString & "','value':2},"
505 ElseIf (i = delay_sec) Then
506 string_data = string_data & "{'date':'" & current_year.ToString & "-" & current_month_str & "-" & current_day.ToString & " " & current_hour_str & ":" & current_min_str & ":" & current_sec.ToString & "','value':2},"
507 string_data = string_data & "{'date':'" & current_year.ToString & "-" & current_month_str & "-" & current_day.ToString & " " & current_hour_str & ":" & current_min_str & ":" & current_sec.ToString & "','value':0}"
508 string_event = string_event & "{'date':'" & current_year.ToString & "-" & current_month_str & "-" & current_day.ToString & " " & current_hour_str & ":" & current_min_str & ":" & current_sec.ToString & "',type:'text',backgroundColor:'#85CDE6',graph:'g1',text:'END smoke test 2'}"
509 Else
510 string_data = string_data & "{'date':'" & current_year.ToString & "-" & current_month_str & "-" & current_day.ToString & " " & current_hour_str & ":" & current_min_str & ":" & (current_sec - delay_sec + i).ToString & "','value':2},"
511 End If
512 Next
513 End Select
514
515
516
517 Exit Sub
518 '-------------------------------------------------------------------------------
519 '------------ Traitement des erreurs ----------
520 '-------------------------------------------------------------------------------
521Errhandler_Avec_Diagnostic:
522 Call U_Msg_Local1.Affiche_Erreur("Calculate_jsGraph_Html")
523 Resume Next
524 '------------ Fin traitement des erreurs ------------
525 End Sub
526
527 Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
528 Button4.PerformClick()
529
530 End Sub
531
532 Private Sub CheckBox1_CheckedChanged(sender As Object, e As EventArgs) Handles U_Memo_Check_Mode_Auto.CheckBox_State_Changed
533
534 If (U_Memo_Check_Mode_Auto.Checked) Then
535 get_params_mode_auto()
536 Timer1.Interval = CInt(U_Memo_Txt_Mirror5.Memo1_Text)
537 Timer1.Enabled = True
538 Timer1.Start()
539 Button4.PerformClick()
540 U_Memo_Check_Mode_Auto.UCtl_Text_Color = Color.Green
541 Else
542 Timer1.Enabled = False
543 Timer1.Stop()
544 U_Memo_Check_Mode_Auto.UCtl_Text_Color = Color.Red
545 End If
546 End Sub
547
548 Public Sub get_params_mode_auto()
549 'U_Memo_Txt_Mirror2.Memo1_Text = "index.html" 'html file name
550 'U_Memo_Txt_Mirror1.Memo1_Text = "\\wsfr30004\PROJECTS\CTRL_Projets\0_FW_Development_Process_Access\100_FwTools\1_Tool_TESTAUTO\12_HTML_Supervisor\multichart" 'html file path
551 'U_Memo_Txt_Mirror1.Memo1_Text = "C:\temp\1" 'html file path
552 U_Memo_Txt_Mirror3.Memo1_Text = "Scripts library" 'page title
553 U_Memo_Txt_Mirror4.Memo1_Text = "FW_Dev_Scripts" 'ir
554 'U_Memo_Txt_Mirror6.Memo1_Text = "1" 'number line
555 End Sub
556
557 Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
558 Button1.BackColor = Color.Yellow
559
560 '***************************************************************************************
561 '*** Pas de vérification + clean des fichiers en mode manu [PCh le 29 mai 2018] ****
562 '*** ****
563 '*** Note1: Supprimé au lancement car la recherche réseau prend 40s au lancement ! ****
564 '***************************************************************************************
565
566 If (U_Memo_Check_Mode_Auto.Checked = True) Then
567
568 'on clean le fichier data.html
569 Dim test = Path.Combine(U_Memo_Txt_Mirror1.Memo1_Text, "data.html")
570 If (File.Exists(test)) Then
571 My.Computer.FileSystem.DeleteFile(test)
572 End If
573 'on clean le buffer contenant les valeurs stockées
574 all_data = ""
575 TextBox1.AppendText(TimeOfDay.Hour.ToString + ":" + TimeOfDay.Minute.ToString + ":" + TimeOfDay.Second.ToString + " -> All data cleaned" + vbCrLf)
576 Button1.BackColor = Color.YellowGreen
577
578 Else
579 '***** CLEAN not done => Show in button **********************
580 Button1.BackColor = Color.Orange
581 Button1.Text = Button1.Text & " Not done"
582
583 End If '*** If (U_Memo_Check_Mode_Auto.Checked = True)
584
585
586
587 End Sub
588
589
590
591 Private Sub Html_Gen_Button_Click(sender As Object, e As EventArgs) Handles Html_Gen_Button.Click
592 Init_And_Fill_Database()
593 Html_Gen()
594 End Sub
595
596
597
598 Private Sub Init_And_Fill_Database()
599 '------------ Initialize and fill U_Db_Database_Logs_Events_Unity ---------------------
600 '--------------------------------------------------------------------------------------
601 Dim u_db_logs_unity As Object = Nothing
602 Dim u_db_logs_unity_t As U_Db_Database_Log_Events = Nothing
603
604 Dim type_name As String = GetType(U_Db_Database_Log_Events).ToString()
605
606 '-------------- Get U_Generate_Html_Page1 object using Object Search unit --------------
607 U_Node_Search_Object_By_Name1.Search_Object_By_Name_And_Type("U_Db_Database_Log_Events_Unity", type_name, u_db_logs_unity)
608
609 '-------------- Check if an object was returned by the previous function ---------------
610 If u_db_logs_unity Is Nothing Then
611 U_Msg_Local1.Aff_Coul_RGB(U_Msg_Local.Type_Warning.Aff_INFO, Color.OrangeRed, "U_Generate_Html_Page was not found!")
612 Else
613 '------ If the HTML page generator was returned, call the generation function ------
614 u_db_logs_unity_t = CType(u_db_logs_unity, U_Db_Database_Log_Events)
615 End If
616
617 '------------ Fill database
618 u_db_logs_unity_t.auto_Open_DB()
619 u_db_logs_unity_t.Fill_Database_Logs_Events_Unity()
620 End Sub
621
622
623 '-------------------------------------------------------------------------------------------------------------
624 '------------------------ FUNCTION to generate test results in an HTML report -------------------------------
625 '-------------------------------------------------------------------------------------------------------------
626 Public Sub Html_Gen()
627 On Error GoTo Errhandler_Avec_Diagnostic
628
629 '----------------------------------------------
630 '------------ Get data from database ----------
631 '----------------------------------------------
632 'Read_Database_Logs_Events_Unity(Loop_Counter_Unity)
633
634
635 '-----------------------------------------------------------
636 '---------- GENERATE HTML REPORT ---------------------------
637 '-----------------------------------------------------------
638 '============== Initialisation du texte du fichier HTML
639 Dim millisecs As Double
640 Dim startTime As Double = System.DateTime.Now.Ticks
641 'Dim stopwatch As Stopwatch = stopwatch.StartNew() 'creates and starts the instance of Stopwatch
642
643 Dim Html_Text As String = "" 'Content of html file (to be written)
644
645 Dim _Height As Integer = 500
646 If ((U_Memo_Txt_Height.Memo1_Text).Length < 4) Then
647 _Height = CInt(U_Memo_Txt_Height.Memo1_Text)
648 End If
649
650 Dim _Width As Integer = 900
651 If ((U_Memo_Txt_Width.Memo1_Text).Length < 4) Then
652 _Width = CInt(U_Memo_Txt_Width.Memo1_Text)
653 End If
654
655 Dim W_Offset As Integer = CInt(_Width / 8)
656 Dim H_Offset As Integer = CInt(_Height / 8)
657 Dim Tick_len As Integer = CInt(H_Offset / 10)
658
659 Dim File_write_html As System.IO.StreamWriter
660
661
662 '=======================================================
663 '========= PART 0 : Entête HTML ========================
664 '=======================================================
665 Html_Text = Html_Text + "<!-- ======================================== -->" & vbCrLf _
666 & "<!-- ======================================== -->" & vbCrLf _
667 & "<!-- ======== PART 0 : Entête HTML ========== -->" & vbCrLf _
668 & "<!-- ======================================== -->" & vbCrLf _
669 & "<!-- ======================================== -->" & vbCrLf _
670 & "<html><head><title>Dashboard Test AUTO</title>" & vbCrLf & vbCrLf
671
672
673 '=============================================================
674 '========= PART 1A : Fiche de style 1 ========================
675 '=============================================================
676 Html_Text = Html_Text + "<!-- ======================================== -->" & vbCrLf _
677 & "<!-- ======================================== -->" & vbCrLf _
678 & "<!-- ===== PART 1A : Fiche de style 1 ======== -->" & vbCrLf _
679 & "<!-- ======================================== -->" & vbCrLf _
680 & "<!-- ======================================== -->" & vbCrLf _
681 & "<LINK REL='stylesheet' TYPE='text/css' HREF='cgi00.css' />" & vbCrLf & vbCrLf
682
683
684 '=============================================================
685 '========= PART 1B : Fiche de style 2 ========================
686 '=============================================================
687 Html_Text = Html_Text + "<!-- ======================================== -->" & vbCrLf _
688 & "<!-- ======================================== -->" & vbCrLf _
689 & "<!-- ===== PART 1B : Fiche de style 2 ======== -->" & vbCrLf _
690 & "<!-- ======================================== -->" & vbCrLf _
691 & "<!-- ======================================== -->" & vbCrLf _
692 & "<LINK REL='stylesheet' TYPE='text/css' HREF='StyleSheet.css' />" & vbCrLf & vbCrLf
693
694 '=======================================================
695 '========= PART 2 : ZONE GRAPHIQUE ========================
696 '=======================================================
697 Html_Text = Html_Text + "<!-- ======================================== -->" & vbCrLf _
698 & "<!-- ======================================== -->" & vbCrLf _
699 & "<!-- ===== PART 2 : ZONE GRAPHIQUE ======== -->" & vbCrLf _
700 & "<!-- ======================================== -->" & vbCrLf _
701 & "<!-- ======================================== -->" & vbCrLf _
702 & "<META HTTP-EQUIV='Refresh' CONTENT='60'; URL='#'>" & vbCrLf _
703 & "</head>" & vbCrLf _
704 & "<body><img alt='Unity Integration' src='signature.gif' style='position: absolute; left: 0px; top: 0px;'>" & vbCrLf _
705 & "<div style='padding-left: 150px; top: 0px; background-color:#FFFFFF;' width='100%' border='0' cellspacing='0' cellpadding='0' class='horizontalNav'><table cellspacing='0' cellpadding='0' width='100%' class='Menu1' id='Menu1' style='background-color:#FFFFFF;' border='0'><tbody><tr><td onmouseout='leaveLayer(this); applyStyle(this.id, "normal");' onmouseover='deployLayer(this);' id='Cell1_1' class='normal'><table cellspacing='0' cellpadding='0' class='Menu1_roundTop'><tbody><tr><td class='top' style='background-color: #FFFFFF;'> </td></tr></tbody></table><table cellspacing='0' cellpadding='0' class='Menu1_content'><tbody><tr><td class='padding'> </td><td valign='top'><a target='_self' href='http://unity-intranets/iqfirmware/iqfw_lv1/index.htm?platform='>Home</a></td><td class='padding'> </td></tr></tbody></table></td><td class='menuSeparator'> </td><td onmouseout='leaveLayer(this); applyStyle(this.id, "normal");' onmouseover='deployLayer(this);' id='Cell1_2' class='normal'><table cellspacing='0' cellpadding='0' class='Menu1_roundTop'><tbody><tr><td class='top' style='background-color: #FFFFFF;'> </td></tr></tbody></table><table cellspacing='0' cellpadding='0' class='Menu1_content'><tbody><tr><td class='padding'> </td><td valign='top'><a target='_self' href='javascript: void(0)'>Team</a></td><td class='padding'> </td></tr></tbody></table></td><td class='menuSeparator'> </td><td onmouseout='leaveLayer(this); applyStyle(this.id, "normal");' onmouseover='deployLayer(this);' id='Cell1_3' class='normal'><table cellspacing='0' cellpadding='0' class='Menu1_roundTop'><tbody><tr><td class='top' style='background-color: #FFFFFF;'> </td></tr></tbody></table><table cellspacing='0' cellpadding='0' class='Menu1_content'><tbody><tr><td class='padding'> </td><td valign='top'><a target='_self' href='javascript: void(0)'>Integration</a></td><td class='padding'> </td></tr></tbody></table></td><td class='menuSeparator'> </td><td onmouseout='leaveLayer(this); applyStyle(this.id, "normal");' onmouseover='deployLayer(this);' id='Cell1_4' class='normal'><table cellspacing='0' cellpadding='0' class='Menu1_roundTop'><tbody><tr><td class='top' style='background-color: #FFFFFF;'> </td></tr></tbody></table><table cellspacing='0' cellpadding='0' class='Menu1_content'><tbody><tr><td class='padding'> </td><td valign='top'><a target='_self' href='http://unity-intranets/iqfirmware/Tools/Tools.htm?platform='>Tools</a></td><td class='padding'> </td></tr></tbody></table></td><td class='menuSeparator'> </td><td onmouseout='leaveLayer(this); applyStyle(this.id, "normal");' onmouseover='deployLayer(this);' id='Cell1_5' class='normal'><table cellspacing='0' cellpadding='0' class='Menu1_roundTop'><tbody><tr><td class='top' style='background-color: #FFFFFF;'> </td></tr></tbody></table><table cellspacing='0' cellpadding='0' class='Menu1_content'><tbody><tr><td class='padding'> </td><td valign='top'><a target='_self' href='http://unity-intranets/iqfirmware/Documents/documents_.htm?platform='>Documents</a></td><td class='padding'> </td></tr></tbody></table></td><td class='menuSeparator'> </td><td onmouseout='leaveLayer(this); applyStyle(this.id, "normal");' onmouseover='deployLayer(this);' id='Cell1_6' class='normal'><table cellspacing='0' cellpadding='0' class='Menu1_roundTop'><tbody><tr><td class='top' style='background-color: #FFFFFF;'> </td></tr></tbody></table><table cellspacing='0' cellpadding='0' class='Menu1_content'><tbody><tr><td class='padding'> </td><td valign='top'><a target='_self' href='javascript: void(0)'>Links</a></td><td class='padding'> </td></tr></tbody></table></td><td class='menuSeparator'> </td></tr></tbody></table></div><iframe src='about:blank' frameborder='0' style='visibility:hidden;display:none;' id='iFrame' background='#EAEAEA'></iframe><span id='myBody'><p class='title'><a name='top'>Supervisor</a></p></span><br/><br/>" & vbCrLf _
706 & "<div id='gammeTabs' align='center' style='cursor: pointer; font-size: 14pt;'>" & vbCrLf _
707 & "<table><tr><td><span id='link_CPU' style='font-weight: bold; font-size: 100%; background-color: yellow;'>Ctrl_Projects</span></td> " & vbCrLf _
708 & "<td><span id='link_CPU' style='font-size: 100%; background-color: yellow;'><a href='\\wsfr30004\PROJECTS\CTRL_Projets\0_FW_Development_Process_Access\100_FwTools\1_Tool_TESTAUTO\12_HTML_Supervisor\(a) Dashboard Timeview HKa\(b) Dashboard ART HTML (Mai 2018)\dashboard.html'>TestAuto_TimeView</a></span</td> " & vbCrLf _
709 & "<td><span id='link_CPU' style='font-size: 100%; background-color: yellow;'><a href='\\wsfr30004\PROJECTS\CTRL_Projets\0_FW_Development_Process_Access\100_FwTools\1_Tool_TESTAUTO\12_HTML_Supervisor\(a) Dashboard Timeview HKa\(b) Dashboard ART HTML (Mai 2018)\index.html'>Home</a></span> </td>" & vbCrLf _
710 & "<td><span id='link_CPU' style='font-size: 100%; background-color: yellow;'><a href='\\wsfr30004\PROJECTS\CTRL_Projets\0_FW_Development_Process_Access\100_FwTools\1_Tool_TESTAUTO\12_HTML_Supervisor\(a) Dashboard Timeview HKa\(b) Dashboard ART HTML (Mai 2018)\dashboard_th.html'>Dashboard test auto</a></span></td></tr>" & vbCrLf _
711 & "<tr><td><span id='link_CPU' style='font-weight: bold; font-size: 100%; background-color: gray;'>Unity Integration</span></td> " & vbCrLf _
712 & "<td><span id='link_CPU' style='font-size: 100%; background-color: gray;'><a href=''>TestAuto-Timeview</a></span></td> " & vbCrLf _
713 & "<td><span id='link_CPU' style='font-size: 100%; background-color: gray;'><a href=''>Home</a></span></td> " & vbCrLf _
714 & "<td><span id='link_CPU' style='font-size: 100%; background-color: gray;'><a href=''>Dashboard test auto</a></span></td></tr>" & vbCrLf _
715 & "<tr><td><span id='link_CPU' style='font-weight: bold; font-size: 100%; background-color: gray;'>Web Server</span></td> " & vbCrLf _
716 & "<td><span id='link_CPU' style='font-size: 100%; background-color: gray;'><a href=''>TestAuto-Timeview</a></span></td> " & vbCrLf _
717 & "<td><span id='link_CPU' style='font-size: 100%; background-color: gray;'><a href=''>Home</a></span></td> " & vbCrLf _
718 & "<td><span id='link_CPU' style='font-size: 100%; background-color: gray;'><a href=''>Dashboard test auto</a></span></td></tr>" & vbCrLf _
719 & "<tr><td><span id='link_CPU' style='font-weight: bold; font-size: 100%; background-color: rgb(0,255,0);'>(W:) Local Dev</span></td> " & vbCrLf _
720 & "<td><span id='link_CPU' style='font-size: 100%; background-color: rgb(0,255,0);'><a href='W:\Disk\Dev_2018_Test-Auto\(h) Html Report (Thomas - Javascript) Mai 2018\(b) Dashboard ART HTML (Mai 2018)\dashboard.html'>TestAuto-Timeview</a></span></td> " & vbCrLf _
721 & "<td><span id='link_CPU' style='font-size: 100%; background-color: rgb(0,255,0);'><a href='W:\Disk\Dev_2018_Test-Auto\(h) Html Report (Thomas - Javascript) Mai 2018\(b) Dashboard ART HTML (Mai 2018)\index.html'>Home</a></span></td> " & vbCrLf _
722 & "<td><span id='link_CPU' style='font-size: 100%; background-color: rgb(0,255,0);'><a href='W:\Disk\Dev_2018_Test-Auto\(h) Html Report (Thomas - Javascript) Mai 2018\(b) Dashboard ART HTML (Mai 2018)\dashboard_th.html'>Dashboard test auto</a></span></td></tr>" & vbCrLf _
723 & "</table>" & vbCrLf & vbCrLf
724
725 '================ Graphique ============================
726 Html_Text = Html_Text + "<!-- ============ TITRE onglet ============ -->" & vbCrLf _
727 & "<title>Graphique de chargement d'applications Unity</title>" & vbCrLf _
728 & "<!-- ======= Container 1 : Titre 1 ========== -->" & vbCrLf _
729 & "<div layout='row' layout-align='start center'>" & vbCrLf _
730 & "<h1>Unity applications load timeline</h1></div>" & vbCrLf _
731 & "<!-- ============= Container 2 : Graphique ============ -->" & vbCrLf _
732 & "<canvas id='myCanvas' width='" & _Width & "' height='" & _Height & "' style='border:2px solid #d3d3d3;'>" & vbCrLf _
733 & "Your browser does not support the HTML5 canvas tag.</canvas>" & vbCrLf
734
735 '================ Insertion Planning Alternance ========
736 Html_Text = Html_Text + "<!-- ============ Planning Alternance ============ -->" & vbCrLf _
737 & "<br/><br/><h1>Planning Alternance 2018</h1>" & vbCrLf _
738 & "<img layout-align='center' alt='Planning Alternance 2018' src='planning.jpeg'></div>" _
739 & vbCrLf & vbCrLf
740
741 '#############################################################################################
742 '#############################################################################################
743 '=============================================================================================
744 '=============== PART 3 : Code en Javascript : Génération du graphique ===================
745 '=============================================================================================
746 '#############################################################################################
747 '#############################################################################################
748
749 Html_Text = Html_Text + "<!-- ======================================== -->" & vbCrLf _
750 & "<!-- ======================================== -->" & vbCrLf _
751 & "<!-- ===== PART 3 : Code en Javascript ======== -->" & vbCrLf _
752 & "<!-- ======================================== -->" & vbCrLf _
753 & "<!-- ======================================== -->" & vbCrLf _
754 & "<script>" & vbCrLf & vbCrLf
755
756
757 '=========== PART 3A : Récupération du container du graphique ===============
758 Html_Text = Html_Text + "// =======================================================" & vbCrLf _
759 & "// ======= PART 3A : Récupération du container du graphique ======== " & vbCrLf _
760 & "// =======================================================" & vbCrLf _
761 & "var c = document.getElementById('myCanvas');" & vbCrLf & vbCrLf
762
763
764 '=========== PART 3B : Initialisation des variables ===============
765 Html_Text = Html_Text + "// =======================================================" & vbCrLf _
766 & "// ======= PART 3B : Initialisation des variables ======== " & vbCrLf _
767 & "// =======================================================" & vbCrLf _
768 & "var ctx = c.getContext('2d');" & vbCrLf _
769 & "var width = " & _Width & ";" & vbCrLf _
770 & "var height = " & _Height & ";" & vbCrLf _
771 & "var w_offset = " & W_Offset & ";" & vbCrLf _
772 & "var h_offset = " & H_Offset & ";" & vbCrLf _
773 & "var arrow_len = h_offset / 5;" & vbCrLf _
774 & "var arrow_width = h_offset / 10;" & vbCrLf _
775 & "var tick_len = arrow_len / 2;" & vbCrLf & vbCrLf
776
777 '=========== PART 3C : INITIALISATION DU GRAPHIQUE ===============
778 Html_Text = Html_Text + "// =======================================================" & vbCrLf _
779 & "// ======= PART 3C : INITIALISATION DU GRAPHIQUE ======== " & vbCrLf _
780 & "// =======================================================" & vbCrLf _
781 & "ctx.strokeStyle = '#000000';" & vbCrLf _
782 & "ctx.beginPath();" & vbCrLf & vbCrLf
783
784
785 '=========== PART 3D : DESSINER L'AXE HORIZONTAL ===============
786 'Html_Text = Html_Text + "// =======================================================" & vbCrLf _
787 ' & "// ======= PART 3D : DESSINER L'AXE HORIZONTAL ======== " & vbCrLf _
788 ' & "// =======================================================" & vbCrLf
789
790 'Draw_Arrow("Javascript", W_Offset, _Height - H_Offset, CInt(_Width - 1.5 * W_Offset), 0, Html_Text)
791
792
793 '=========== Dessiner les ticks sur l'axe horizontal ===============
794 'Html_Text = Html_Text + "// =======================================================" & vbCrLf _
795 ' & "// ======= Dessiner les ticks sur l'axe horizontal ======== " & vbCrLf _
796 ' & "// =======================================================" & vbCrLf
797
798 'Dim Data_Count As Integer = 11
799 Dim X_Max As Integer = _Width - 2 * W_Offset
800 'Dim X_Step As Integer = CInt(X_Max / Data_Count)
801 'For cntTick As Integer = 0 To X_Max Step X_Step
802 ' Html_Text = Html_Text + "ctx.moveTo(" & W_Offset + cntTick & "," & _Height - H_Offset & ");" & vbCrLf _
803 ' & "ctx.lineTo(" & W_Offset + cntTick & ", " & _Height - H_Offset - Tick_len & ");" & vbCrLf _
804 ' & "ctx.lineTo(" & W_Offset + cntTick & ", " & _Height - H_Offset + Tick_len & ");" & vbCrLf & vbCrLf
805 'Next cntTick
806
807 '=========== Ajouter le label de l'axe des abscisses ===============
808 Html_Text = Html_Text + "// =======================================================" & vbCrLf _
809 & "// ======= Dessiner les ticks sur l'axe horizontal ======== " & vbCrLf _
810 & "// =======================================================" & vbCrLf _
811 & "ctx.font = '14px Times New Roman';" & vbCrLf _
812 & "ctx.fillStyle = 'Black';" & vbCrLf _
813 & "ctx.fillText('Date', width - 0.5 * w_offset, height - h_offset);" & vbCrLf & vbCrLf
814
815
816 ''=========== PART 3E : DESSINER L'AXE VERTICAL ===============
817 'Draw_Arrow("Javascript", W_Offset, _Height - H_Offset, CInt(_Height - 1.5 * H_Offset), Math.PI / 2, Html_Text)
818
819 ''=========== Dessiner les états sur l'axe vertical ===========
820 'Html_Text = Html_Text + "// === Dessiner les états sur l'axe vertical ==" & vbCrLf
821
822 ''------------- Get Names of Type_Etat elements
823 'Dim App_States() As String = Nothing
824
825 'If U_Memo_Check_Benchmark.U_Memo_Check_Mirror1.Checked = True Then
826 ' App_States = [Enum].GetNames(GetType(U_Db_Database_Log_Events.Type_Etat_Courbe_Html))
827 'Else
828 ' App_States = [Enum].GetNames(GetType(U_Db_Database_Log_Events.Type_Benchmark_Perf_Html))
829 'End If
830
831 'Dim Count_States As Integer = App_States.Length + 1
832 'Dim Pas As Integer = CInt(_Height / Count_States)
833 'Dim Hauteur_Max As Integer = _Height - 2 * H_Offset
834
835 'Dim State_Idx As Integer = 0
836
837 'Html_Text = Html_Text + "ctx.textAlign='end';" & vbCrLf
838 'Dim hauteur_courante As Integer = 0
839 'While hauteur_courante < Hauteur_Max And State_Idx < App_States.Length
840 ' Html_Text = Html_Text + "ctx.moveTo(" & W_Offset & ", " & _Height - H_Offset - hauteur_courante & ");" & vbCrLf _
841 ' & "ctx.lineTo(" & W_Offset - Tick_len & ", " & _Height - H_Offset - hauteur_courante & ");" & vbCrLf _
842 ' & "ctx.lineTo(" & W_Offset + Tick_len & ", " & _Height - H_Offset - hauteur_courante & ");" & vbCrLf _
843 ' & "ctx.fillText('" & App_States(State_Idx) & "', " & CInt(W_Offset * 0.9) & ", " & _Height - H_Offset - hauteur_courante & ");" _
844 ' & vbCrLf & vbCrLf
845
846 ' hauteur_courante = hauteur_courante + Pas
847 ' State_Idx = State_Idx + 1
848 'End While
849 'Html_Text = Html_Text + "ctx.textAlign='start';" & vbCrLf
850
851 '=========== RAFRAICHIR LE GRAPHIQUE ===============
852 Html_Text = Html_Text + "// =======================================================" & vbCrLf _
853 & "// ======= RAFRAICHIR LE GRAPHIQUE ======== " & vbCrLf _
854 & "// =======================================================" & vbCrLf _
855 & "ctx.stroke();" & vbCrLf & vbCrLf
856
857
858 '============ TEST DRAW CURVE ======================
859 '------------ Créer un tableau de données ----------------------------
860 Dim Struct_Test_Array As St_Collection_Curve_Data
861 Dim Struct_Test_Analog_Array As St_Collection_Curve_Data
862
863 Struct_Test_Array.Title = Nothing
864 Struct_Test_Array.Count = 10
865 ReDim Preserve Struct_Test_Array.Table_Data(10)
866
867 Struct_Test_Analog_Array.Title = "Angle (rad)"
868 Struct_Test_Analog_Array.Count = 100
869 ReDim Preserve Struct_Test_Analog_Array.Table_Data(100)
870
871 Dim test_array(10) As Type_Curve_Data
872 Dim test_analog(100) As Type_Curve_Data
873
874 Dim state_counter As Integer = 1
875 Dim state_counter_max As Integer = 0
876
877 If U_Memo_Check_Benchmark.U_Memo_Check_Mirror1.Checked = True Then
878 state_counter_max = 7
879 Else
880 state_counter_max = 3
881 End If
882
883
884 For test_array_idx As Integer = 0 To 10
885
886 test_array(test_array_idx).DateTime = Now
887 Struct_Test_Array.Table_Data(test_array_idx).DateTime = Now
888
889 test_array(test_array_idx).State = CType(state_counter, U_Db_Database_Log_Events.Type_Etat_Courbe_Html)
890 Struct_Test_Array.Table_Data(test_array_idx).State = CType(state_counter, U_Db_Database_Log_Events.Type_Etat_Courbe_Html)
891
892 state_counter = state_counter + 1
893
894 If (state_counter = state_counter_max) Then
895 state_counter = 1
896 End If
897 Next
898
899
900 For test_analog_idx As Integer = 0 To 100
901 test_analog(test_analog_idx).DateTime = Now
902 test_analog(test_analog_idx).Value = Math.Cos(test_analog_idx / 4) + 1
903
904 Struct_Test_Analog_Array.Table_Data(test_analog_idx).DateTime = Now
905 Struct_Test_Analog_Array.Table_Data(test_analog_idx).Value = Math.Cos(test_analog_idx / 4) + 1
906 Next
907
908
909 If U_Memo_Check_Success.U_Memo_Check_Mirror1.Checked = True Then
910 test_array(5).Label1 = "Fin du premier test : 3 ms"
911 test_array(5).Label2 = "Succès : Test OK "
912 test_array(5).Success = True
913
914 Struct_Test_Array.Table_Data(5).Label1 = "Fin du premier test : 3 ms"
915 Struct_Test_Array.Table_Data(5).Label2 = "Succès : Test OK "
916 Struct_Test_Array.Table_Data(5).Success = True
917 Else
918 test_array(5).Label1 = "Fin du premier test : 1 ms"
919 test_array(5).Label2 = "Echec : Test NOK"
920 test_array(5).Success = False
921
922 Struct_Test_Array.Table_Data(5).Label1 = "Fin du premier test : 1 ms"
923 Struct_Test_Array.Table_Data(5).Label2 = "Echec : Test NOK"
924 Struct_Test_Array.Table_Data(5).Success = False
925 End If
926
927
928 Dim Line_Color As String = "Blue"
929 If (U_Memo_Txt_Line_Color.Memo1_Text <> "Texte Mémorisé") Then
930 Line_Color = U_Memo_Txt_Line_Color.Memo1_Text
931 End If
932
933 Dim Line_Width As String = "3"
934 If (U_Memo_Txt_Line_Width.Memo1_Text <> "Texte Mémorisé") Then
935 Line_Width = U_Memo_Txt_Line_Width.Memo1_Text
936 End If
937
938 '------------ Mettre à jour le titre
939 Zone_Curve_Data.Title = "State"
940
941 '------------ Dessiner la courbe à partir du tableau -----------------
942 'Call Draw_Curve("Javascript", X_Max, test_array, Line_Color, Line_Width, _Height, Html_Text)
943 'Call Draw_3_Curves("Javascript", X_Max, _Height, Struct_Test_Array, Struct_Test_Analog_Array, Html_Text)
944 Call Draw_2_Curves("Javascript", X_Max, _Height, Struct_Test_Array, Struct_Test_Analog_Array, Html_Text)
945
946 '=========== RAFRAICHIR LE GRAPHIQUE ===============
947 Html_Text = Html_Text + "// =======================================================" & vbCrLf _
948 & "// ======= RAFRAICHIR LE GRAPHIQUE ======== " & vbCrLf _
949 & "// =======================================================" & vbCrLf _
950 & "ctx.stroke();" & vbCrLf & vbCrLf
951
952
953 '========== Arrêter la mesure de temps
954 'On calcul le nombre de millisecondes écoulé depuis le début, pour le calcul de la vitesse de test
955 millisecs = (CULng(System.DateTime.Now.Ticks) - startTime) / 10000
956 'stopwatch.Stop()
957 'Dim time As Long = stopwatch.ElapsedMilliseconds
958
959 '=======================================================
960 '========= PART 4 : Mise à jour date création ==========
961 '=======================================================
962 Html_Text = Html_Text + "// ==============================================" & vbCrLf _
963 & "// ==============================================" & vbCrLf _
964 & "</script>" & vbCrLf & vbCrLf _
965 & "<br/><div align='center'>File generated in " & millisecs & " milliseconds</div>" & vbCrLf & vbCrLf _
966 & "<!-- ======================================== -->" & vbCrLf _
967 & "<!-- ======================================== -->" & vbCrLf _
968 & "<!-- ===== PART 4 : Mise à jour date création ======== -->" & vbCrLf _
969 & "<!-- ======================================== -->" & vbCrLf _
970 & "<!-- ======================================== -->" & vbCrLf _
971 & "<br/><div align='center'> This page was generated [Visual Studio - TEST-AUTO] on " & Date.Now().ToString() & "</div></body></html>" _
972 & vbCrLf & vbCrLf
973
974
975
976 '=======================================================
977 '=======================================================
978 '============= GENERAITON DU FICHIER HTML ==============
979 '=======================================================
980 '=======================================================
981
982 '================ CHEMIN DU FICHIER A OUVRIR ===========
983 Dim File_Html As String = "W:\Disk\Dev_2018_Test-Auto\(h) Html Report (Thomas - Javascript) Mai 2018\(b) Dashboard ART HTML (Mai 2018)\dashboard.html"
984 If (Html_File_Name_Text.Memo1_Text <> "Texte Mémorisé") Then
985 File_Html = Html_File_Name_Text.Memo1_Text
986 End If
987
988 ' VALUE IS : "W:\Disk\Dev_2018_Test-Auto\(h) Html Report (Thomas - Javascript) Mai 2018\(b) Dashboard ART HTML (Mai 2018)\dashboard.html"
989 ' OR "N:\(Z1) Backup Disk_W (2017)\Disk\Dev_2018_Test-Auto\(h) Html Report (Thomas - Javascript) Mai 2018\(b) Dashboard ART HTML (Mai 2018)\dashboard.html"
990
991 '=============== OUVERTURE DU FICIHER ==================
992 File_write_html = My.Computer.FileSystem.OpenTextFileWriter(File_Html, False)
993
994 '=============== ECRITURE DU FICIHER ===================
995 File_write_html.WriteLine(Html_Text)
996
997 '=============== FERMETURE DU FICHIER ==================
998 File_write_html.Close()
999
1000 '=============== AFFICHAGE SUCCES ======================
1001 Html_Gen_Button.BackColor = Color.GreenYellow
1002
1003 Exit Sub '-------- Sortir de la méthode
1004
1005
1006 '--------------------------------------------------------------------
1007 '--------------------- TRAITEMENT D'ERREURS -------------------------
1008 '--------------------------------------------------------------------
1009Errhandler_Avec_Diagnostic:
1010 Html_Gen_Button.BackColor = Color.Red
1011 U_Msg_Local1.Affiche_Erreur_Global("Html Generation method ")
1012 Resume Next
1013 End Sub
1014
1015
1016
1017 '------------------------------------------------------------------------------------
1018 '----------------- FUNCTION ROLE : Draw three curves from data arrays -------------
1019 '------------------------------------------------------------------------------------
1020 Sub Draw_3_Curves(target As String, x_max As Integer, _Height As Integer, data As St_Collection_Curve_Data, data_analog As St_Collection_Curve_Data, Optional ByRef html_output As String = Nothing)
1021 Draw_Curve(target, True, CInt(_Height / 8), x_max, data_analog, False, "Blue", "2", CInt(_Height / 6), html_output)
1022 Draw_Curve(target, True, CInt(_Height / 3 + _Height / 10), x_max, Zone_Overall_Curve_Data, False, "Brown", "2", CInt(_Height / 6), html_output)
1023 Draw_Curve(target, False, CInt(2 * _Height / 3 + _Height / 12), x_max, Zone_Curve_Data, True, "Green", "2", CInt(_Height / 6), html_output)
1024 'Draw_Curve(target, CInt(9 * _Height / 20), x_max, data, "Green", "2", CInt(_Height / 2), html_output)
1025 End Sub
1026
1027
1028
1029 '------------------------------------------------------------------------------------
1030 '----------------- FUNCTION ROLE : Draw a curve from data array ---------------------
1031 '------------------------------------------------------------------------------------
1032 Sub Draw_2_Curves(target As String, x_max As Integer, _Height As Integer, data As St_Collection_Curve_Data, data_analog As St_Collection_Curve_Data, Optional ByRef html_output As String = Nothing)
1033 Draw_Curve(target, True, CInt(_Height / 8 + _Height / 20), x_max, Zone_Overall_Curve_Data, True, "Brown", "2", CInt(_Height / 4), html_output)
1034 Draw_Curve(target, False, CInt(_Height / 2 + _Height / 6), x_max, Zone_Curve_Data, True, "Blue", "2", CInt(_Height / 4), html_output)
1035 End Sub
1036
1037
1038 '------------------------------------------------------------------------------------
1039 '----------------- FUNCTION ROLE : Draw a curve from data array ---------------------
1040 '------------------------------------------------------------------------------------
1041 Sub Draw_Curve(target As String, analog As Boolean, y_start As Integer, x_max As Integer, data As St_Collection_Curve_Data, flag_show_x_label As Boolean, Line_Color As String, Line_Width As String, _Height As Integer, Optional ByRef Html_Output As String = Nothing)
1042
1043 test_label.Text = ""
1044
1045 Dim App_States() As String = Nothing
1046
1047 If U_Memo_Check_Benchmark.U_Memo_Check_Mirror1.Checked = True Then
1048 App_States = [Enum].GetNames(GetType(U_Db_Database_Log_Events.Type_Etat_Courbe_Html))
1049 Else
1050 App_States = [Enum].GetNames(GetType(U_Db_Database_Log_Events.Type_Benchmark_Perf_Html))
1051 End If
1052
1053 'Dim _Height As Integer = 500
1054 'If ((U_Memo_Txt_Height.Memo1_Text).Length < 4) Then
1055 ' _Height = CInt(U_Memo_Txt_Height.Memo1_Text)
1056 'End If
1057
1058 Dim _Width As Integer = 900
1059 If ((U_Memo_Txt_Width.Memo1_Text).Length < 4) Then
1060 _Width = CInt(U_Memo_Txt_Width.Memo1_Text)
1061 End If
1062
1063 Dim W_Offset As Integer = CInt(_Width / 10)
1064 Dim H_Offset As Integer = CInt(_Height / 10)
1065 Dim states_cnt As Integer = App_States.Length
1066
1067 Dim x As Integer = 0
1068
1069 Dim x_step As Integer
1070 x_step = CInt(x_max / data.Table_Data.Length)
1071
1072 Dim y_step As Integer = CInt(_Height / states_cnt)
1073
1074 Dim y_analog_max As Double
1075 Dim y_step_analog As Double
1076 If analog = True Then
1077 y_analog_max = Get_Max_Int_In_Array(data.Table_Data)
1078 If y_analog_max = 0 Then
1079 y_step_analog = 0
1080 Else
1081 y_step_analog = _Height / y_analog_max
1082 End If
1083 End If
1084 Dim y_start_abs As Integer = y_start + _Height - H_Offset
1085
1086 '=========== STEP 0 : PARAMETRER LA COURBE ========
1087 Html_Output = Html_Output + "// ==============================================" & vbCrLf _
1088 & "// ======== DESSINER UNE COURBE ===============" & vbCrLf _
1089 & "// ==============================================" & vbCrLf _
1090 & "ctx.strokeStyle = '" & Line_Color & "';" & vbCrLf _
1091 & "ctx.lineWidth = " & Line_Width & ";" & vbCrLf & vbCrLf _
1092 & "ctx.beginPath()" & vbCrLf _
1093 & "ctx.moveTo(" & W_Offset & ", " & _Height - H_Offset + y_start & ");" & vbCrLf
1094
1095 '-------- STEP 1 : Parcourir tous les points de la courbe -----------------------
1096 For Each element In data.Table_Data
1097 Dim y As String
1098
1099 If analog = True Then
1100 y = Str(_Height - H_Offset - element.Value * y_step_analog + y_start)
1101 Else
1102 test_label.Text = test_label.Text & "dateTime = " & element.DateTime.ToString("HH:mm") & vbCrLf
1103 test_label.Text = test_label.Text & "state = " & App_States(element.State - 1) & vbCrLf
1104
1105 y = Str(_Height - H_Offset - (element.State - 1) * y_step + y_start)
1106 End If
1107
1108 Dim label_color As String = "Red"
1109
1110 If (element.Success = True) Then
1111 label_color = "Green"
1112 End If
1113
1114
1115 If analog = True Then
1116 Html_Output = Html_Output + "ctx.lineTo(" & Str(W_Offset + x * x_step) & ", " & y & ");" & vbCrLf _
1117 & "ctx.stroke();" & vbCrLf & vbCrLf
1118 Else
1119 Html_Output = Html_Output + "ctx.lineTo(" & Str(W_Offset + (x * x_step)) & ", " & y & ");" & vbCrLf _
1120 & "ctx.lineTo(" & Str(W_Offset + ((x + 1) * x_step)) & ", " & y & ");" & vbCrLf _
1121 & "ctx.stroke();" & vbCrLf & vbCrLf
1122 End If
1123
1124 If ((element.Label1 IsNot Nothing) And (element.Label1 <> "")) Then
1125
1126 If analog = False Then
1127 Draw_Label(target, CSng(Str(W_Offset + (x * x_step))), CSng(y), 30, Math.PI / 3, element.Label1, element.Label2, label_color, Html_Output)
1128 '=========== STEP 2 : REPARAMETRER LA COURBE ========
1129 Html_Output = Html_Output + "ctx.strokeStyle = '" & Line_Color & "';" & vbCrLf _
1130 & "ctx.lineWidth = " & Line_Width & ";" & vbCrLf & vbCrLf _
1131 & "ctx.beginPath()" & vbCrLf
1132 Html_Output = Html_Output & "ctx.moveTo(" & Str(W_Offset + ((x + 1) * x_step)) & ", " & y & ");" & vbCrLf & vbCrLf
1133 Else
1134 Dim label_xstart As Single = Single.Parse(Str(W_Offset + (x * x_step)), System.Globalization.CultureInfo.CreateSpecificCulture("en-us"))
1135 Dim label_ystart As Single = Single.Parse(y, System.Globalization.CultureInfo.CreateSpecificCulture("en-us"))
1136 Draw_Label(target, label_xstart, label_ystart, 30, Math.PI / 3, element.Label1, element.Label2, label_color, Html_Output)
1137
1138 '=========== STEP 2 : REPARAMETRER LA COURBE ========
1139 Html_Output = Html_Output + "ctx.strokeStyle = '" & Line_Color & "';" & vbCrLf _
1140 & "ctx.lineWidth = " & Line_Width & ";" & vbCrLf & vbCrLf _
1141 & "ctx.beginPath()" & vbCrLf
1142
1143 Html_Output = Html_Output & "ctx.moveTo(" & Str(W_Offset + (x * x_step)) & ", " & y & ");" & vbCrLf & vbCrLf
1144 End If
1145
1146 End If
1147
1148
1149 Dim timestamp_x As String = Nothing
1150
1151 If analog = True Then
1152 timestamp_x = Str(W_Offset + x * x_step)
1153 Else
1154 timestamp_x = Str(W_Offset + (x + 1) * x_step)
1155 End If
1156
1157 If (flag_show_x_label = True) Then
1158 If element.DateTime <> Nothing Then
1159 If analog = True Then
1160 If ((element.Label1 <> Nothing) And (element.Label1 <> "")) Then
1161 '------------ Ecrire les dates correspondant à chaque point ----------
1162 Html_Output = Html_Output + "ctx.font = '9px Arial'; ctx.textAlign='center'; ctx.fillStyle = 'blue';" & vbCrLf _
1163 & "ctx.fillText('" & element.DateTime.ToString("HH:mm") & "', " & Str(W_Offset + (x * x_step)) & ", " & Str(_Height + H_Offset + y_start) & ");" & vbCrLf _
1164 & "ctx.stroke(); ctx.strokeStyle = 'blue'" & vbCrLf _
1165 & "ctx.moveTo(" & timestamp_x & "," & y_start_abs & ");" & vbCrLf _
1166 & "ctx.lineTo(" & timestamp_x & ", " & y_start_abs - 5 & ");" & vbCrLf _
1167 & "ctx.lineTo(" & timestamp_x & ", " & y_start_abs + 5 & ");" & vbCrLf _
1168 & "ctx.stroke(); ctx.strokeStyle = '" & Line_Color & "' " & vbCrLf & vbCrLf
1169
1170
1171 If analog = True Then
1172 Html_Output = Html_Output & "ctx.moveTo(" & Str(W_Offset + (x * x_step)) & ", " & y & ");" & vbCrLf & vbCrLf
1173 Else
1174 Html_Output = Html_Output & "ctx.moveTo(" & Str(W_Offset + ((x + 1) * x_step)) & ", " & y & ");" & vbCrLf & vbCrLf
1175 End If
1176
1177 Html_Output = Html_Output & "ctx.stroke()" & vbCrLf & vbCrLf
1178
1179 End If
1180 Else
1181 '------------ Ecrire les dates correspondant à chaque point ----------
1182 Html_Output = Html_Output + "ctx.font = '9px Arial'; ctx.textAlign='center'; ctx.fillStyle = 'black';" & vbCrLf _
1183 & "ctx.fillText('" & element.DateTime.ToString("HH:mm") & "', " & Str(W_Offset + (x * x_step)) & ", " & Str(_Height + H_Offset + y_start) & ");" & vbCrLf
1184 End If
1185 End If
1186 End If
1187
1188 x = x + 1
1189 Next
1190
1191 '=========== STEP 3A : DESSINER L'AXE HORIZONTAL ===============
1192 Html_Output = Html_Output + "// =======================================================" & vbCrLf _
1193 & "// ======= PART 3D : DESSINER L'AXE HORIZONTAL ======== " & vbCrLf _
1194 & "// =======================================================" & vbCrLf
1195
1196 '=========== STEP 3B : REPARAMETRER LA COURBE ========
1197 Html_Output = Html_Output + "ctx.strokeStyle = 'black';" & vbCrLf _
1198 & "ctx.lineWidth = 1;" & vbCrLf & vbCrLf _
1199 & "ctx.beginPath();" & vbCrLf
1200
1201
1202 Draw_Arrow("Javascript", W_Offset, y_start_abs, CInt(_Width - 1.5 * W_Offset), 0, Html_Output)
1203
1204
1205 If flag_show_x_label = True Then
1206 '=========== Dessiner les ticks sur l'axe horizontal ===============
1207 Html_Output = Html_Output + "// =======================================================" & vbCrLf _
1208 & "// ======= Dessiner les ticks sur l'axe horizontal ======== " & vbCrLf _
1209 & "// =======================================================" & vbCrLf
1210
1211 '---------- Eviter de surcharger le graphique
1212 Dim dataLen As Integer = data.Table_Data.Length
1213 Dim x_tick_step As Integer = x_step
1214
1215 If dataLen >= 99 Then
1216 If dataLen >= 999 Then
1217 If dataLen >= 9999 Then
1218 x_tick_step = x_step * 1000
1219 Else
1220 x_tick_step = x_step * 100
1221 End If
1222 Else
1223 x_tick_step = x_step * 10
1224 End If
1225 End If
1226
1227 For cntTick As Integer = 0 To x_max Step x_tick_step
1228 Html_Output = Html_Output + "ctx.moveTo(" & W_Offset + cntTick & "," & y_start_abs & ");" & vbCrLf _
1229 & "ctx.lineTo(" & W_Offset + cntTick & ", " & y_start_abs - 5 & ");" & vbCrLf _
1230 & "ctx.lineTo(" & W_Offset + cntTick & ", " & y_start_abs + 5 & ");" & vbCrLf & vbCrLf
1231 Next cntTick
1232
1233 End If
1234
1235 '=========== STEP 3B : REPARAMETRER LA COURBE ========
1236 Html_Output = Html_Output + "ctx.stroke(); ctx.strokeStyle = 'black'; ctx.fillStyle = 'black';" & vbCrLf _
1237 & "ctx.lineWidth = 1;" & vbCrLf & vbCrLf _
1238 & "ctx.beginPath();" & vbCrLf
1239
1240 '=========== STEP 3C : DESSINER L'AXE VERTICAL ===============
1241 Draw_Arrow("Javascript", W_Offset, CSng(y_start + _Height - H_Offset), _Height + H_Offset, Math.PI / 2, Html_Output)
1242
1243 '=========== Dessiner les états sur l'axe vertical ===========
1244 Html_Output = Html_Output + "// === Dessiner les états sur l'axe vertical ==" & vbCrLf
1245 Html_Output = Html_Output + "ctx.stroke();" & vbCrLf & vbCrLf
1246
1247 Dim Nb_Of_Ticks As Integer = 5
1248 Dim Count_States As Integer = App_States.Length + 1
1249 Dim Hauteur_Max As Integer
1250 Dim Pas As Integer
1251
1252 If analog = True Then
1253 Pas = CInt(_Height / Nb_Of_Ticks)
1254 Hauteur_Max = _Height + H_Offset
1255 Else
1256 Pas = CInt(_Height / (Count_States - 1))
1257 Hauteur_Max = _Height - H_Offset
1258 End If
1259
1260
1261
1262 Dim Y_Idx As Integer = 0
1263
1264 Html_Output = Html_Output + "ctx.textAlign='end';" & vbCrLf
1265 Dim Hauteur_Courante As Integer = 0
1266 Dim Y_Hauteur As Integer = 0
1267 Dim Y_Idx_Max As Integer
1268
1269 If (analog = True) Then
1270 Y_Idx_Max = Nb_Of_Ticks
1271 Else
1272 Y_Idx_Max = App_States.Length
1273 End If
1274
1275
1276 While Hauteur_Courante < Hauteur_Max
1277 Y_Hauteur = _Height - H_Offset - Hauteur_Courante + y_start
1278
1279 Html_Output = Html_Output + "ctx.moveTo(" & W_Offset & ", " & Y_Hauteur & ");" & vbCrLf _
1280 & "ctx.lineTo(" & W_Offset - 5 & ", " & Y_Hauteur & ");" & vbCrLf _
1281 & "ctx.lineTo(" & W_Offset + 5 & ", " & Y_Hauteur & ");" & vbCrLf
1282
1283 Html_Output = Html_Output + "ctx.font = '11px Arial';"
1284 If analog = True Then
1285 Html_Output = Html_Output + "ctx.fillText('" & Str(Y_Idx * y_analog_max / Y_Idx_Max) & "', " & CInt(W_Offset * 0.9) & ", " & Y_Hauteur & ");" _
1286 & vbCrLf & vbCrLf
1287 Else
1288 Html_Output = Html_Output + "ctx.fillText('" & App_States(Y_Idx) & "', " & CInt(W_Offset * 0.9) & ", " & Y_Hauteur & ");" _
1289 & vbCrLf & vbCrLf
1290 End If
1291
1292
1293 Hauteur_Courante = Hauteur_Courante + Pas
1294 Y_Idx = Y_Idx + 1
1295 End While
1296 Html_Output = Html_Output + "ctx.textAlign='end';" & vbCrLf
1297
1298 Html_Output = Html_Output + "ctx.font = '14px Arial';" _
1299 & "ctx.fillText('" & data.Title & "', " & CInt(W_Offset * 0.9) & ", " & CInt(y_start - 3 * H_Offset) & ");" _
1300 & vbCrLf & vbCrLf
1301
1302 Html_Output = Html_Output + "ctx.stroke();" & vbCrLf & vbCrLf
1303 End Sub
1304
1305
1306
1307 '------------------------------------------------------------------------------------
1308 '----------------- FUNCTION ROLE : Draw a line from a specified ---------------------
1309 '----------------- start point to another end point ---------------------
1310 '------------------------------------------------------------------------------------
1311 '----------------- target = "Javascript" (only option defined for now) --------
1312 '----------------- html_output for javascript = -----------------
1313 '----------------- text to be inserted into HTML file -----------------
1314 '------------------------------------------------------------------------------------
1315 Sub Draw_Label(target As String, x_start As Single, y_start As Single, arrow_length As Single, arrow_angle As Single, text As String, text2 As String, text_color As String, Optional ByRef html_output As String = Nothing, Optional line_width As String = "2")
1316 Dim x_end As String = Nothing
1317 Dim y_end As String = Nothing
1318
1319 '--------------- STEP 0 : INIT LINE STYLE
1320 html_output = html_output + "// =======================================================" & vbCrLf _
1321 & "// ======= AJOUTER UN LABEL ======== " & vbCrLf _
1322 & "// =======================================================" & vbCrLf _
1323 & "ctx.strokeStyle = '" & text_color & "'; ctx.lineWidth = " & line_width & "; ctx.beginPath(); ctx.textAlign='start';" & vbCrLf
1324
1325 '--------------- STEP 1a : DRAW ARROW HEAD
1326 Draw_Line_W_Angle(target, x_start, y_start, 10, arrow_angle - CSng(Math.PI) / 6, html_output)
1327 Draw_Line_W_Angle(target, x_start, y_start, 10, arrow_angle + CSng(Math.PI) / 6, html_output)
1328
1329
1330 '--------------- STEP 1b : DRAW LINE FROM START POINT with specified ARROW LENGTH
1331 Draw_Line_W_Angle(target, x_start, y_start, arrow_length, arrow_angle, html_output, x_end, y_end)
1332
1333
1334 '--------------- STEP 2 : ADD LABEL TEXT
1335
1336 If ((text2 IsNot Nothing) And (text2 <> "")) Then
1337
1338 '---------- CAS OU IL Y A 2 LABELS
1339 Dim label_height As Single = 40
1340 Dim label_width As Single = Math.Max(text.Length, text2.Length) * 7
1341 Dim label_text_offset_y As Single = 16
1342 Dim label_text_offset_x As Single = 5
1343 y_end = CSng(CDbl(y_end.Replace(".", ",")) - label_height).ToString().Replace(",", ".")
1344 Dim x_text As String = CSng(CDbl(x_end.Replace(".", ",")) + label_text_offset_x).ToString().Replace(",", ".")
1345 Dim y_text As String = CSng(CDbl(y_end.Replace(".", ",")) + label_text_offset_y).ToString().Replace(",", ".")
1346 Dim y_text_2 As String = CSng(CDbl(y_end.Replace(".", ",")) + label_text_offset_y + label_height / 2).ToString().Replace(",", ".")
1347
1348 html_output = html_output + "ctx.moveTo(" & x_end & ", " & y_end & ");" & vbCrLf _
1349 & "ctx.rect(" & x_end & ", " & y_end & ", " & label_width & ", " & label_height & ");" & vbCrLf _
1350 & "ctx.stroke(); ctx.beginPath(); ctx.font = '12px Arial'; ctx.fillStyle = '" & text_color & "';" & vbCrLf _
1351 & "ctx.fillText('" & text & "', " & x_text & ", " & y_text & ");" & vbCrLf _
1352 & "ctx.fillText('" & text2 & "', " & x_text & ", " & y_text_2 & ");" & vbCrLf
1353
1354
1355 html_output = html_output + "ctx.stroke();" & vbCrLf & vbCrLf
1356
1357 Else
1358
1359 '---------- CAS OU IL Y A UN SEUL LABEL
1360 Dim label_height As Single = 20
1361 Dim label_width As Single = text.Length * 7
1362 Dim label_text_offset_y As Single = 16
1363 Dim label_text_offset_x As Single = 5
1364 y_end = CSng(CDbl(y_end.Replace(".", ",")) - label_height).ToString().Replace(",", ".")
1365 Dim x_text As String = CSng(CDbl(x_end.Replace(".", ",")) + label_text_offset_x).ToString().Replace(",", ".")
1366 Dim y_text As String = CSng(CDbl(y_end.Replace(".", ",")) + label_text_offset_y).ToString().Replace(",", ".")
1367
1368 html_output = html_output + "ctx.moveTo(" & x_end & ", " & y_end & ");" & vbCrLf _
1369 & "ctx.rect(" & x_end & ", " & y_end & ", " & label_width & ", " & label_height & ");" & vbCrLf _
1370 & "ctx.stroke(); ctx.beginPath(); ctx.font = '12px Arial'; ctx.fillStyle = '" & text_color & "';" & vbCrLf _
1371 & "ctx.fillText('" & text & "', " & x_text & ", " & y_text & ");" & vbCrLf _
1372 & "ctx.stroke()" & vbCrLf & vbCrLf
1373 End If
1374
1375 End Sub
1376
1377
1378
1379
1380
1381
1382 '------------------------------------------------------------------------------------
1383 '----------------- FUNCTION ROLE : Draw an arrow from a specified -------------------
1384 '----------------- start point, specifying a length and angle -----------------
1385 '------------------------------------------------------------------------------------
1386 '----------------- target = "Javascript" (only option for now) ----------------
1387 '----------------- html_output for javascript = -----------------
1388 '----------------- text to be inserted into HTML file -----------------
1389 '------------------------------------------------------------------------------------
1390 Sub Draw_Arrow(target As String, x_start As Single, y_start As Single, arrow_length As Single, arrow_angle As Single, Optional ByRef html_output As String = Nothing)
1391 Dim x_end As String = Nothing
1392 Dim y_end As String = Nothing
1393
1394
1395 '--------------- STEP 1 : DRAW LINE FROM START POINT with specified ARROW LENGTH
1396 Draw_Line_W_Angle(target, x_start, y_start, arrow_length, arrow_angle, html_output, x_end, y_end)
1397
1398
1399 '--------------- DRAW ARROW HEAD
1400 x_end = x_end.Replace(".", ",")
1401 y_end = y_end.Replace(".", ",")
1402 Draw_Line_W_Angle(target, CSng(x_end), CSng(y_end), 10, arrow_angle - 5 * CSng(Math.PI) / 6, html_output)
1403 Draw_Line_W_Angle(target, CSng(x_end), CSng(y_end), 10, arrow_angle + 5 * CSng(Math.PI) / 6, html_output)
1404
1405 End Sub
1406
1407
1408
1409
1410
1411
1412 '------------------------------------------------------------------------------------
1413 '----------------- FUNCTION ROLE : Draw a line from a specified ---------------------
1414 '----------------- start point, a given length L and angle Alpha -------------
1415 '----------------- and returns end point coordinates -------------
1416 '------------------------------------------------------------------------------------
1417 '----------------- target = "Javascript" (only option for now) ----------------
1418 '----------------- html_output for javascript = -----------------
1419 '----------------- text to be inserted into HTML file -----------------
1420 '------------------------------------------------------------------------------------
1421 Sub Draw_Line_W_Angle(target As String, x_start As Single, y_start As Single, L As Single, alpha As Single, Optional ByRef html_output As String = Nothing, Optional ByRef x_end As String = Nothing, Optional ByRef y_end As String = Nothing)
1422
1423 '--------------- Find end point
1424 x_end = CSng(x_start + L * Math.Cos(alpha)).ToString().Replace(",", ".")
1425 y_end = CSng(y_start - L * Math.Sin(alpha)).ToString().Replace(",", ".")
1426
1427 '--------------- Draw Line using basic DrawLine function
1428 Dim x_start_formatted As String = x_start.ToString().Replace(",", ".")
1429 Dim y_start_formatted As String = y_start.ToString().Replace(",", ".")
1430 Draw_Line(target, x_start_formatted, y_start_formatted, x_end, y_end, html_output)
1431
1432 End Sub
1433
1434
1435
1436
1437
1438
1439 '------------------------------------------------------------------------------------
1440 '----------------- FUNCTION ROLE : Draw a line from a specified ---------------------
1441 '----------------- start point to another end point ---------------------
1442 '------------------------------------------------------------------------------------
1443 '----------------- target = "Javascript" (only option for now) ----------------
1444 '----------------- html_output for javascript = -----------------
1445 '----------------- text to be inserted into HTML file -----------------
1446 '------------------------------------------------------------------------------------
1447 Sub Draw_Line(target As String, x_start As String, y_start As String, x_end As String, y_end As String, Optional ByRef html_output As String = Nothing)
1448 '--------------- DRAW LINE IN JAVASCRIPT
1449 If (target = "Javascript") Then
1450 html_output = html_output + "ctx.moveTo(" & x_start & ", " & y_start & ");" & vbCrLf _
1451 & "ctx.lineTo(" & x_end & ", " & y_end & ");" _
1452 & vbCrLf & vbCrLf
1453 End If
1454 End Sub
1455
1456
1457
1458
1459
1460 Private Sub Read_Database_Button_Click(sender As Object, e As EventArgs) Handles Read_Database_Button.Click
1461 'Gestion des erreurs
1462 On Error GoTo Errhandler_Avec_Diagnostic
1463
1464 Read_Database_Logs_Events_Unity(0)
1465
1466 Exit Sub
1467 '-------------------------------------------------------------------------------
1468 '------------ Traitement des erreurs ----------
1469 '-------------------------------------------------------------------------------
1470Errhandler_Avec_Diagnostic:
1471 Call U_Msg_Local1.Affiche_Erreur("Error During Read Database TESTAUTO")
1472 Resume Next
1473 '------------ Fin traitement des erreurs -------------
1474 End Sub
1475
1476
1477
1478 Public Sub Read_Database_Logs_Events_Unity(Loop_Counter_Unity As Long)
1479 'Gestion des erreurs
1480 On Error GoTo Errhandler_Avec_Diagnostic
1481
1482 '---------------------------------------------------------------------------
1483 '--- Init database and get instance from U_Node_Search_Object_By_Name ---
1484 '--- then Read logs database to get the data for HTML generation ---
1485 '--- ---
1486 '--- Note1: This object is in "Parent" collection ---
1487 '--- => Take care: the tree of objects is: ---
1488 '--- [Parent level3] U_Script_OPC ---
1489 '--- [Parent level2] ... TabControl ---
1490 '--- [Parent level1] ... ... TabPage ---
1491 '--- => Reference is: Me.Parent.Parent.Parent ---
1492 '---------------------------------------------------------------------------
1493
1494 '----------- Test if object Database_Log_Event is nothing ---------------------
1495 If (U_Db_Database_Log_Events_Local Is Nothing) Then
1496
1497 Dim Object_Name_To_Search As String
1498 Object_Name_To_Search = "U_Db_Database_Log_Events_Unity"
1499
1500 Dim Object_Type_To_Search As String
1501 Object_Type_To_Search = "U_Db_Database_Log_Events"
1502
1503 Dim Reference_Found_By_Search As Object = Nothing
1504
1505 Call U_Node_Search_Object_By_Name1.Search_Object_By_Name_And_Type(Object_Name_To_Search, Object_Type_To_Search, Reference_Found_By_Search)
1506
1507 '------------ CAS où l'objet n'a pas été trouvé -------------------------
1508 If Reference_Found_By_Search Is Nothing Then
1509 U_Msg_Local1.Aff_Coul_RGB(U_Msg_Local.Type_Warning.Aff_Error1, Color.Red, "Database Logs_Events_Unity was not found")
1510 Read_Database_Button.BackColor = Color.Red
1511 Exit Sub
1512 End If
1513
1514 If Reference_Found_By_Search IsNot Nothing Then
1515 U_Db_Database_Log_Events_Local = TryCast(Reference_Found_By_Search, U_Db_Database_Log_Events)
1516
1517 '*************************************************************************************
1518 '*** Object Log database found: Use this object to create html *********
1519 '*************************************************************************************
1520 Read_Database_Button.BackColor = Color.Magenta
1521 Read_Database_Button.Text = Read_Database_Button.Text & " : DB exists"
1522 End If
1523
1524
1525 Else
1526 Call U_Msg_Local1.Aff_Coul_RGB(U_Msg_Local.Type_Warning.Aff_INFO_GRAS, Color.SteelBlue, "U_Db_Database_Log_Events_Unity existe ")
1527 End If
1528
1529
1530 If (U_Db_Database_Log_Events_Local IsNot Nothing) Then
1531 '*************************************************************************************
1532 '*** Partie 1_B : Read data from Log_Events database [PCh + Hka, 30 Mai 2018] ***
1533 '*************************************************************************************
1534 Dim U_Db_Database_Log_Events_Name As String
1535 U_Db_Database_Log_Events_Name = U_Db_Database_Log_Events_Local.Name
1536
1537
1538 '*****************************************************************************
1539 '*** Search data in database *******
1540 '*** *******
1541 '*** Note: Request = search all Field_Name1, Field_Name2... *******
1542 '*** WHERE Loc_Ident_Record = Value (Long integer) *******
1543 '*****************************************************************************
1544 '--- Table name to search --------------
1545 Dim Requete_SQL1 As String
1546 Dim Snp_Request_Search1 As dao.Recordset
1547 Dim Loc_Base_Access As dao.Database
1548 Dim U_Db_Database_Loc As U_Db_Database
1549 U_Db_Database_Loc = U_Db_Database_Log_Events_Local.U_Db_Database_AutoOpen1.U_Db_Database1
1550
1551 If (U_Db_Database_Loc.Info_Base_Acces.Flag_Base_Ouverte = False) Then
1552 U_Db_Database_Loc.U_Db_Database_OpenDB()
1553 End If
1554
1555
1556 If (U_Db_Database_Loc.Info_U_Database.Base_Access Is Nothing) Then
1557 '==== La base n'est pas créée ou pas ouverte: on sort ======================================================
1558 Read_Database_Button.BackColor = Color.Red
1559 Read_Database_Button.Text = "Base pas ouverte - Exit"
1560 Call U_Msg_Local1.Aff_Coul_RGB(U_Msg_Local.Type_Warning.Aff_INFO, Color.DarkRed, " Database Access not open, object is nothing ")
1561 Exit Sub
1562 Else
1563 Read_Database_Button.BackColor = Color.Green
1564 Read_Database_Button.Text = "Base ouverte "
1565 Loc_Base_Access = U_Db_Database_Loc.Info_U_Database.Base_Access
1566 End If '=== If (U_Db_Database_Loc.Info_U_Database.Base_Access Is Nothing =====================
1567
1568
1569 '-------------------------------------------------------------------------------------------------
1570 '---- Show size of table (number of lines) ----
1571 '-------------------------------------------------------------------------------------------------
1572 '-------------------------------------------------------------------------------
1573 '------ Calcul du nombre d'enregistrements dans la table ------
1574 '-------------------------------------------------------------------------------
1575 Dim Name_Of_Table_To_Search As String
1576 Dim Nombre_Blocs_Standard1 As Long
1577 Dim Name_Of_Field_To_Search As String
1578 Dim Field_Value_To_Search As String
1579 Name_Of_Table_To_Search = "Table_Evenement"
1580 Name_Of_Field_To_Search = "Test_Name"
1581 Field_Value_To_Search = "Unity_Load_Loop_Toufik_" & Trim(CStr(Loop_Counter_Unity))
1582
1583
1584 'Dim Requete_SQL_1 As String
1585 'Dim Snp_Requete1 As dao.Recordset
1586 'Requete_SQL_1 = "SELECT count(*) FROM " & Name_Of_Table_To_Search '-- C'est Type_Bloc.Bloc_Standard
1587 'Snp_Requete1 = Loc_Base_Access.OpenRecordset(Requete_SQL_1, dao.RecordsetTypeEnum.dbOpenSnapshot)
1588 'Dim Counter_Lines_Max As Integer
1589 'Counter_Lines_Max = CInt(Snp_Requete1(0).Value)
1590 ''Counter_Activity_Max = Info_Base_Acces.Rs(Table_Activités).RecordCount
1591 ''Info_Base_Acces.Rs(Table_Activités).MoveFirst()
1592 'U_Memo_Txt_Count_Record.Memo1_Text = "Lines Max= " & Str(Counter_Lines_Max)
1593
1594
1595
1596 Dim Requete_SQL_1 As String
1597 Dim Snp_Requete1 As dao.Recordset
1598 Requete_SQL_1 = "SELECT count(*) FROM " & Name_Of_Table_To_Search & " WHERE " & Name_Of_Field_To_Search & " LIKE '" & Field_Value_To_Search & "'"
1599 Snp_Requete1 = Loc_Base_Access.OpenRecordset(Requete_SQL_1, dao.RecordsetTypeEnum.dbOpenSnapshot)
1600 Dim Counter_Lines_Max As Integer
1601 Counter_Lines_Max = CInt(Snp_Requete1(0).Value)
1602 U_Memo_Txt_Count_Record.Memo1_Text = "Lines Max= " & Str(Counter_Lines_Max)
1603 U_Msg_Local1.Aff_Coul_RGB(U_Msg_Local.Type_Warning.Aff_INFO, Color.ForestGreen, "Reading " & Counter_Lines_Max & " lines from database")
1604
1605
1606 Dim Requete_SQL_2 As String
1607 Dim Snp_Requete2 As dao.Recordset
1608 Requete_SQL_2 = "SELECT * FROM " & Name_Of_Table_To_Search & " WHERE " & Name_Of_Field_To_Search & " LIKE '" & Field_Value_To_Search & "'"
1609 Snp_Requete2 = Loc_Base_Access.OpenRecordset(Requete_SQL_2, dao.RecordsetTypeEnum.dbOpenSnapshot)
1610
1611
1612 Dim Flag_Table_Empty As Boolean
1613 Flag_Table_Empty = False
1614 '--------------- Vérifier que la table n'est pas vide -----------------------------
1615 If ((Snp_Requete2.BOF = True) And (Snp_Requete2.EOF = True)) Then
1616 Flag_Table_Empty = True
1617 End If
1618
1619
1620 '--------------- Parcourir la table résultant de la requête -----------------------
1621 If Flag_Table_Empty = False Then
1622
1623 Snp_Requete2.MoveFirst()
1624
1625 For Counter_Data As Integer = 1 To Counter_Lines_Max
1626 Dim Index_Courant As Integer
1627 Index_Courant = Counter_Data - 1
1628
1629 If (Snp_Requete2.Fields(Name_Of_Field_To_Search).Value.ToString <> "") Then
1630 Dim Field_Value As String
1631 Field_Value = Snp_Requete2.Fields(Name_Of_Field_To_Search).Value.ToString
1632
1633 If Field_Value = Field_Value_To_Search Then
1634 '---------- Redimensionner le tableau de points de la courbe --------------
1635 ReDim Preserve Zone_Curve_Data.Table_Data(Index_Courant)
1636
1637 '---------- Récupérer l'état correspondant au point courant de la courbe --
1638 Dim State_As_String As String
1639 State_As_String = CType(Snp_Requete2.Fields("Commande_Name").Value, String)
1640 State_As_String = Trim(State_As_String)
1641
1642 Dim State_As_Characters() As Char
1643 State_As_Characters = CType(State_As_String, Char())
1644
1645 Dim State_As_Int As Integer
1646 State_As_Int = Integer.Parse(State_As_Characters(0))
1647
1648
1649 '----------- Récupérer les labels ------------------------------------------
1650 Dim Label_As_String As String
1651 Label_As_String = CType(Snp_Requete2.Fields("Complete_Result").Value, String)
1652
1653 Dim Array_Labels As String()
1654 Array_Labels = Split(Label_As_String, ":")
1655
1656 If (Array_Labels(0) = "LABEL") Then
1657 Dim Labels As String()
1658 Labels = Split(Array_Labels(1), ",")
1659
1660 If (Labels(0) <> "") Then
1661 Zone_Curve_Data.Table_Data(Index_Courant).Label1 = Labels(0)
1662 End If
1663
1664 If (Labels(1) <> "") Then
1665 Zone_Curve_Data.Table_Data(Index_Courant).Label2 = Labels(1)
1666 End If
1667
1668 If (Labels(2) <> "") Then
1669 Zone_Curve_Data.Table_Data(Index_Courant).Success = CBool(Labels(2))
1670 End If
1671
1672 If (Labels(3) <> "") Then
1673 Zone_Curve_Data.Table_Data(Index_Courant).Value = Double.Parse(Labels(3))
1674 End If
1675
1676 End If
1677
1678
1679 Zone_Curve_Data.Table_Data(Index_Courant).DateTime = CDate(Snp_Requete2.Fields("Test_Date").Value)
1680 Zone_Curve_Data.Table_Data(Index_Courant).State = CType(State_As_Int, U_Db_Database_Log_Events.Type_Etat_Courbe_Html)
1681 End If
1682 End If
1683
1684 Snp_Requete2.MoveNext()
1685 Next
1686
1687 Counter_Lines_Max = 4
1688
1689 End If
1690
1691
1692
1693 'If Loc_Use_Field_Record_Search = True Then
1694 ' '---- Select restriction of the table ---------------------------------------
1695 ' Requete_SQL1 = "SELECT * FROM " + Loc_Linked_Table_Name + " WHERE " + Loc_Field_Record_Search + " = " + Str(Loc_Ident_Record_Search_Value) + " " ' Time_P WHERE Type='CVX' " '-- C'est Type_Bloc.Bloc_Standard
1696 'Else
1697 ' '---- Select all the table -------------------------------------------------
1698 ' Requete_SQL1 = "SELECT * FROM " + Loc_Linked_Table_Name
1699 'End If
1700 ''--- Show SQL string --------------
1701 'Call U_Msg_Local1.Aff_Coul_RGB(U_Msg_Local.Type_Warning.Aff_INFO, Color.Violet, "SQL Search Request= " + Requete_SQL1)
1702 ''--- Launch the request --------------
1703 'Snp_Request_Search1 = Loc_Base_Access.OpenRecordset(Requete_SQL1, dao.RecordsetTypeEnum.dbOpenDynaset)
1704
1705 'If ((Snp_Request_Search1.BOF = True) And (Snp_Request_Search1.EOF = True)) Then
1706 ' '---- Dynaset is empty => Exit --------------------------------------------
1707 ' Call U_Msg_Local1.Aff_Coul_RGB(U_Msg_Local.Type_Warning.Aff_INFO, Color.DarkOrange, "Table = " + Loc_Linked_Table_Name + " Search is empty -> Exit ")
1708 ' '---- Clear the grid (remove lines from last request) ---------------------
1709 ' Dim Count_Rows_To_clear As Integer
1710 ' Count_Rows_To_clear = Grid1.RowsCount
1711 ' If (Count_Rows_To_clear >= 1) Then
1712 ' Dim Counter_Rows As Integer
1713 ' For Counter_Rows = 1 To Count_Rows_To_clear - 1
1714 ' '---- Note: Clear the 1st line each time (auto indexed) ---------------
1715 ' Grid1.Rows.Remove(1)
1716 ' Next Counter_Rows
1717 ' End If
1718
1719 End If
1720
1721 Exit Sub
1722
1723 '-------------------------------------------------------------------------------
1724 '------------ Traitement des erreurs ----------
1725 '-------------------------------------------------------------------------------
1726Errhandler_Avec_Diagnostic:
1727 Call U_Msg_Local1.Affiche_Erreur("Error During Read Database TESTAUTO - simu for HKa")
1728 Resume Next
1729 '------------ Fin traitement des erreurs -------------
1730 End Sub
1731
1732
1733 Private Sub Show_Html_Local_Click(sender As Object, e As EventArgs) Handles Show_Html_Local.Click
1734 Dim html_file_loc As String = Html_File_Name_Text.Memo1_Text
1735
1736 If System.IO.File.Exists(html_file_loc) Then
1737 Process.Start(html_file_loc)
1738 End If
1739
1740 End Sub
1741
1742 Private Sub Show_Html_Network_Click(sender As Object, e As EventArgs) Handles Show_Html_Network.Click
1743 Dim html_file_net As String = U_Memo_Txt_Html_File_Name_Network.Memo1_Text
1744
1745 If System.IO.File.Exists(html_file_net) Then
1746 Process.Start(html_file_net)
1747 End If
1748 End Sub
1749
1750
1751
1752 Private Function Get_Max_Int_In_Array(data As Type_Curve_Data()) As Integer
1753 Dim result As Integer = -1
1754
1755 For Each element In data
1756 If (result = -1) Then
1757 result = CInt(element.Value)
1758 Else
1759 If (result < element.Value) Then
1760 result = CInt(element.Value)
1761 End If
1762 End If
1763
1764 Next
1765
1766 Return result
1767 End Function
1768
1769End Class