'#Reference {420B2830-E718-11CF-893D-00A0C9054228}#1.0#0#C:\WINDOWS\system32\scrrun.dll#Microsoft Scripting Runtime
' DisplayMultiTurretNCCodeInHTMLFormat.bas
'
' Author: Polina Milyavskaya
' Organization: Delcam USA
' Date: 10/10/07
' Copyright (c) 2008, Delcam USA
'
' General Description: Add-In allows user to view nc code for multiple turrets in parallel.
' 					   The nc code for multiple turrets is aligned by sync codes
'					   (lower and upper bounds of sync numbers are integer values specified
'					   by the user) and displayed in the resulting html file.
'					   Remark: the document must be opened and cnc file has to be loaded
'					   prior to the script execution.
'
' Works in FeatureCAM v14.2.0.12 and above
'
'Revised on 07/23/08-07/30/08. Polina:
'						Default upper and lower bounds of the sync numbers are set to
'						100 and 200 correspondingly.
'						Added ability to "remember" entered values of the upper and lower
'						bounds of the sync numbers (until the macro is unloaded or
'						FeatureCAM is restarted)
'						Added sync number prefix ("M", "P", etc.) field and its default value ("M")


Option Explicit

Dim sync_num_lower_bound As Integer
Dim sync_num_upper_bound As Integer
Dim sync_num_prefix As String

Sub DisplayMultiTurretNCCodeInHTMLFormat
	Dim doc As FMDocument
	Dim save_nc_result As String
	Dim res_fnames
	Dim file_content
	Dim i As Integer
	Dim fso 'As Scripting.FileSystemObject
	Dim file_tmp 'As Scripting.TextStream
	Dim output_file_name As String
	Dim num_of_turrets As Integer
	Dim html_file_generated As Boolean

	'Initialize variable
	'sync_num_lower_bound = -1 'don't initialize now (to keep old value)
	'sync_num_upper_bound = -1 'don't initialize now (to keep old value)
	output_file_name = ""
	If (sync_num_lower_bound <= 0 And sync_num_upper_bound <= 0) Then
		sync_num_lower_bound = 100 'temporary value, common for many machines
		sync_num_upper_bound = 200 'temporary value, common for many machines
	End If

	If (sync_num_prefix = "") Then
		sync_num_prefix = "M"
	End If

	Set fso = CreateObject("Scripting.FileSystemObject")


	'Get document handle
	Set doc = Application.ActiveDocument

	If (doc Is Nothing) Then
		MsgBox "Error accessing file. Application.ActiveDocument returns 'Nothing'"
		Exit Sub
	End If

	'Construct output file name (html), which will be displayed in the dialog box
	Dim pos As Integer
	pos = InStr(UCase(doc.Name), ".FM")
	If (pos > 0) Then
		output_file_name = "C:\" & Left(doc.Name, pos - 1) & ".html"
	Else
		output_file_name = "C:\" & doc.Name & ".html"
	End If

	'Get user input and verify it
	If (Not GetUserInput(sync_num_lower_bound, sync_num_upper_bound, output_file_name)) Then Exit Sub

	If (sync_num_lower_bound = -1 Or sync_num_upper_bound = -1 Or output_file_name = "") Then
		MsgBox "Required parameters were not set properly"
		Exit Sub
	End If


	'Save nc code and get the names of the generated files
	doc.SaveNC("temporaryNCCode.txt", "C:\",,eNCFT_NCCode, False, save_nc_result)
	res_fnames = Split(save_nc_result, vbLf & vbTab)


	'Compute the number of turrets based on the number of files generated
	num_of_turrets = UBound(res_fnames) - 1


	'Verify that files with nc code exist
	For i = 1 To num_of_turrets + 1
		If (Not fso.FileExists(res_fnames(i))) Then
			MsgBox "File " & res_fnames(i) & " doesn't exist"
			Exit Sub
		End If
	Next i


	'Read nc code
	ReDim file_content(num_of_turrets)
	For i = 1 To num_of_turrets + 1
		Set file_tmp = fso.OpenTextFile(res_fnames(i), 1)
		file_content(i-1) = file_tmp.ReadAll
		file_tmp.Close
	Next i


	'Format nc code
	html_file_generated = NCCodeToHTMLTableFormat(output_file_name, num_of_turrets, _
							file_content, sync_num_lower_bound, sync_num_upper_bound)

	If (html_file_generated) Then
		'View result (open html file)
		OpenHTMLFile output_file_name
	End If


	'Delete temporary nc code files
	For i = 1 To num_of_turrets + 1
		If (fso.FileExists(res_fnames(i))) Then fso.DeleteFile(res_fnames(i))
	Next i

End Sub




'Opens a dialog box and reads user data
Private Function GetUserInput(ByRef sync_num_lower_bound As Integer, _
							  ByRef sync_num_upper_bound As Integer, _
							  ByRef output_file_name As String) As Boolean

	Dim result As Long

	GetUserInput = False

	On Error GoTo reportError
	Begin Dialog UserDialog 490,150,"Display nc code for multiple turrets" ' %GRID:10,7,1,1
		OKButton 390,42,90,21
		CancelButton 390,70,90,21
		GroupBox 10,6,360,138,"",.GroupBox1
		Text 55,33,90,21,"Prefix:",.Text6
		TextBox 160,30,90,15,.prefix
		Text 55,56,90,21,"Lower bound:",.Text1
		TextBox 160,53,90,15,.lower_bound
		Text 55,79,100,21,"Upper bound:",.Text2
		TextBox 160,76,90,15,.upper_bound
		Text 55,122,180,21,"Enter full path:",.Text3
		TextBox 160,120,190,15,.output_file
		Text 30,14,100,21,"Sync code",.Text4
		Text 30,103,110,21,"Output file (html)",.Text5
	End Dialog
		Dim dlg As UserDialog

		dlg.output_file = output_file_name
		'if bound values are > 0, display them
		If (sync_num_upper_bound > 0) Then
			dlg.upper_bound = CStr(sync_num_upper_bound)
		End If
		If (sync_num_lower_bound > 0) Then
			dlg.lower_bound = CStr(sync_num_lower_bound)
		End If

		dlg.prefix = sync_num_prefix

		result = Dialog(dlg)

		If result = 0 Then
			Exit Function
		End If

		If (dlg.prefix = "") Then
			MsgBox "Sync code prefix wasn't specified. Defaulting to 'M'"
			sync_num_prefix = "M"
		Else
			sync_num_prefix = dlg.prefix
		End If

		If (Not IsNumeric(dlg.lower_bound)) Then
			MsgBox "Sync code lower bound must be a number"
			Exit Function
		End If

		If (Not IsNumeric(dlg.upper_bound)) Then
			MsgBox "Sync code upper bound must be a number"
			Exit Function
		End If

		If (dlg.output_file = "") Then
			MsgBox "Output file must be specified"
			Exit Function
		End If
		

		sync_num_lower_bound = CInt(dlg.lower_bound)
		sync_num_upper_bound = CInt(dlg.upper_bound)
		output_file_name = dlg.output_file

		GetUserInput = True
		Exit Function


	'If error occured
	reportError:
		MsgBox "Failed to get or process user input. Error details: " & Err.Description
		Err.Clear
		Exit Function

End Function




'Finds next sync code (M code in the range between sync_code_lower_bound
'and sync_code_upper_bound. The function returns the sync command (without the M)
'and the line containing nc code
Private Function FindNextSyncCode(ByVal nc_code As String, _
									ByVal sync_code_lower_bound As Integer, _
									ByVal sync_code_upper_bound As Integer, _
									ByRef sync_code_line As String _
								 ) As Integer
	Dim sync_code_pos As Integer
	Dim pos As Integer, m_code_pos As Integer
	Dim code As String
	Dim code_num As Integer
	Dim next_char As String
	Dim sync_code_found As Boolean

	Dim tmp_nc_code As String
	tmp_nc_code = nc_code

	sync_code_found = False
	FindNextSyncCode = -1
	pos = 1
	While (pos >= 1)
		code = ""
		pos = InStr(UCase(nc_code), UCase(sync_num_prefix))
		m_code_pos = pos
		If (pos = 0) Then Exit Function
		pos = pos + 1
		next_char = Mid(nc_code, pos, 1)
		While (IsNumeric(next_char))
			code = code & next_char
			pos = pos + 1
			next_char = Mid(nc_code, pos, 1)
		Wend
		If (IsNumeric(code)) Then
			code_num = CInt(code)
			If (code_num >= sync_code_lower_bound And code_num <= sync_code_upper_bound) Then
				FindNextSyncCode = code_num
				sync_code_line = Mid(nc_code, m_code_pos, Len(nc_code)-InStr(nc_code, vbLf))
				If (InStr(sync_code_line, vbCr) > 0) Then
					sync_code_line = Left(sync_code_line, InStr(sync_code_line, vbCr)-1)
				End If
				Exit Function
			End If
		End If
		nc_code = Right(nc_code, Len(nc_code) - pos)
	Wend
End Function



'Parse nc code for each turret and save nc code to html file (table format)
Private Function NCCodeToHTMLTableFormat(ByVal output_file_name As String, _
										   ByVal num_of_turrets As Integer, _
										   ByVal file_content As Variant, _
										   ByVal sync_code_lower_bound As Integer, _
										   ByVal sync_code_upper_bound As Integer) As Boolean
	Dim html_file
	Dim fso
	Dim tmp As String
	Dim sync_code_found As Boolean
	Dim sync_code_found_each_file() As Boolean
	Dim search_sync_num As Integer
	Dim i As Integer

	Dim sync_code_line As String

	NCCodeToHTMLTableFormat = False

	Set fso = CreateObject("Scripting.FileSystemObject")

	search_sync_num = sync_code_lower_bound

	ReDim sync_code_found_each_file(num_of_turrets)

	'Create html file
	On Error Resume Next
    	Set html_file = fso.OpenTextFile(output_file_name, 2, True)
    	If (Not fso.FileExists(output_file_name)) Then
    		MsgBox "Failed to create file " & output_file_name
    		Exit Function
    	End If
	    If (html_file Is Empty) Then Exit Function

	On Error GoTo reportError
		html_file.WriteLine("<HTML>")
		html_file.WriteLine("<BODY>")
		html_file.WriteLine("<center>")
		html_file.WriteLine("<table border=""1"" cellpadding=""2"" cellspacing=""0"">")
		html_file.WriteBlankLines(1)

		'Header of the table (i.e. "Turret 1 program")
		WriteColumnHeadersToTable html_file, num_of_turrets

		sync_code_found = True
		While (sync_code_found)
			html_file.WriteLine("<tr valign=""top"">")
			'Determine what's the next sync code
		  	search_sync_num = FindNextSyncCode(file_content(0), sync_code_lower_bound, sync_code_upper_bound, sync_code_line)
			If (search_sync_num >= sync_code_lower_bound And search_sync_num <= sync_code_upper_bound) Then
				'Find sync code in each file and write nc code before it to html file
				For i = 0 To num_of_turrets
					tmp = GetContentBeforeNextSyncCode(file_content(i), UCase(sync_num_prefix) & search_sync_num, sync_code_found_each_file(i))'sync_code_found)
					sync_code_found = sync_code_found Or sync_code_found_each_file(i)
					If (sync_code_found_each_file(i)) Then
						html_file.WriteLine("    " & HTMLColumn(Join(Split(tmp, vbCrLf), "<br>")))
					Else
						html_file.WriteLine("    " & HTMLColumn(Join(Split(file_content(i), vbCrLf), "<br>")))
						file_content(i) = ""
					End If
				Next i
				html_file.WriteLine("</tr>")
				html_file.WriteBlankLines(1)
				'Write sync code (line containing sync code to the html file)
				If (sync_code_found) Then
					WriteSyncCodeRowToTable html_file, sync_code_line, sync_code_found_each_file, num_of_turrets
				End If
			Else
				sync_code_found = False
			End If
		Wend

		'If no more sync codes are found in the file, write the remaining nc code to file
		For i = 0 To num_of_turrets
			html_file.WriteLine("    " & HTMLColumn(Join(Split(file_content(i), vbCrLf), "<br>")))
		Next i

		html_file.WriteLine("</table><br>")
		html_file.WriteLine("</center>")
		html_file.WriteLine("</BODY>")
		html_file.WriteLine("</HTML>")
		html_file.Close

		NCCodeToHTMLTableFormat = True
		Exit Function


	'If error occured
	reportError:
		MsgBox "Script failed in method DisplayNCCodeInHTMLFormat. Error details: " & Err.Description
		Err.Clear
		Exit Function

End Function


'Write header of the table (turrets' names) to the html file
Private Sub WriteColumnHeadersToTable(ByVal html_file, _
										ByVal num_of_turrets As Integer)
	Dim i As Integer

	html_file.WriteLine("<tr bgcolor=""#C0C0C0"">")
	For i = 0 To num_of_turrets
		html_file.WriteLine("    " & _
							"<td><font face=""Arial"" size=""3""><b>" & "Turret " & i+1 & " program" & "</b></font></td>")

		'html_file.WriteLine("    " & HTMLColumn(HTMLBold("Turret " & i+1 & " program")))
	Next i
	html_file.WriteLine("</tr>")
	html_file.WriteBlankLines(1)

End Sub

'Write "<tr><td>M*</td><td>M*</td></tr>" kind of line to the html file
Private Sub WriteSyncCodeRowToTable(ByVal html_file, _
									ByVal sync_code As String, _
									ByRef sync_code_found_each_file() As Boolean, _
									ByVal num_of_turrets As Integer)

	Dim i As Integer

	html_file.WriteLine("<tr bgcolor=""#C0C0C0"">")
	For i = 0 To num_of_turrets
		If (sync_code_found_each_file(i)) Then
			html_file.WriteLine("    " & _
								"<td><font face=""Arial"" size=""3"" color=""#CC0000""><b>" & sync_code & "</b></font></td>")
		Else
			html_file.WriteLine("    " & _
								"<td><font face=""Arial"" size=""4"" color=""#CC0000""><b>" & sync_code & " not found</b></font></td>")
		End If
	Next i
	html_file.WriteLine("</tr>")
	html_file.WriteBlankLines(1)

End Sub

'Extract content of the nc code file from the previous sync code (or beginning
'of the file) up to the next sync code
Private Function GetContentBeforeNextSyncCode(ByRef nc_code As String, _
												ByVal sync_code As String, _
												ByRef sync_code_found As Boolean _
											 ) As String
	Dim sync_code_pos As Integer

	sync_code_found = False
	GetContentBeforeNextSyncCode = ""

	sync_code_pos = InStr(nc_code, sync_code)
	If (sync_code_pos > 0) Then
		sync_code_found = True
		GetContentBeforeNextSyncCode = Left(nc_code, sync_code_pos - 1)
		nc_code = Right(nc_code, (Len(nc_code)-sync_code_pos)+1)
		nc_code = Right(nc_code, Len(nc_code)-InStr(nc_code, vbLf))
	End If
End Function

'put html "row" tags around the string
Private Function HTMLRow( s As String ) As String
	HTMLRow = "<tr>" & s & "</tr>"
End Function

'put html "column" tags around the string
Private Function HTMLColumn( s As String ) As String
	HTMLColumn = "<td><font face=""Arial"" size=""2"">" & s & "</font></td>"
End Function

'put html "bold" tags around the string
Private Function HTMLBold( s As String ) As String
	HTMLBold = "<b>" & s & "</b>"
End Function

'Open html file
Private Sub OpenHTMLFile(ByVal fileName As String )
	Dim Web As Object
    Set Web = CreateObject("InternetExplorer.Application")
    Web.Visible = True
    Web.Navigate fileName
End Sub


' Add a toolbar button for this macro upon loading of this addin into FeatureCAM.
Private Sub OnLoadAddin()
	Dim bars As FMCmdBars
	Dim bar As FMCmdBar
	Dim ctrl As FMCmdBarBtn
	Set bars = Application.CommandBars
	Set bar = bars("Macros")
	If bar Is Nothing Then
		Set bar = bars.Add ("Macros")
	End If
	Set ctrl = bar.Controls.Add( ,,"DisplayMultiTurretNCCodeInHTMLFormat")
	ctrl.FaceId = 38
	bar.Visible=True
End Sub

' Remove the toolbar button for this macro upon unloading of this addin from FeatureCAM.
Private Sub OnUnloadAddin()
	Dim bars As FMCmdBars
	Dim bar As FMCmdBar
	Dim ctrl As FMCmdBarCtrl
	Set bars = Application.CommandBars
	Set bar = bars("Macros")
	If Not bar Is Nothing Then
		Set ctrl = bar.Controls("DisplayMultiTurretNCCodeInHTMLFormat")
		If Not ctrl Is Nothing Then
			ctrl.Delete
		End If
	End If
End Sub

Private Sub AddIn_OnConnect(ByVal flags As FeatureCAM.tagFMAddInFlags)
	OnLoadAddin
End Sub

Private Sub AddIn_OnDisConnect(ByVal flags As FeatureCAM.tagFMAddInFlags)
	OnUnloadAddin
End Sub