' -----------------------------------------------------------------------------
' --- CustomDialogClass.CATScript
' -----------------------------------------------------------------------------
' (c) 2023, Johann Oberdorfer - Engineering Support | CAD | Software
'     johann.oberdorfer [at] gmail.com
'     www.johann-oberdorfer.eu
' -----------------------------------------------------------------------------
' This source file is distributed under the BSD license.
'   This program is distributed in the hope that it will be useful,
'   but WITHOUT ANY WARRANTY; without even the implied warranty of
'   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
'   See the BSD License for more details.
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
'
' Purpose:
'
'   A generic user dialog for Catia.
'   This is a prove of concept and is based on HTA + mshta.exe, whereas
'   the HTA:Application is configured to emulate "Edge" mode.
'   Is it guaranteed so that mshta.exe will be supported in the future?
'   Mshta.exe depends on mshta.dll which is part of the OS and most likely
'   it will be supported. As we are speaking about MS, of course, this is
'   only a good guess.
'
'   Techniques/programming languages used:
'     catscript class, HTML, CSS, javascript,
'     HTA (running in edge emulation mode), WShell
'
'   The dialog can be configured via a variety of input arguments.
'   When calling up, the dialog window is positioned in the center
'   of the Catia screen (multi screen environment also supported).
'   The layout of the dialog can be styled via css and behavior and
'   event management can be programmed via javascript as for any web
'   application.
'   As mentioned above, this is a prove of concept and the source code
'   provided here might be a starting point for an even more elaborated
'   user dialog.
'   The return value(s) is(are) returned to the catscript caller via
'   the "wshell stdout" stream and so the dialog keeps alive as long as
'   the stdout stream does not return -eof- code (or similar).
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' Option Explicit
Language="VBSCRIPT"

Class CustomDialogClass

	Private H() As String
	Private Image As String

	Private Sub Class_Initialize()
		ReDim H(0)
		Image = ""
	End Sub

	' Private Sub Class_Terminate()
	' End Sub

	Private Sub LAdd (ByVal str As String)
		' index always starts at position 1
		ReDim Preserve H (UBound(H) + 1)
		H (UBound(H)) = str
	End Sub

	Private Property Get Count() As Long
        Count = UBound(H)
    End Property

	Private Property Get Item (ByVal index As Long) As String
        Item = H(index)
    End Property

	Private Function CreateUniqueFileName ( _
				ByVal file_name As String, _
				ByVal file_ext As String, _
				ByRef full_path_name As String) As Boolean
		Dim d,m,y, _
			date_str, time_str, temp_dir As String

		Dim str As Folder
		Dim fs As FileSystem

		' get the user's temporary directory ...
		' --------------------------------------

		Set fs = CATIA.FileSystem
		Set str = fs.TemporaryDirectory
		temp_dir = CATIA.SystemService.Environ(str.Name)

		IF ( Not fs.FolderExists(temp_dir) ) Then
			CreateUniqueFileName = False
			Exit Function
		End IF

		' create a unique time-stamp
		' --------------------------
		' note:
		' date_str = FormatDateTime(Now(), vbGeneralDate)
		' does not work very well as the function relies
		' on system default settings which might be unpredictable

		d = Day(Now())
		m = Month(Now())
		y = Right(Year(Now()), 2)
		
		If Len(d) = 1 Then d = "0" & d
		If Len(m) = 1 Then m = "0" & m

		date_str = y & "-" & m & "-" & d
		time_str = Replace (Time, ":", "-", 1, -1, vbTextCompare)
		time_stamp = Replace (date_str & "-" & time_str, " ", "-", 1, -1, vbTextCompare)

		' and finally, create a full pathname
		file_name = file_name + "-" + time_stamp + file_ext
		full_path_name = fs.ConcatenatePaths(temp_dir, file_name)

		CreateUniqueFileName = True
	End Function

	' // attempt to open a data file
	' //
	Private Function OpenDataFileForWriting ( _
							ByVal fileName As String, _
							ByRef ostream As CATIATextStream) As Boolean

		Dim Overwrite As Boolean : Overwrite = True
		Dim fs As FileSystem
		Dim f As File

		OpenDataFileForWriting = False
		Set fs = CATIA.FileSystem

		Err.Clear : On Error Resume Next
		Set f = fs.CreateFile(fileName, Overwrite)
		On Error Goto 0

		If (Err.Number <> 0) Then
			Exit Function
		End IF

		' attempt to open the output file
		Err.Clear : On Error Resume Next
		Set ostream = f.OpenAsTextStream( "ForWriting" )
		On Error Goto 0

		If (Err.Number <> 0) Then
			Exit Function
		End If

		OpenDataFileForWriting = True
	End Function

	' no external or add on files are used
	'
	Private Sub BuildDialog ( _
					ByVal w As Long, ByVal h As Long, _
					ByVal msg As String, ByVal params() As String)

		Dim i As Integer
		Dim label, rbutton As String
		Dim left, top As Long
		Dim fs As CATIAFileSystem
		Set fs = CATIA.FileSystem

		' header block...
		LAdd "<html>"
		LAdd "<head>"
		LAdd "<title>Option Dialog</title>"
		LAdd "<hta:application"
		LAdd "  id='myHTA' applicationname='Select Option:'"
		LAdd "  border='thin' borderstyle='normal' innerborder='no'"
		LAdd "  caption='yes'"
		LAdd "  singleinstance='yes'"
		LAdd "  showintaskbar='yes'"
		LAdd "  navigable='yes'"
		LAdd "  sysmenu='no' contextmenu='no'"
		LAdd "  maximizebutton='no' minimizebutton='no'"
		LAdd "  resizable='no'>"
		LAdd "<meta http-equiv='x-ua-compatible' content='ie=edge'>"
		
		LAdd "<style>"
		LAdd "body {"
		LAdd "  padding:0; margin:0;"
		LAdd "  font-family: Arial,sans-serif; font-size:12px;"
		LAdd "}"
		LAdd ".container {"
		LAdd "  display:flex;"
		LAdd "  flex-direction:column;"
		LAdd "  align-items:center;"
		LAdd "  justify-content:center;"
		LAdd "  background-color:GhostWhite;"
		LAdd "}"
		LAdd "label {"
		LAdd "  display:block;"
		LAdd "  margin:5px;"
		LAdd "  padding:10px;"
		LAdd "  border:1px solid #ccc;"
		LAdd "  border-radius:10px;"
		LAdd "  cursor:pointer;"
		LAdd "  transition:background-color 0.2s ease;"
		LAdd "  background:GhostWhite;"
		LAdd "  min-width:200px;font-size:14px;"
		LAdd "}"
		LAdd "  label:hover {"
		LAdd "  background-color:CornflowerBlue;"
		LAdd "}"
		LAdd "button {"
		LAdd "  margin:5px;"
		LAdd "  padding:5px 5px;"
		LAdd "  border:1px solid #ccc;"
		LAdd "  border-radius:5px;"
		LAdd "  cursor:pointer;"
		LAdd "  transition:background-color 0.2s ease;"
		LAdd "  min-width:100px;"
		LAdd "}"
		LAdd "button:hover {"
		LAdd "  background-color:CornflowerBlue;"
		LAdd "}"
		LAdd "#okButton:focus, #cancelButton:focus {"
		LAdd "  outline:none;"
		LAdd "}"
		LAdd "img {"
		LAdd "  max-width:100%;"
		LAdd "  height:auto;"
		LAdd "  margin-top:5px;margin-bottom:5px;"
		LAdd "}"
		LAdd "</style>"

		LAdd "</head>"
		LAdd "<body scroll='no' style='background-color:Lavender;' >"

		' logo goes here ...
		If (fs.FileExists(Image)) Then
			LAdd "<div class='container'>"
			LAdd "<img src='" + Image + "'>"
			LAdd "</div>"
		ElseIf _
			(Len(Image) > 100) Then ' is a base64 encoded image ?
			LAdd "<div class='container'>"
			LAdd "<img src='data:image/png;base64, " + Image + " '>"
			LAdd "</div>"
		End If

		LAdd "<div class='container' style='background-image: linear-gradient(GhostWhite,Lavender);'>"

		' message goes here ...
		If (Len(msg) <> 0) Then
			LAdd "<h3>"
			LAdd msg
			LAdd "</h3>"
		End If

		LAdd "<div class='radio'>"

		' "<label id='label1' onclick='selectLabel(""label1"")' style='background-color:CornflowerBlue;'>"
		' "<input type='radio' id='myRadioButton1' name='myRadioGroup' value='Option 1' checked>"
		' "Option 1"
		' "</label>"
		' "<br/>"

		For i = 1 To Ubound(params)
			label = "label" + CStr(i)
			rbutton = "myRadioButton" + CStr(i)
			value =	Trim(params(i))
			
			If (InStr(1, value, "*", vbTextCompare)) Then
				value = Mid (value, 2, Len(value))
LAdd "<label id='" + label + "' onclick='selectLabel(""" + label + """)' style='background-color:CornflowerBlue;'>"
LAdd "<input type='radio' id='" + rbutton + "' name='myRadioGroup' value='" + value + "' checked>"
LAdd value
LAdd "</label>"
			Else
LAdd "<label id='" + label + "' onclick='selectLabel(""" + label + """)'>"
LAdd "<input type='radio' id='" + rbutton + "' name='myRadioGroup' value='" + value + "'>"
LAdd value
LAdd "</label>"
			End If

		Next

		LAdd "</div>"
		LAdd "</div>"
		LAdd "<div class='container' style='background:Gainsboro; border-radius: 0px; padding:10px;'>"
		LAdd "<div>"
		LAdd "<button id='okButton' onclick='OK_Click()'>OK</button>"
		LAdd "<button id='cancelButton' onclick='Cancel_Click()'>Cancel</button>"
		LAdd "</div>"
		LAdd "</div>"
		LAdd "<script type='text/javascript'>"

		If (TypeName(CATIA) = "Application") Then

			' some screen arithmetics required to place the dialog centered
			' on-top of the CATIA window, should also work for dual screens...
		
			left = CATIA.Left + (CATIA.Width/2)-(w/2)
			top  = CATIA.Top  + (CATIA.Height/2)-(h/2)
			
			LAdd "window.resizeTo(" + CStr(w) + "," + CStr(h) + ");"
			LAdd "window.moveTo(" + CStr(left) + "," + CStr(top) + ");"
			LAdd "window.focus();"
		Else
			' fallback solution
			LAdd "const w = " + CStr(w) + ";"
			LAdd "const h = " + CStr(h) + ";"
			LAdd "window.resizeTo(w, h);"
			LAdd "window.moveTo((screen.availWidth - w) / 2, (screen.availHeight - h) / 2);"
			LAdd "window.focus();"
		End If

		LAdd "function selectLabel(labelId) {"
		LAdd "const labels = document.getElementsByTagName('label');"
		LAdd "for (let i = 0; i < labels.length; i++) {"
		LAdd "labels[i].style.backgroundColor = '';"
		LAdd "}"
		LAdd "const selectedLabel = document.getElementById(labelId);"
		LAdd "selectedLabel.style.backgroundColor = 'CornflowerBlue';"
		LAdd "}"

		class_LAdd "function OK_Click() {"
		class_LAdd "const stdout = new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1);"
		class_LAdd "var inputs = document.querySelectorAll('input[name=""myRadioGroup""]');"
		class_LAdd "var usr = 0;"
		class_LAdd "for (var i = 0; i < inputs.length; ++i) {"
		class_LAdd "if (inputs[i].checked) {"
		class_LAdd "usr = i+1;"
		class_LAdd "break;"
		class_LAdd "}"
		class_LAdd "}"
		class_LAdd "if (usr === 0) {"
		class_LAdd "stdout.WriteLine('');"
		class_LAdd "} else {"
		class_LAdd "stdout.WriteLine(usr);"
		class_LAdd "}"
		class_LAdd "window.close(1);"
		class_LAdd "}"

		LAdd "function Cancel_Click() {"
		LAdd "window.close();"
		LAdd "}"
		LAdd "document.addEventListener('keydown', function(event) {"
		LAdd "if (event.key === 'Enter') {"
		LAdd "event.preventDefault();"
		LAdd "document.getElementById('okButton').click();"
		LAdd "}"
		LAdd "event = window.event;"
		LAdd "if (event.keyCode == 27) {"
		LAdd "event.preventDefault();"
		LAdd "document.getElementById('cancelButton').click();"
		LAdd "}"
		LAdd "});"
		LAdd "</script>"
		LAdd "</body>"
	End Sub

	Public Sub SetImage (ByVal mmencoded_str As string) As String
        Image = mmencoded_str
    End Sub

	Public Function ShowSelectionDialog ( _
			ByVal w As Long, ByVal h As Long, _
			ByVal msg As String, ByVal params() As String) As String

		Dim usr, hta_dialog_filename As String
		Dim fs As FileSystem
		Dim ostream As CATIATextStream
		Dim wsh As IWsgShell3
		Dim hta As WshExec
	
		Set fs = CATIA.FileSystem

		' create unique temp File
		If ( Not CreateUniqueFileName ("hta_dialog", ".hta", hta_dialog_filename)) Then
			Err.Raise 1010, _
				"CustomDialogClass", _
				"Unable to create temporary file: " + hta_dialog_filename
		End If
		
		If (Not OpenDataFileForWriting (hta_dialog_filename, ostream) ) Then
			Err.Raise 1011, _
				"CustomDialogClass", _
				"Unable to open file: " + hta_dialog_filename + " for writing!"
		End If

		' build dialog
		Call BuildDialog (w,h, msg, params)

		' write hta dialog information to temp file...
		For i = 1 To Count
			ostream.Write Item(i) + Chr(10)
		Next
		ostream.Close
	
		' call up the the dialog
		usr = ""

		' mshta.exe
		'   - is based on mshta.dll which is part of the windows OS and is supported
		'     for the future (whereas IE is running out of support)
		'   - no more command line options, takes a script as argument,
		'     or a HTA dialog file, when using HTA a file is required,
		'     a string which holds the hta code is not accepted (!)
		'
		Set wsh = CreateObject("WScript.Shell")
		Set hta = wsh.Exec("mshta.exe " + hta_dialog_filename)

		If hta.ExitCode <> 0 Then
			' handle error (if any)
			MsgBox "Error occured while executing mshta.exe!"
		Else
			' get the selected value from the HTA window,
			' CATIA keeps in frozen state as long as 'stdout stream'
			' does not send eof-stream...
			
			Do Until hta.StdOut.AtEndOfStream
				usr = hta.StdOut.ReadLine()
			Loop
		End If

		fs.DeleteFile (hta_dialog_filename)

		' return value
		ShowSelectionDialog = usr
	End Function

End Class

' ------------------------
' dialog test goes here...
' ------------------------

Dim MMENCODED_LOGO As String
MMENCODED_LOGO = _
"iVBORw0KGgoAAAANSUhEUgAAAPoAAAA6CAMAAACu2rS7AAAABGdBTUEAALGPC" + _
"VQAAAL3UExURUdwTP8MAP7+/87Ozujo6P///9HR0ezs7O3t7evr683Nzf+KAO" + _
"...truncated, insert your own logo here (optional) ..."

Sub LAddValue (ByRef options() As String, ByVal str As String)
	' index always starts at position 1
	ReDim Preserve options (UBound(options) + 1)
	options (UBound(options)) = str
End Sub

' example function, can be called directly from CATMain

Function CustomDialogClass_Cmd (ByVal options() As String) As String
	Dim usr As String
	Dim DLG As CustomDialogClass

	Set DLG = New CustomDialogClass
	' DLG.SetImage (MMENCODED_LOGO)

	usr = DLG.ShowSelectionDialog (_
			400, 500, "Select your required option:", options)
	
	Set DLG = Nothing

	CustomDialogClass_Cmd = usr
End Function

' example function, can be called via "CATIA.SystemService.ExecuteScript"

Function CustomDialogClass_Cmd1 ( _
			ByVal opt_w As Integer, ByVal opt_h As Integer, _
			ByVal option_str As String) As String
	Dim arr As Array
	Dim usr As String
	Dim options() As String
	Dim DLG As CustomDialogClass

	ReDim options(0)

	arr = Split(option_str, "@")
	For i = 0 To Ubound(arr)
		LAddValue options, arr(i)
	Next

	Set DLG = New CustomDialogClass
	' DLG.SetImage (MMENCODED_LOGO)
	DLG.SetImage ("<Your own path here>\job_engineering_logo_small-min.png")

	usr = DLG.ShowSelectionDialog (_
			opt_w, opt_h, "Select your required option:", options)
	
	Set DLG = Nothing

	CustomDialogClass_Cmd1 = usr
End Function


Sub CATMain ()
	Dim usr, options() As String
	' Dim catia_w, catia_h As Integer

	' if a "*" is used at the 1st place,
	' this option becomes the default one

	ReDim options(4)
	options(1) = "The quick brown fox"
	options(2) = "*jumps over" 'default option
	options(3) = "walks around"
	options(4) = "the lazy dog."

	' MsgBox CStr(catia_w) + " : " + CStr(catia_h)

	CATIA.RefreshDisplay = False

	' -----------------------------------
	usr = CustomDialogClass_Cmd (options)
	' -----------------------------------

	If (Len(usr) = 0) Then
		MsgBox "Nothing selected!"
	Else
		MsgBox "You selected: " + usr
	End If
End Sub

' -----------------------------------------------------------------------------
' --- CustomDialogClass-Test.CATScript
' -----------------------------------------------------------------------------
' (c) 2023, Johann Oberdorfer - Engineering Support | CAD | Software
'     johann.oberdorfer [at] gmail.com
'     www.johann-oberdorfer.eu
' -----------------------------------------------------------------------------
' This source file is distributed under the BSD license.
'   This program is distributed in the hope that it will be useful,
'   but WITHOUT ANY WARRANTY; without even the implied warranty of
'   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
'   See the BSD License for more details.
' -----------------------------------------------------------------------------
' Purpose:
'
' A CATScript example call of a 'custom message dialog' class which implements
' a generic user selection dialog.
'
' Features:
' - The user message dialog is stored in a separate file and
'   is called up and instantiated at run-time via a
'     CATIA.SystemService.ExecuteScript call
' - The user dialog itself is freely configurable and
'   is based on a HTM application + mshta.exe
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' Option Explicit
Language = "VBSCRIPT"

Const PATH_NAME = "<current-directory-name-goes-here>\CATScript"
Const CUSTOM_DLG = "CustomDialogClass.CATScript"
Const DELIM = "@"


Sub CATMain()
	Dim usr As Variant
	Dim params() As Variant
	
	' if a "*" is used at the 1st place,
	' this option becomes the default one

	ReDim params(2)
	params(0) = 400
	params(1) = 500
	params(2) = _
		"The quick brown fox" + DELIM + _
		"*jumps over" 		  + DELIM + _
		"walks around"		  + DELIM + _
		"the lazy dog."

	usr = CATIA.SystemService.ExecuteScript ( _
				PATH_NAME, catScriptLibraryTypeDirectory, _
				CUSTOM_DLG, "CustomDialogClass_Cmd1", params)

	If (Len(usr) = 0) Then
		MsgBox "Nothing selected!"
	Else
		MsgBox "You selected: '" + usr + "'"
	End If

End Sub

Finally, here is the content of the HTA declaration file which is written as a temporary file and with a unique file name to %TEMP% directory. Once the dialog is closed, this file will be deleted.

Note that the following line is required to declare the emulation mode:

<meta http-equiv='x-ua-compatible' content='ie=edge'>

In this mode catscript is no longer supported. Code declared between the <script> ... </script> tags is considered to be javascript. Strictly speaking, the type='text/javascript' is also not required any more and can be deleted.

<html>
<head>
<title>Select Option Dialog</title>
<hta:application
id='myHTA' applicationname='Select Option:'
border='thin' borderstyle='normal' innerborder='no'
caption='yes'
singleinstance='yes'
showintaskbar='yes'
navigable='yes'
sysmenu='no' contextmenu='no'
maximizebutton='no'	minimizebutton='no'
resizable='no'>
<meta http-equiv='x-ua-compatible' content='ie=edge'>
<style>
.container {
display: flex;
flex-direction: column;
align-items: center;
justify-content: center;
/* padding: 5px; */
background-color: GhostWhite /* #f7f7f7 */;
font-family: Arial, sans-serif;
}
label {
display: inline-block;
margin-bottom: 10px;
padding: 10px 10px;
border: 1px solid #ccc;
border-radius: 10px;
cursor: pointer;
transition: background-color 0.2s ease;
}
label:hover {
background-color: CornflowerBlue; /* #f0f0f0; */
}
button {
margin: 10px;
padding: 10px 10px;
border: 1px solid #ccc;
border-radius: 5px;
font-size: 16px;
cursor: pointer;
transition: background-color 0.2s ease;
min-width: 100px;
}
button:hover {
background-color: CornflowerBlue;
}
#okButton:focus, #cancelButton:focus {
outline: none;
}
img {
max-width: 100%;
height: auto;
margin-bottom: 5px;
}
</style>
</head>
<body scroll='no' style='background-color: Wheat;' >
<div class='container' style='background-color: Wheat;'>
<img src='data:image/png;base64, base64-encoded-image-here '>
</div>
<div class='container' style='background-image: linear-gradient(Wheat,GhostWhite);'>
<h3>
Select your required option:
</h3>
<div class='radio'>
<label id='label1' onclick='selectLabel("label1")'>
<input type='radio' id='myRadioButton1' name='myRadioGroup' value='The quick brown fox'>
The quick brown fox
</label>
<br/>
<label id='label2' onclick='selectLabel("label2")' style='background-color:CornflowerBlue;'>
<input type='radio' id='myRadioButton2' name='myRadioGroup' value='jumps over' checked>
jumps over
</label>
<br/>
<label id='label3' onclick='selectLabel("label3")'>
<input type='radio' id='myRadioButton3' name='myRadioGroup' value='walks around'>
walks around
</label>
<br/>
<label id='label4' onclick='selectLabel("label4")'>
<input type='radio' id='myRadioButton4' name='myRadioGroup' value='the lazy dog.'>
the lazy dog.
</label>
<br/>
</div>
</div>
<div class='container' style='background:Gainsboro; border-radius: 5px;'>
<div>
<br/>
<button id='okButton' onclick='OK_Click()'>OK</button>
<button id='cancelButton' onclick='Cancel_Click()'>Cancel</button>
</div>
</div>
<script type='text/javascript'>
window.resizeTo(400,500);
window.moveTo(-1127,330.5);
window.focus();
function selectLabel(labelId) {
const labels = document.getElementsByTagName('label');
for (let i = 0; i < labels.length; i++) {
labels[i].style.backgroundColor = '';
}
const selectedLabel = document.getElementById(labelId);
selectedLabel.style.backgroundColor = 'CornflowerBlue';
}
function OK_Click() {
const stdout = new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1);
if (document.getElementById('myRadioButton1').checked) {
stdout.WriteLine(document.getElementById('myRadioButton1').value);
} else if (document.getElementById('myRadioButton2').checked) {
stdout.WriteLine(document.getElementById('myRadioButton2').value);
} else if (document.getElementById('myRadioButton3').checked) {
stdout.WriteLine(document.getElementById('myRadioButton3').value);
} else {
stdout.WriteLine('');
}
window.close(1);
}
function Cancel_Click() {
window.close();
}
document.addEventListener('keydown', function(event) {
if (event.key === 'Enter') {
event.preventDefault();
document.getElementById('okButton').click();
}
event = window.event;
if (event.keyCode == 27) {
event.preventDefault();
document.getElementById('cancelButton').click();
}
});
</script>
</body>