Page 1 of 1

HTA/VBS interface

Posted: 2018-07-15T14:07:17-07:00
by pmcgillan
Hi,
I looked for a simple interface that was easy to use. finding none, I wrote one. Not sure if this will come through, but here is the code. If it doesn't come through and work, fill free to email me and I will send via regular email.

Code: Select all

<HTML>
<HEAD>
<TITLE>Picture Changer</TITLE>
<HTA:APPLICATION ID="oHTA"
     APPLICATIONNAME="Picture Annotater"
     BORDER=none
     BORDERSTYLE=none
     CAPTION="yes"
     ICON=""
     MAXIMIZEBUTTON=no
     MINIMIZEBUTTON=no
     SHOWINTASKBAR=yes
     SINGLEINSTANCE=yes
     SYSMENU="yes"
     VERSION="2.0"
     CONTEXTMENU="no"
     WINDOWSTATE="maximize"
/>
<SCRIPT language=vbs>
Dim StartPath, Filter, Caption, OpenFileDialog, Chg1, Chg2, Chg3, Chg4, Chg5, Chg6, Chg7, Chg8, MyFileName

Set MyFSO = CreateObject("Scripting.FileSystemObject")

Sub Window_onloadw
  Filter = "*.jpg"
  StartPath = "P:\Pictures\"
  Caption = "Select a File"
end sub

Sub Go_onclick

  MyFileName = Dlg.openfiledlg(StartPath & "*", , Cstr(Filter), Cstr(Caption))
  MyFileName = split(MyFileName, chr(0))(0) ' removes the excess baggage hidden on the end

  PLine = ""
  PLine = PLine & "<br><form name='newone'><table>"
  PLine = PLine & "<tr><td>File Name</td><td><input type='text' id='Chg1' size='50' value='"&MyFileName&"'></td></tr>"
  PLine = PLine & "<tr><td>Location X</td><td><input type='text' id='Chg2' size='10' value='50'></td></tr>"
  PLine = PLine & "<tr><td>Location Y</td><td><input type='text' id='Chg3' size='10' value='50'></td></tr>"
  PLine = PLine & "<tr><td>Font</td><td><input type='text' id='Chg4' size='50' value='Courier'></td></tr>"
  PLine = PLine & "<tr><td>Font Size</td><td><input type='text' id='Chg5' size='50' value='40'></td></tr>"
  PLine = PLine & "<tr><td>Color</td><td><input type='text' id='Chg6' size='50' value='Black'></td></tr>"
  PLine = PLine & "<tr><td>Info</td><td><input type='text' id='Chg7' size='50' value='2018'></td></tr>"
  PLine = PLine & "<tr><td>Gravity</td><td><input type='text' id='Chg8' size='50' value='NorthWest'></td></tr>"

  PLine = PLine & "<tr><th colspan=2><input type='button' value='Process' onClick='ProcessIt()'>"
  PLine = PLine & "<input type='button' value='Exit' onClick='QuitScript()'></th></tr>"

  DataArea.innerHTML = PLine
  DataArea.style.visibility="visible"

  PicArea.innerHTML = ""

End sub

'##############################################################
' process filename - adds annontation - could be top and bottom add
Sub ProcessIt
  Dim img
  Set img = CreateObject("ImageMagickObject.MagickImage.1")

  MyFname = Document.Forms(0).elements("Chg1").value
  MyLocX = Document.Forms(0).elements("Chg2").value
  MyLocY = Document.Forms(0).elements("Chg3").value
  MyFont = Document.Forms(0).elements("Chg4").value
  MySize = Document.Forms(0).elements("Chg5").value
  MyColor = Document.Forms(0).elements("Chg6").value
  MyInfo = Document.Forms(0).elements("Chg7").value
  MyGravity = Document.Forms(0).elements("Chg8").value
  MyOutput = MyFSO.GetParentFolderName(MyFname) & "\" & "PC_" & MyFSO.GetFileName(MyFname)

  img.Convert MyFname, "-gravity", MyGravity, "-font", MyFont, "-pointsize", MySize, "-fill", MyColor, "-annotate", "+50+50", MyInfo, MyOutput

  PicArea.innerHTML = "<img src='"&MyOutput&"'>"
End Sub

'##############################################################
' exit program
Sub QuitScript
   self.Close()
End Sub


'##############################################################
' run program
Function RunFile(fname)
  Shell.Run fname
End Function

</SCRIPT>
</HEAD>

<BODY>

  <OBJECT id=Dlg classid='CLSID:3050F4E1-98B5-11CF-BB82-00AA00BDCE0B' width=0 height=0></OBJECT>

  <Button id=Go>Open File</Button>
  <Button OnClick='QuitScript()'>Exit</Button>

  <span id = "DataArea"></span>
  <span id = "PicArea"></span>

</BODY>
</HTML>