'Script Copyright  2012 Ryan Marshall (Skarn)
'All Rights Reserved

pixelFontFactor = System.ScreenHeight / 100

'User variables for developers to be changed - do NOT recommend anything else be changed in this script library
debugActive = False				'-if true when a debug() function is called will show the debug text object

debug_objname = "dxDebug"		'define the text object to behave as a debug display
launcher_objname = "dxScriptor"	'define the DesktopX shortcut object to behave as a file launcher
sounder_objname = "conPlayer"	'define the DesktopX object which contains sound states
mplayer_objname = "dxMPlayer"	'define the DesktopX object which is a media player

'End User variables
'=============================================================================================================
'[AUTOIT] next to any function or command indicates it is an AUTOITv3 reliant function.
'Enables easy finding of AUTOIT dependant areas of script for alternate method swapping later.

'Global variables and info  - other globals are defined and descripted above the section containing the functions they apply to.
	'- [dependant function] - description of variable
Dim MouseTrakObj	'- [dxMouseTrack(obj)] - holds the object name being tracked - "" if nothing being tracked
Dim MouseTrakX		'- [dxMouseTrack(obj)] - holds the mouse x position relative to object being tracked
Dim MouseTrakY		'- [dxMouseTrack(obj)] - holds the mouse y position relative to object being tracked

'**debugging method: EVERY function calls bugme() on exit - if the Err Object is valid then debug messages are populated.
'=============================================================================================================
'BEGIN SCRIPT LIBRARY

class XLink
	'Class XLink and FStringCat - Fast string concatenation
	'	credit: Alex Turner - http://www.nerds-central.com/
	'	dependent functions: 	[arrJoin]
	Public datum
	Public nextXLink
	
	Private Sub Class_Initialize
	  Set nextXLink=nothing
	  datum=""
	End Sub
End class

class FStringCat
	'Class XLink and FStringCat - Fast string concatenation
	'	credit: Alex Turner - http://www.nerds-central.com/
	'	dependent functions: 	[arrJoin]
	Private sp
	Private ep
	Private l
	Private accum
	
	Private Sub Class_Initialize
		l=0
		accum=""
		Set sp=nothing
	End Sub
	
	Public Sub append(what)
		accum=accum & what
		If len(accum)>2800 Then
			If(sp Is nothing) Then
				Set ep=New XLink
				Set sp=ep
			Else
				Dim oep
				Set oep=ep
				Set ep=New XLink
				Set oep.nextXLink=ep
			End If
			ep.datum=accum
			accum=""
			l=l+1
		End If
	End Sub
	
	Public Function getStr()
		If l=0 Then
			getStr=accum
			Exit Function
		End If
		ep.datum=ep.datum & accum
		
		While l>1 
			Dim ptr
			Set ptr=sp
			Dim nsp
			Set nsp=New XLink
			Dim nep
			Set nep=nsp
			Dim nl
			nl=0
			
			While Not (ptr Is nothing) 
				If  nep.datum=""  Then
					nep.datum=ptr.datum
					nl=nl+1
				Else
					If ptr.datum<>"" Then nep.datum=nep.datum & ptr.datum
					Set nep.nextXLink=New XLink
					Set nep=nep.nextXLink
				End If
				Set ptr=ptr.nextXLink
			Wend
			Set sp=nsp
			Set ep=nep
			l=nl
		Wend
		getStr=sp.datum
	End Function
End class

Sub filEmptyRecycler()
	dim objShell
	set objShell = CreateObject("shell.application")
	set objFolder = objShell.NameSpace(&Ha&)
	set objFolderItem = objFolder.Self
	'Set colVerbs = objFolderItem.Verbs()
	'For each objVerb in colVerbs
	'	MsgBox(objVerb.Name)
	'Next
	'objFolder.InvokeVerb "Empty Recycle &Bin"
	Call objFolderItem.InvokeVerb("Empty Recycle Bin")
End Sub

Sub dxTrueSleep(strObjectName)
	If DesktopX.IsObject("dxEdit_script") Then
		DesktopX.Object("dxEdit_script").Sleep 5
	End If
	DesktopX.Object("dxScriptor").Sleep 5
	DesktopX.Object(strObjectName).Sleep 5
End Sub

'script extensions
Sub vbsInclude(sInstFile)
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	Set f = oFSO.OpenTextFile(sInstFile)
	s = f.ReadAll
	f.Close
	ExecuteGlobal s
End Sub

'registry functions
Sub regWrite(rootkey,key,keyData)
	'rootkey should have a / terminator
	Set objShell = CreateObject("WScript.Shell")
	
	objShell.RegWrite rootkey & key, 1, "REG_SZ"
	objShell.RegWrite rootkey & key, keyData, "REG_SZ"
End Sub

Function regRead(rootkey,key)
	On Error Resume Next
	Set objShell = CreateObject("WScript.Shell")
	
	regRead = objShell.RegRead(rootkey&key)
	If Err.Number <> 0 Then
		regRead = False
		Err.Clear
	End If
End Function

Sub dxLabels(onOff)
	Msgbox("label")
	If onOff = 1 then
		For each obj in DesktopX.GroupObjects("txtLabels")
			obj.Delete
		Next
		count = 0
		For each obj in DesktopX.Objects
			If obj.ParentName = "" Then
				DesktopX.Object("txtLabel").Clone "txtLabel" & count,obj.Left,obj.Top
				DesktopX.Object("txtLabel" & count).Text = obj.Name & ":" & obj.Comments
				DesktopX.Object("txtLabel" & count).Group = "txtLabels"
				count = count + 1
			End If
		Next
	Else
		For each obj in DesktopX.GroupObjects("txtLabels")
			obj.Delete
		Next
	End If
End Sub

'xml functions
Function xmlLoad(strXML)
	Set xmlLoad = CreateObject("Microsoft.XMLDom")
	xmlLoad.loadXML(strXML)
End Function

Function xmlLoadFile(strXMLPath)
	Set xmlLoadFile = CreateObject("Microsoft.XMLDom")
	Call xmlLoadFile.setProperty("SelectionLanguage", "XPath")
	xmlLoadFile.load(strXMLPath)
End Function

Function xmlNew(strXMLFilePath)
	Set xmlNew = CreateObject("Microsoft.XMLDom")
	Call xmlNew.Save(strXMLFilePath)
End Function

'zip functions
Function zipAddFileToZip (strZipFilePath, strFilePath)
	On Error Resume Next
	Set oApp = createobject("Shell.Application")
	Call oApp.NameSpace(strZipFilePath).CopyHere(strFilePath)
End Function

Function zipCreate(strZipFilePath)
	On Error Resume Next
	Set fso = CreateObject("Scripting.FileSystemObject")
	Set fp = fso.OpenTextFile(strZipFilePath, 2, True )
	fp.Write Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, 0)
	fp.Close
	Set fso = Nothing
End Function

Function zipAddFolderToZip (strZipFilePath, strFolderPath)
	Set oApp = CreateObject("Shell.Application")
	Set oFolder = oApp.NameSpace(strFolderPath)
	If Not oFolder Is Nothing Then
		oApp.NameSpace(strZipFilePath).CopyHere oFolder.Items
	End If
End Function

Sub zipUn(strFile,strFolder)
    Set objShell = CreateObject("Shell.Application")
	Set objSource = objShell.NameSpace(strFile & "\").Items
	Set objTarget = objShell.Namespace(strFolder)
    intOptions = 256 '&H400& + &H800& + &H10&
    objTarget.CopyHere objSource,intOptions
    Set objShell = Nothing
End Sub 

'date functions
Function dateDaysMonth(intMonth,intYear)
	Select Case intMonth
		Case 9,4,6,11
			dateDaysMonth = 30
		Case 1,3,5,7,8,9,10,12
			dateDaysMonth = 31
		Case 2
			If (intYear Mod 4 = 0) And (intYear Mod 100 <> 0) Or (intYear Mod 400 = 0) Then
				dateDaysMonth = 29
			Else
				dateDaysMonth = 28
			End If
	End Select
End Function

'DesktopX specific functions
Function dxGUID()	'generates a GUID
	Set TypeLib = CreateObject("Scriptlet.TypeLib") 
	dxGUID = Left(CStr(TypeLib.Guid), 38) 
	Set TypeLib = Nothing 
End Function

Function dxObjectMenu(obj)
	objType = ""
	objTypes = paramGet(obj.Name,"type")
	If objTypes <> false then
		arrObjTypes = split(objTypes,",")
		objType = arrObjTypes(1)
	End If
	
	Dim menu
	Set menu = DesktopX.CreatePopupMenu
	menu.AppendMenu 0, 32, "name:" & obj.Name
	menu.AppendMenu 0, 30, "x: " & obj.Left
	menu.AppendMenu 0, 31, "y: " & obj.Top
	menu.AppendMenu 0, 33, "Comments"
	
	menu.AppendMenu 0 + &H00000002 + &H00000001, 999, "w: " & obj.Width
	menu.AppendMenu 0 + &H00000002 + &H00000001, 999, "h: " & obj.Height
	
	menu.AppendMenu 0 + &H00000020, 1, "Resize"
	menu.AppendMenu 0, 2, "Clone"
	menu.AppendMenu 0, 3, "Replace"
	menu.AppendMenu 0, 4, "Destroy"
	If obj.Text <> "" Then
		menu.AppendMenu 0 + &H00000020, 10, "Font"
		menu.AppendMenu 0, 11, "Text"
		
	End If
	menu.AppendMenu 0 + &H00000020, 20, "Opacity"
	menu.AppendMenu 0 + &H00000020, 90, "DX menu"
	menu.AppendMenu 0, 91, "Bulk Replace"
	
	Dim result
	result = menu.TrackPopupMenu(0, System.CursorX, System.CursorY)
	dxObjectMenu = True
	Select Case result
		Case 2
			Call dxClone(obj.Name,"","")
		
		Case 1
			origLeft = obj.Left
			origTop = obj.Top
			newWidth = InputBox("Width:","",obj.Width)
			newHeight = InputBox("Height:","",obj.Height)
			If newWidth <> ""  and newHeight <> "" Then
				Call dxResize(obj.Name,CInt(newWidth),CInt(newHeight),1)
			End If
			obj.Left = origLeft
			obj.Top = origTop
		
		Case 3
			
			textToReplace = InputBox("Replace Text:")
			textToReplaceWith = InputBox("with Text:")
			
			Call dxRename(obj,textToReplace,textToReplaceWith)
		
		
			
		Case 4
			Call dxDestroy(obj.Name)
		
		Case 10
			Call dxTextFontSet(obj,frmFontSelect(obj.Name))
		
		Case 11
			newText = InputBox("Text","DesktopX",obj.Text)
			If obj.Text <> "" Then
				obj.Text = newText
			End If
		Case 20 
			newOpacity = InputBox("Enter opacity:","Set opacity",obj.Opacity)
			obj.Opacity = newOpacity
			
		Case 30
			newX = InputBox("Enter new X position:","Set X",obj.Left)
			obj.Left = newX
		Case 31
			newY = InputBox("Enter new Y position:","Set Y",obj.Top)
			obj.Top = newY
		
		Case 32
			newName = InputBox("Enter new Name:","Set Name",obj.Name)
			obj.Name = newName
		
		Case 33
			newComments = InputBox("Enter new Name:","Set Name",obj.Comments)
			obj.Comments = newComments
		Case 90
			dxObjectMenu = False
		
		Case 91
			prop = InputBox("Property:")
			textToReplace = InputBox("Replace Text:")
			textToReplaceWith = InputBox("with Text:")
			Call dxRenameBulk(prop,textToReplace,textToReplaceWith)
		
		Case 0
			dxObjectMenu = True
	End Select
End Function

Function dxObjectAtPos(x,y,objParentName)
	dxObjectAtPos = False
	Set objParent = DesktopX.Object(objParentName)
	For each objChild in objParent.Children
		objX = objChild.Left
		objY = objChild.Top
		objWidth = objChild.Width
		objHeight = objChild.Height
		If x >= objX and x <= objX+objWidth and y>=objY and y <= objY + objHeight Then
			dxObjectAtPos = objChild.Name
			Exit For
		End If
	Next
End Function

Sub dxRenameBulk(prop,replaceTxt,withTxt)
	For each obj in DesktopX.Objects
		Execute("origValue = obj." & prop)
		Execute("newValue = Replace(origValue,replaceTxt,withTxt)")
		'msgbox(origValue & newValue)
		Execute("obj." & prop & " = """ & newValue & """")
	Next
End Sub

Sub dxRename(obj,textToReplace,textToReplaceWith)
	For each objChild in obj.Children
		objChild.Name = Replace(objChild.Name,textToReplace,textToReplaceWith)
	Next
	
	obj.Name = Replace(obj.Name,textToReplace,textToReplaceWith)
End Sub

Function dxRealPos(obj)
	'RealPos(obj)
	'obj = DesktopX Object Model
	'returns string x,y of objects position relative to screen
	'useful for mouse detection routines using cursorx and cursory
	Dim x,y
	x=obj.Left
	y=obj.Top
	Set objin = obj
	Do While DesktopX.IsObject(objin.ParentName) = True
		If DesktopX.Object(objin.Name).Child = True Then
			x = x + DesktopX.Object(objin.ParentName).Left
			y = y + DesktopX.Object(objin.ParentName).Top
		End If
		Set objin = DesktopX.Object(objin.ParentName)
	Loop
	dxRealPos = Array(x,y)
	
	Set objin = Nothing
End Function

Function dxRealPosRight(obj)
	'returns string x,y of objects right position relative to screen
	Dim x
	x=obj.Width
	Set objin = obj
	Do While DesktopX.IsObject(objin.ParentName) = True
		If DesktopX.Object(objin.Name).Child = True Then
			x = x + DesktopX.Object(objin.ParentName).Left
		End If
		Set objin = DesktopX.Object(objin.ParentName)
	Loop
	dxRealPosRight = x
	
	Set objin = Nothing
End Function

Sub dxDelObj(objname)
	'fire and forget desktopX object delete - will only delete if it exists and won't have error if it doesn't.
	If DesktopX.IsObject(objname) Then
		DesktopX.Object(objname).Delete
	End If
End Sub

Function dxMouseTrack(obj)									'not yet implemented
	
End Function

Sub dxFocus													'[AUTOIT]
	'Set oAutoIt = CreateObject("AutoItX3.Control")
	'Call oAutoIt.Opt("WinTitleMatchMode",4)
	'Call oAutoIt.WinActivate("[TITLE:Program Manager; CLASS:DXDesk]","")
End Sub

Sub dxHideGroup(groupname)
	'hides all objects in a desktopx group
	For each obj in DesktopX.GroupObjects(groupname)
		obj.Visible = False
	Next
End Sub

Sub dxShowGroup(groupname)
	'shows all objects in a desktopx group
	For each obj in DesktopX.GroupObjects(groupname)
		obj.Visible = True
	Next
End Sub

Function dxGroupList(groupname)
	'returns a comma delimited string of all the names of all objects in a desktopx group
	dxGroupList = ""
	For each obj in DesktopX.GroupObjects(groupname)
		dxGrouplist = dxGroupList & obj.Name & ","
	Next
	If dxGroupList ="" then exit function
	dxGroupList = Left(dxGroupList,Len(dxGroupList)-1)
End Function

Function dxGroupListPlus(groupName)
	'returns a comma delimited string of all the names of all objects in a desktopx group and their children
	dxGroupListPlus = ""
	For each obj in DesktopX.GroupObjects(groupname)
		dxGroupListPlus = dxGroupListPlus & obj.Name & ","
		For each childObj in obj.Children
			dxGroupListPlus = dxGroupListPlus & childObj.Name & ","
		Next
	Next
	If dxGroupListPlus ="" then exit function
	dxGroupListPlus = Left(dxGroupListPlus,Len(dxGroupListPlus)-1)
End function

Sub dxTextFontSet(obj,params)
	'uses result from genericFormFont and applies to DesktopX object 'obj'
	fontArr = Split(params,",")
	obj.SetFont fontArr(0), fontArr(1), fontArr(2), fontArr(3), fontArr(4), fontArr(5), 0
	obj.TextColor = fontArr(6)
	obj.TextBorder = fontArr(7)
	If fontArr(7) Then
		obj.TextBorderColor = fontArr(8)
	End If
End Sub

Function dxSetPropertyAll(objList,prop,value)					
	'sets a property specified by prop to value for all desktopx objects in objList by name
	objArr = split(objList,",")
	For a = 0 to arrUBound(objArr)
		If DesktopX.IsObject(objArr(a)) then
			Set obj = DesktopX.Object(objArr(a))
			If lCase(prop) = "picture" Then
				Execute("obj.States("""")." & prop & " = " & value)
			Else
				Execute("obj." & prop &" = " & value)
			End If
		End If
	Next
End Function

Function dxOnTop(objList)
	objArr = split(objList,",")
	For a = 0 to arrUBound(objArr)
		If DesktopX.IsObject(objArr(a)) then
			Set obj = DesktopX.Object(objArr(a))
			obj.OnTop
		End If
	Next
End Function

Function dxSetGroup(obj,groupName)
	obj.Group = groupName
	For each child in obj.Children
		Call dxSetGroup(child,groupName)
	Next
End Function

Sub dxDestroy(objName)											'appears to work stable now
	'On Error Resume Next
	If DesktopX.IsObject(objName) = False Then
		Exit Sub
	End If
	
	Set obj = DesktopX.Object(objName)
	If Err.Number <> 0 then
		Err.Clear
		Exit Sub
	End If
	
	'get a list of children
	childList = ""
	For each objChild in DesktopX.Object(objName).Children
		childList = childList & objChild.Name & ","
	Next
	If childList <> "" Then
		childList = Left(childList,Len(childList)-1)
		childArr = Split(childList,",")
		For a = 0 to Ubound(childArr)
			Call dxDestroy(childArr(a))
		Next
	End If
	
	If DesktopX.IsObject(objName) Then
		obj.Delete
	End If
End Sub

Function dxClone(objName,parentName,rndName)					'appears to work stable now
	'this function will clone an object and all it's children.
	'it does a 'perfect' clone.
	'you would not want to create function to use this cloned object or it's children to be based on the name
	'I utilise my params function to give the objects a 'second name'.
	'it will return the object name of the equivilent cloned object that was originally requested to be called.
	'clones are given a "_#" id number, and it's children accordingly.
	'however, in the event a child would have a name that already exists, all subsequent objects cloned will have a new id number.
	'it is assumed that this is ok to do, and that the idea is to reference the original object cloned.
	
	'provides a 'Clone all' method in dxscript that desktopX doesn't currently have itself.
	If rndName = "" Then
		rndName = 0
	End If
	While DesktopX.IsObject(objName&"_"&rndName)
		rndName = rndName + 1
	Wend
	
	DesktopX.Object(objName).Clone objName&"_"&rndName,DesktopX.Object(objName).Left,DesktopX.Object(objName).Top
	
	'assign it to it's parent
	If parentName = "" Then
		parentName = DesktopX.Object(objName).ParentName
	End If
	
	'msgBox(parentName)
	DesktopX.Object(objName&"_"&rndName).Parent = DesktopX.Object(parentName)
	
	DesktopX.Object(objName & "_" & rndName).Move DesktopX.Object(objName).Left,DesktopX.Object(objName).Top
	'get a list of it's children
	For Each objChild In DesktopX.Object(objName).Children
		If objChild.ParentName = objName Then
			childList = childList & objChild.Name &","
		End If
	Next
	
	'this will only clone children if there are children
	childArr = Split(childList,",")
	For a = 0 To UBound(childArr)-1
		Call dxClone(childArr(a),objName&"_"&rndName,rndName)
	Next
	
	Set dxClone = DesktopX.Object(objName&"_"&rndName)
End Function

Function dxResize(strObjName,width,height,coordStyle)			'needs to be updated to remove param dependency
	Dim intW
	Dim intH
	Dim objImage
	Dim hwRatio
	Dim whRatio
	Dim obj
	Dim scaleType
	Dim newW
	Dim newH
	Dim newX
	Dim newY
	Dim xScaleFactor
	Dim yScaleFactor
	Dim childList
	Dim childNewWidthP
	Dim childNewHeightP
	Dim arrChildList
	
	Set obj = DesktopX.Object(strObjName)
	
	If coordStyle = 0 then
		intW = System.ScreenWidth * width / 100
		intH = System.ScreenHeight * height / 100
	Else
		intW = width
		intH = height
	End If
	
	scaleType = paramGetIndex(obj.Name,"scale",1)
	If obj.FontName = "" Then
		Set objImage = DesktopX.Object("dxImage")
		objImage.Picture = obj.Picture
		hwRatio = obj.Height/obj.Width
		whRatio = obj.Width/obj.Height
		Select Case scaleType
			Case "00"
				newW = obj.Width
				newH = obj.Height
			
			Case "01"
				newH = intH
				newW = newH * whRatio
			
			Case "10"
				newW = intW
				newH = newW * hwRatio
			
			Case "11"
				newW = intW
				newH = intH
		
		End Select
		xScaleFactor = newW / obj.Width
		yScaleFactor = newH / obj.Height
		
		obj.Width = newW
		obj.Height = newH
	Else
		hwRatio = obj.Height/obj.Width
		whRatio = obj.Width/obj.Height
		'xScaleFactor = yScaleFactor
		Select Case scaleType
			Case "00"

			Case "01"
				yScaleFactor = intH / obj.Height
				obj.SetFont obj.FontName, CInt(obj.FontSize * yScaleFactor), 0, 0, 0, 0, 0
			
			Case "10"
				newW = intW
				obj.Width = newW
				
			Case "11"
				newW = intW
				yScaleFactor = intH / obj.Height
				obj.Width = newW
				obj.SetFont obj.FontName, CInt(obj.FontSize * yScaleFactor), 0, 0, 0, 0, 0
		End Select
	End If
	
	
	childList = ""
	For Each objChild In obj.Children
		If objChild.ParentName = obj.Name Then
			childList = childList & objChild.Name & ","
		End If
	Next
		
	If childList <> "" Then
		arrChildList = split(childList,",")
		For a = 0 To UBound(arrChildList)-1
			Set objChild = DesktopX.Object(arrChildList(a))
			childNewWidth = objChild.Width*xScaleFactor
			childNewHeight = objChild.Height*yScaleFactor
			
			'position first
			positionType = paramGetIndex(objChild.Name,"scale",2)
			If isNull(positionType) Then positionType = "11"
			Select Case positionType
				Case "00"
					newX = objChild.Left
					newY = objChild.Top
					
				Case "01"
					If objChild.Child = false then
						newX = obj.Left + yScaleFactor * (objChild.Left - obj.Left)
						newY = obj.Top + yScaleFactor * (objChild.Top - obj.Top)
					Else
						newX = yScaleFactor * objChild.Left
						newY = yScaleFactor * objChild.Top
					End If
				Case "10"
					If objChild.Child = false then
						newX = obj.Left + xScaleFactor * (objChild.Left - obj.Left)
						newY = obj.Top + xScaleFactor * (objChild.Top - obj.Top)
					Else
						newX = xScaleFactor * objChild.Left
						newY = xScaleFactor * objChild.Top
					End If
				Case "11"
					If objChild.Child = false then
						newX = obj.Left + xScaleFactor * (objChild.Left - obj.Left)
						newY = obj.Top + yScaleFactor * (objChild.Top - obj.Top)
					Else
						newX = xScaleFactor * objChild.Left
						newY = yScaleFactor * objChild.Top
					End If
			End Select
		
			objChild.Left = newX
			objChild.Top = newY
			
			'resize
			Call dxResize(arrChildList(a),childNewWidth,childNewHeight,1)
			
		Next
	End If
End Function

Function dxChildList(objName)
	dxChildList = ""
	Set obj = DesktopX.Object(objName)
	For each objChild in obj.Children
		dxChildList =  dxChildList & objChild.Name & ","
	Next
	If dxChildList <> "" Then
		dxChildList = Left(dxChildList,Len(dxChildList)-1)
	End If
End Function

Function dxChildListPlus(obj)
	childList = ""
	For each child in obj.Children
		childList = childList & child.Name & "," & dxChildListPlus(child)
	Next
	
	If childList <> "" Then
		childList = Mid(childList,1,Len(childList)-1)
	End If
	
	dxChildListPlus = childList
End Function

Function dxIsVisible(obj)
	If obj.Visible = False then
		dxIsVisible = False
	Else
		If obj.ParentName <> "" Then
			dxIsVisible = dxIsVisible(DesktopX.Object(obj.ParentName))
		Else
			dxIsVisible = True
		End If
	End If
End Function

Function dxParentList(obj,strParentList)
	If obj.ParentName <> "" Then
		strParents = dxParentList(DesktopX.Object(obj.ParentName),obj.ParentName)
		dxParentList = strParents & "," & strParentList
	Else
		dxParentList = strParentList
	End If
	If dxParentList <> "" then
		dxParentList = Left(dxParentList,Len(dxParentList)-1)
	End If
End Function

'imageMagick functions
Function imShear(inputImagePath,outputImagePath,xShear,yShear)
	Set img = CreateObject("ImageMagickObject.MagickImage.1")
	img.Convert inputImagePath,"-background","transparent","-shear",xShear & "x" & yShear,"png32:" & outputImagePath
	imShear = outputImagePath
End Function

Function imDistort(inputImagePath,outputImagePath,distortParams)
	Set img = CreateObject("ImageMagickObject.MagickImage.1")
	Call img.Convert(inputImagePath,"-resize","640x480!","-virtual-pixel","transparent","-matte","-mattecolor","transparent","-background","transparent","-distort","perspective",distortParams,"png32:" & outputImagePath)
	imDistort = outputImagePath
End Function

'custom vbScript functions
Function iif(psdStr, trueStr, falseStr)
  If psdStr Then
    iif = trueStr
  Else 
    iif = falseStr
  End If
End Function

Function min(A)
	'returns the minimum value out of array A
	minArray = A(0)
	For I = LBound(A) + 1 To UBound(A)    
		If A(I) < minArray Then 
			minArray = A(I)
		End If
	Next
	min = minArray
End Function

Function max(A)
	'returns the minimum value out of array A
	maxArray = A(0)
	For I = LBound(A) + 1 To UBound(A)    
		If A(I) > maxArray Then 
			maxArray = A(I)
		End If
	Next
	max = maxArray
End Function

Function YesNo(question,title)
	YesNo = MsgBox(question,4,title)
	If YesNo = 6 then
		YesNo = "y"
	Else
		YesNo = "n"
	End If
End Function

function txtFindAndRead(strFind,strSearch,intReadChars,blnReadToCR)
	txtFindAndRead = False
	foundPos = Instr(1,strSearch,strFind)
	If foundPos > 0 then
		If blnReadToCR = true then
			strRemaining = Mid(strSearch,foundPos+Len(strFind),Len(strSearch))
			arrStrRemaining = split(strRemaining,chr(13))
			txtFindAndRead = arrStrRemaining(0)
		end If
	End If
End Function

'FileSystem functions
Sub filRun(p_path,params,wait)								'[AUTOIT]
	'uses AutoIt activex to run a program with parameters
	'wait = False/True indicates whether script is paused until program is closed.
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	Set oFile = oFSO.GetFile(p_path)
	working_path = oFSO.GetParentFolderName(oFile.Path)
	Set oAutoIt = CreateObject("AutoItX3.Control")
	oAutoIt.RunAsSet "Skarn","3r5m-skarn","a2108b",0
	If wait = True then
		'Call oAutoIt.ShellExecuteWait("""" & p_path & """ " & params,working_path)
		Call oAutoIt.RunWait("""" & p_path & """ " & params, working_path,oAutoIt.SW_HIDE)
	Else
		Call oAutoIt.Run("""" & p_path & """ " & params,working_path)
	End If
End Sub

Sub filRun2(p_path,params)									'simple FSO run method - hardly ever works
	Set WshShell = CreateObject("WScript.Shell")
	'Set oFSO = CreateObject("Scripting.FileSystemObject")
	MsgBox(p_path)
	WshShell.Run """" & p_path & """"
End Sub

Sub filRun3(p_path,params)									'DesktopX object launcher method
	'If DesktopX.IsObject(launcher_objname) then
	'	set launcher = DesktopX.Object(launcher_objname)
		Object.Command = p_path
		Object.CommandParams = params
		Object.ExecuteCommand
		Object.Command = ""
	'End If
End Sub

Function filReadText(sourcefile)
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	Set objFile = oFSO.OpenTextFile(sourcefile)
	filReadText = objFile.ReadAll()
	objFile.Close
End Function

Function filWriteText(strFileName,strText)
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	Set objFile = oFSO.CreateTextFile(strFileName,true)
	Call objFile.Write(strText)
	objFile.Close
End Function

Function filWriteLine(sourcefile,strLine)
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	Set objFile = oFSO.OpenTextFile(sourcefile,8)
	Msgbox(strLine)
	Call objFile.WriteLine(strLine)
	objFile.Close
End Function

Function filFileCopy(sourcefile,destfolder,destname)
	'copies a file to destfolder, and will rename to destname if specified
	'destname = "" will just copy file with it's original name
	'returns file path of copied file
	If sourceFile = "" Then filFileCopy = False: Exit Function
		
	On Error Resume Next
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	If oFSO.FileExists(sourcefile) = False Then filFileCopy = False: Exit Function
		
	If destname = "" Then
		destname = oFSO.GetFileName(sourcefile)
	End If
	
	oFSO.CopyFile sourcefile , destfolder & "\" & destname, true
	filFileCopy = destfolder & "\" & destname
	
	If Err.Number <> 0 Then
		filFileCopy = False
		Err.Clear
	End If
End Function

Function filGetFileName(sourceFile)
	'returns the 'end' part of a full path filename e.g. c:\test.txt returns test.txt
	If sourceFile = "" Then filGetFileName = False: Exit Function
		
	On Error Resume Next
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	If oFSO.FileExists(sourcefile) = False Then filGetFileName = False: Exit Function
	
	filGetFileName = oFSO.GetFileName(sourcefile)
	
	If Err.Number <> 0 Then
		filGetFileName = False
		Err.Clear
	End If
End Function

Function filGetExtensionName(sourceFile)
	'returns the 'end' part of a full path filename e.g. c:\test.txt returns test.txt
	If sourceFile = "" Then filGetExtensionName = False: Exit Function
		
	On Error Resume Next
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	If oFSO.FileExists(sourcefile) = False Then filGetExtensionName = False: Exit Function
	
	filGetExtensionName = oFSO.GetExtensionName(sourcefile)
	
	If Err.Number <> 0 Then
		filGetExtensionName = False
		Err.Clear
	End If
End Function

Function filGetBaseName(sourceFile)
	'returns the 'end' part of a full path filename e.g. c:\test.txt returns test.txt
	If sourceFile = "" Then filGetBaseName = False: Exit Function
		
	On Error Resume Next
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	If (oFSO.FileExists(sourcefile) Or oFSO.FolderExists(sourcefile)) = False Then 
		filGetBaseName = False
		Exit Function
	End If
	filGetBaseName = oFSO.GetBaseName(sourcefile)
	If filGetBaseName = "" Then
		filGetBaseName = oFSO.GetDriveName(sourcefile)
	End If
	
	If Err.Number <> 0 Then
		filGetBaseName = False
		Err.Clear
	End If
End Function

Function filBrowseFile(path)
	'Simple version - *.* filter
	'opens a user dialog for selecting a file same as windows built in one
	'returns the filepath of the file selected
	'path = the initial directory being browsed (path = "" starts at c:\)
	On Error Resume Next
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	If oFSO.FolderExists(path) = False Then path = "" ':filBrowseFile = False: Exit Function
	
	Set objDialog = CreateObject("UserAccounts.CommonDialog")
	objDialog.Filter = "All Files|*.*"
	
	If path = "" Then
		objDialog.InitialDir = ""'C:"
	Else
		objDialog.InitialDir = path
	End If
	
	intResult = objDialog.ShowOpen
	If intResult = 0 Then
	    filBrowseFile = False
	Else
	    filBrowseFile = objDialog.FileName
	End If
	
	If Err.Number <> 0 Then
		filBrowseFile = False
		Err.Clear
	End If
End Function

Function filBrowseFolder(path)
	'opens a user dialog for selecting a file same as windows built in one
	'returns the filepath of the file selected
	'path = the initial directory being browsed
	REM Set objDialog = CreateObject("UserAccounts.CommonDialog")
	
	REM objDialog.Filter = "All Folders|*.*"
	REM If path = "" Then
		REM objDialog.InitialDir = "C:"
	REM Else
		REM objDialog.InitialDir = path
	REM End If
	
	REM intResult = objDialog.ShowOpen
	REM If intResult = 0 Then
	    REM filBrowseFolder = False
	REM Else
	    REM filBrowseFolder = objDialog.FileName
	REM End If
	Const WINDOW_HANDLE = 0
	Const SHOW_EDITBOX = &H0010
	Const VALIDATION = &H0020
	Const DESKTOP = 0
	Set objShell = CreateObject("Shell.Application")
	Set objFolder = objShell.BrowseForFolder(WINDOW_HANDLE, _
	   "Please select a folder", _
	   SHOW_EDITBOX + VALIDATION, DESKTOP)
	If objFolder Is Nothing Then
	   filBrowseFolder = False
	Else
	   filBrowseFolder = objFolder.Self.Path
	End If
End Function

Function filCreateFolder(folderpath)
	'create a folder
	'returns True if successful, False if not
	On Error Resume Next
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	Set fldr = oFSO.CreateFolder(folderpath)
	
	If Err.Number <> 0 Then
		filCreateFolder = False
		Err.Clear
		Exit Function
	Else	
		filCreateFolder = True
		Exit Function
	End If
End Function

Function filCreateFolderPath(folderpath)
	On Error Resume Next
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	
	arrPath = split(folderpath,"\")
	buildPath = arrPath(0) & "\"
	For a = 1 to arrUBound(arrPath)
		buildPath = buildPath  & arrPath(a) & "\"
		If oFSO.FolderExists(buildPath) = False then
			Call oFSO.CreateFolder(buildPath)
		End If
	Next
End Function

Function filFolderList(folderpath,verbose)
	'returns a comma delimited string of all sub folders in a path
	'verbose - True/False - True returns the full path to each folder in the array, False returns just the folder names
	'returns empty string if no sub folders found
	filFolderList = ""
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	'if the folder exists get the list of folders
	'If oFSO.FolderExists(folderpath) Then
		Set objFolder = oFSO.GetFolder(folderpath)
		For Each subFolder In objFolder.SubFolders
			If verbose = True then
				filFolderList = filFolderList & subFolder.Path &"|"
			Else
				filFolderList = filFolderList & subFolder.Name &"|"
			End If
		Next
		
		If filFolderList <> "" Then
			filFolderList = Left(filFolderList,Len(filFolderList)-1)
		End If
	'End If
	
	Set oFSO = Nothing
	Set objFolder = Nothing
End Function

Function filFolderCount(folderpath)
	'returns number of subfolders in a folder
	filFolderCount = 0
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	If oFSO.FolderExists(folderpath) Then
		Set objFolder = oFSO.GetFolder(folderpath)
		filFolderCount = objFolder.SubFolders.Count
	End If
End Function

Function filParentFolder(strPath)
	'returns path to the parent folder of a folder
	On Error Resume Next
	filParentFolder = False
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	filParentFolder = oFSO.GetParentFolderName(strPath)
End Function

Function filFolderParent(folderpath)
	'returns path to the parent folder of a folder
	On Error Resume Next
	filFolderParent = False
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	If oFSO.FolderExists(folderpath) Then
		Set objFolder = oFSO.GetFolder(folderpath)
		filFolderParent = objFolder.ParentFolder.Path
	End If
End Function

Function filFileList(folderpath,filetypes,verbose)
	'returns a comma delimited string of all sub folders in a path
	'can filter by filetypes e.g. exe,txt will only return .exe and .txt files in the list
	'verbose - True/False - True returns the full path to each folder in the array, False returns just the folder names
	'returns empty string if no sub folders found
	filFileList = ""
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	If oFSO.FolderExists(folderpath) Then
		Set objFolder = oFSO.GetFolder(folderpath)
		For Each fil In objFolder.Files
			If filetypes = "" or InStr(Lcase(filetypes),LCase(oFSO.GetExtensionName(fil.Path))) <> 0 then
				If verbose = True then
					filFileList = filFileList & fil.Path &"|"
				Else
					filFileList = filFileList & fil.Name &"|"
				End If
			End If
		Next
		If filFileList <> "" Then
			filFileList = Left(filFileList,Len(filFileList)-1)
		Else
			filFileList = False
		End If
	End If
End Function

Function filFileExists(file)
	'Returns True/False if file exists
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	If oFSO.FileExists(file) Then
		filFileExists = True
	Else
		filFileExists = False
	End If
End Function

Function filFolderExists(file)
	'Returns True/False if file exists
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	If oFSO.FolderExists(file) Then
		filFolderExists = True
	Else
		filFolderExists = False
	End If
End Function

Function filFileMove(sourcefile,destfolder,destname)
	'moves a file to destfolder, and will rename to destname if specified
	'destname - "" will just move file, any other string will rename file to destname on move
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	If destname = "" Then
		destname = oFSO.GetFileName(sourcefile)
	End If
	oFSO.MoveFile sourcefile,destfolder&"\"&destname
End Function

Function filDelete(sourcefile)
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	If oFSO.FileExists(sourcefile) Then
		oFSO.DeleteFile sourcefile
	End If
End Function

Function filFolderDelete(sourcefolder)
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	If oFSO.FolderExists(sourcefolder) Then
		oFSO.DeleteFolder sourcefolder
	End If
End Function

Function filDrivelist(withDetail)
	set fso = CreateObject("Scripting.FileSystemObject")
	Set fsoDrives = fso.Drives

	For Each fsoDrive In fsoDrives
		If withDetail = True then
			sDrive = sDrive & "Drive " & fsoDrive.DriveLetter & ": "
			Select Case fsoDrive.DriveType
			   Case 0: sDriveType = "Unknown"
			   Case 1: sDriveType = "Removable Drive"
			   Case 2: sDriveType = "Fixed Disk"
			   Case 3: sDriveType = "Remote Disk"
			   Case 4: sDriveType = "CDROM Drive"
			   Case 5: sDriveType = "RAM Disk"
			End Select

			sDrive = sDrive & sDriveType & "|"
		Else
			sDrive = sDrive & fsoDrive.DriveLetter & ":" & "|"
		End If
	Next
	Set fsoDrives = Nothing
	filDrivelist = sDrive
End Function

'process functions
Function procPriority(strProcess,strPriority)
	REM Select Case strPriority
		REM Case "low"
			REM PRIO = 32768
			
		REM Case "normal"
			REM PRIO = 64
	REM End Select
	
	REM strComputer = "."
	REM Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
	REM Set colProcesses = objWMIService.ExecQuery("Select * from Win32_Process Where Name = " & strProcess & "'")
	REM For Each objProcess in colProcesses
		REM objProcess.SetPriority(PRIO) 
	REM Next
End Function

Function procRunning(processname)
	'returns True if a process matching processname is running
	'processname = the process to check if running.
	Set WshShell = CreateObject("WScript.Shell")
	Set locator = CreateObject("WbemScripting.SWbemLocator")
	Set service = locator.ConnectServer()
	Set props = service.ExecQuery("select name, description from Win32_Process where name = '"&processname&"'")
	
	If props.count>0 Then
		procRunning = True
	Else
		procRunning = False
	End If
End Function

Function procRunningProcesses()
	Dim objWMIService, objProcess, colProcess
	Dim strComputer, strList

	strComputer = "."

	Set objWMIService = GetObject("winmgmts:" _
	& "{impersonationLevel=impersonate}!\\" _ 
	& strComputer & "\root\cimv2") 

	Set colProcess = objWMIService.ExecQuery _
	("Select * from Win32_Process")

	For Each objProcess in colProcess
		strList = strList & "|" & _
		objProcess.Name
	Next
	procRunningProcesses = strList
End Function

Function procKillProcess(strProcess)
	strComputer = "."
	Set objWMIService = GetObject("winmgmts:" _
		& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

	Set colProcessList = objWMIService.ExecQuery _
		("Select * from Win32_Process Where Name = '" & strProcess & "'")

	For Each objProcess in colProcessList
		objProcess.Terminate()
	Next
End Function

'web functions
Function webGetHTML(strWebURL,arrHeader,async)
	Set http = CreateObject("Microsoft.XmlHttp")
	http.open "GET", strWebURL, async
	For headerCount = 0 to UBound(arrHeader) step 2
		strKey = arrHeader(headerCount)
		strValue = arrHeader(headerCount + 1)
		Call http.setRequestHeader(strKey,strValue)
	Next
	http.send ""
	
	If Not async Then
		webGetHTML = Array(http.responseText,http.getAllResponseHeaders)
	Else
		Set webGetHTML = http
	End If
End Function

Function webPostHTML(strWebURL,strBody,arrHeader,async)
	Set http = CreateObject("Microsoft.XmlHttp")
	http.open "POST", strWebURL, async
	For headerCount = 0 to UBound(arrHeader) step 2
		strKey = arrHeader(headerCount)
		strValue = arrHeader(headerCount + 1)
		Call http.setRequestHeader(strKey,strValue)
	Next
	http.send(strBody)
	
	If Not async Then
		webPostHTML = Array(http.responseText,http.getAllResponseHeaders)
	Else
		Set webPostHTML = http
	End If
End Function

Function webPutHTML(strWebURL)
	Set http = CreateObject("Microsoft.XmlHttp")
	http.open "PUT", strWebURL, FALSE
	http.send ""
	webPutHTML = http.responseText
End Function

'number functions
Function numPadZeroes(intNumber,intZeroes)
	For a = 1 to intZeroes
		If intNumber < 10 ^ a then
			numPadZeroes = string(a,"0") & intNumber
		Else
			numPadZeroes = intNumber
		End If
	Next
End Function

'string Array functions (generic delimited)
Function strArraySet(strArray,delim,index,value,create)		'[FStringCat]
	'strArray = comma delimited string array
	'index = string array item index to set value of
	'value = value to set
	'create = True/False - True will cause the string array to be extended to include the index if it doesn't exist. indexes not defined will be filled with ""
	Dim tempArr
	If delim = "" then delim = ","
	If strArray = "" then
		ReDim Preserve tempArr(index)
	Else
		tempArr = Split(strArray,delim)
		tempArr_Bound = UBound(tempArr)
		If index > tempArr_Bound And create = True Then
			ReDim Preserve tempArr(index)
		ElseIf index > tempArr_UBound And create = False Then
			strArraySet = strArray
			Exit Function
		End If
	End If
	tempArr(index) = value
	strArraySet = arrJoin(tempArr,",")
End Function

Function strArrayGet(strArray,delim,indexs)					'[FStringCat]
	'strArray = a string array delimited by the delim character
	'index = string array item index to return value of (commad delimited)
	Dim arrItems,arrIndexs, ts
	If delim = "" then delim = ","
	If strArray = "" then
		strArrayGet = False
	Else
		arrItems = Split(strArray,delim)
		arrIndexs = Split(indexs,",")
		
		Set strCat=New FStringCat
		For Each index In arrIndexs
			strCat.append(arrItems(index) & ",")
		Next
		strCatGet = strCat.getStr()
		strArrayGet = Left(strCatGet,Len(strCatGet)-1)
	End If
End Function

Function strArrayCount(strArray,delim)
	'returns 0 if the strArray passed is "" otherwise gives an integer count of items in a delimited string array
	Dim tempArr
	If delim = "" then delim = ","
	If strArray = "" then
		strArrayCount = 0
	Else
		tempArr = split(strArray,delim)
		strArrayCount = UBound(tempArr)+1
	End If
End Function

Function strArrayDel(strArray,delim,indexs)					'[FStringCat]
	If delim = "" then delim = ","
	If strArray = "" then
		strArrayDel = strArray
	Else
		arrItems = Split(strArray,delim)
		arrIndexs = Split(indexs,",")
		For Each index In arrIndexs
			If index <= UBound(arrItems) Then
				arrItems(index) = "**REMOVE ME**"
			End If
		Next
		
		Set strCat=New FStringCat
		For Each index In arrItems
			If index <> "**REMOVE ME**" Then
				strCat.append(index & ",")
			End If
		Next
		strCatGet = strCat.GetStr()
		strArrayDel = Left(strCatGet,Len(strCatGet)-1)
	End If
End Function

Function strArrayPull(strArray,strElem)
	lenElem = Len(strElem)
	foundAt = Instr(1,strArray,strElem)
	If foundAt > 0 then
		If foundAt > 1 then
			strArrayPull = Replace(strArray,"," & strElem,"")
		ElseIf foundAt + lenElem - 1 = Len(strArray) Then
			strArrayPull = ""
		Else
			strArrayPull = Replace(strArray,strElem & ",","")
		End If
	End If
End Function

'string functions
Function strRepeat(root,delim,num)
	If num = 0 then
		strRepeat = ""
		Exit Function
	End If
	
	ReDim tempArr(num-1)
	For a = 0 to num-1
		tempArr(a) = root
	Next
	strRepeat = arrJoin(tempArr,delim)
End Function

'window control functions
Sub winFocus(process_name,matchmode)						'[AUTOIT]
	Set oAutoIt = CreateObject("AutoItX3.Control")
	Call oAutoIt.Opt("WinTitleMatchMode",matchmode)
	Call oAutoIt.WinActivate(process_name,"")
End Sub

Sub winClose(title)
End Sub

'mouse control functions
Sub mouseClick(x,y,replace)									'[AUTOIT]
	'moves the system mouse to x,y then clicks it.
	'replace = True returns the mouse to it's original position before this function was called
	xorig = System.CursorX
	yorig = System.CursorY
	Set oAutoIt = CreateObject("AutoItX3.Control")
	Call oAutoIt.MouseClick("left",x,y,1,1)
	If replace = True then
		Call oAutoIt.MouseMove(xorig,yorig,1)
	End If
End Sub

'normal Array functions
Function arrJoin(arrayin,joinchar)							'[FStringCat]
	'a faster array joining function than VBScript's default Join function
	'requires FStringCat Class
	On Error Resume Next
	array_size = UBound(arrayin)
	If Err.Number <> 0 Then
		Err.Clear
		Exit Function
	End If
	
	Set strCat=New FStringCat
	For Each item In arrayin
		strCat.append(item & joinchar)
	Next
	
	strCatGet = strCat.GetStr()
	arrJoin = Left(strCatGet,Len(strCatGet)-1)
End Function

Function arrUBound(arrayin)
	'a nicer UBound function for arrays (I think)
	'UBound is often called as a For Next loop paramater
	'But if the array has issues with a UBound call (this happens more often than you might think)
	'this function will return -1 as the UBound - effectively cancels any loop you might use with an array
	'and useful for telling if an array even exists.
	On Error Resume Next
	last = UBound(arrayin)
	If Err.Number > 0 then
		arrUBound = -1
		Err.Clear
	Else
		arrUBound = last
	End If
End Function

'icon extraction
Function extractIconsFromFile(strFile,strOutputDirectory)
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	extractIconsFromFile = False
	If Not objFSO.FolderExists(strOutputDirectory) Then
		Call objFSO.CreateFolder(strOutputDirectory)
	Else
		Set objFolder = objFSO.GetFolder(strOutputDirectory)
		For Each objFile In objFolder.Files
			Call objFile.Delete(True)
		Next
		Set objFolder = Nothing
	End If
	
	strExtension = objFSO.GetExtensionName(strFile)
	strFileName = objFSO.GetFileName(strFile)
	strFileNameRoot = Left(strFileName,Len(strFileName)-Len(strExtension)-1)
	
	Select Case strExtension
		Case "ico","png"
			Call filFileCopy(strFile,strOutputDirectory,strFileName)
			extractIconsFromFile = True
			Exit Function
			
		Case "exe","dll"
			extractIconsFromFile = exeExtractIconsFromPE(strFile,strOutputDirectory)
			Exit Function
			
		Case "lnk"
			Set Shell = CreateObject("WScript.Shell")
			Set link = Shell.CreateShortcut(strFile)
			strFile = link.TargetPath
			extractIconsFromFile = extractIconsFromFile(strFile,strOutputDirectory)
			Exit Function
		
		Case Else
			strRegistryFileType = getFileTypeFromExtension(strExtension)
			iconFile = getIconLocationFromFileType(strRegistryFileType)
			If filFileExists(iconFile) Then
				extractIconsFromFile = extractIconsFromFile(iconFile,strOutputDirectory)
			Else
				extractIconsFromFile = False
			End If
			Exit Function
			
	End Select
End Function

Function getFileTypeFromExtension(strExtension)
	Const HKEY_CLASSES_ROOT = &H80000000
	strComputer = "."
	Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
	strKeyPath = "." & strExtension
	strValueName = ""
	Call oReg.GetStringValue(HKEY_CLASSES_ROOT,strKeyPath,"",dwValue)
	getFileTypeFromExtension = dwValue
End Function

Function getIconLocationFromFileType(strFileType)
	Const HKEY_CLASSES_ROOT = &H80000000
	strComputer = "."
	Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
	strKeyPath = strFileType & "\DefaultIcon"
	strValueName = ""
	

	Call oReg.GetStringValue(HKEY_CLASSES_ROOT,strKeyPath,"",dwValue)
	If Not IsNull(dwValue) Then
		getIconLocationFromFileType = dwValue
	Else
		Call oReg.GetExpandedStringValue(HKEY_CLASSES_ROOT,strKeyPath,"",dwValue)
		getIconLocationFromFileType = dwValue
	End If
	
	If IsNull(dwValue) Then
		getIconLocationFromFileType = False
		Exit Function
	End If
	
	arrIcon = Split(dwValue,",")
	If UBound(arrIcon) = 0 Then
		getIconLocationFromFileType = dwValue
	Else
		getIconLocationFromFileType = arrIcon(0) '& "_" & arrIcon(1)
	End If
End Function

Function exeExtractIconsFromPE(strFilePath,strOutputFolder)
	On Error Resume Next
	exeExtractIconsFromPE = False
	
	Set exeStream = binReadFile(strFilePath)
	If exeStream Is Nothing Then Err.Clear:exeExtractIconsFromPE = False
	
	If exeStream.Size < 100 Then
		Err.Clear:exeExtractIconsFromPE = False:Exit Function
	End If
	
	pos_E_lfanew = binNumberFromBytes(exeStream,60,4)
	str_signature = binStringFromBytes(exeStream,pos_E_lfanew,4)
	If Left(str_signature,2) <> "PE" Then
		Err.Clear:exeExtractIconsFromPE = False:Exit Function
	End If
	int_Machine = binNumberFromBytes(exeStream,pos_E_lfanew+4,2)
	siz_OptionalHeader = binNumberFromBytes(exeStream,pos_E_lfanew+20,2)
	num_Sections = binNumberFromBytes(exeStream,pos_E_lfanew+6,2)
	pos_sectionHeaders = pos_E_lfanew + 24 + siz_OptionalHeader
	blnRSRCFound = False
	For section_count = 1 To num_Sections
		pos_sectionHeader = pos_sectionHeaders + 40*(section_count-1)
		str_sectionName = binStringFromBytes(exeStream,pos_sectionHeader,8)
		If Instr(1,str_sectionName,".rsrc") > 0 Then
			blnRSRCFound = True
			rva_section = binNumberFromBytes(exeStream,pos_sectionHeader+12,4)
			siz_section = binNumberFromBytes(exeStream,pos_sectionHeader+16,4)	
			pos_sectionData = binNumberFromBytes(exeStream,pos_sectionHeader+20,4)
			Exit For
		End If
	Next
	If blnRSRCFound = False Then
		Err.Clear: exeExtractIconsFromPE = False
	End If
	
	Set rsrcDataStream = binExtractBytesAsStream(exeStream,pos_sectionData,siz_section)
	
	num_namedEntries = binNumberFromBytes(rsrcDataStream,12,2)
	num_idEntries = binNumberFromBytes(rsrcDataStream,14,2)
	
	vbAns = 6 'DesktopX.MsgBox("Only high quality icons?",&00000004,"test",Object.Name)
	
	For resEntry_count = 1 to num_namedEntries + num_idEntries
		pos_resEntry = 16 + 8 * (resEntry_count-1)
		str_entryName = binNumberFromBytes(rsrcDataStream,pos_resEntry,4)
		'If Trim(str_entryName) = "14" Then
		'	pos_iconGroups_resEntry = binNumberFromBytes(rsrcDataStream,pos_resEntry+4,4) - 2147483648
		'End If
		If Trim(str_entryName) = "3" Then
			pos_iconResources_resEntry = binNumberFromBytes(rsrcDataStream,pos_resEntry+4,4) - 2147483648
		End If
	Next
	
	'iconResources resEntry
	num_idEntries = binNumberFromBytes(rsrcDataStream,pos_iconResources_resEntry+14,2)
	For icon_resEntry_count = 1 to num_idEntries
		pos_icon_resEntry1 = pos_iconResources_resEntry + 16 + 8 * (icon_resEntry_count-1)
		
		str_entryName = binNumberFromBytes(rsrcDataStream,pos_icon_resEntry1,4)
		pos_icon_resEntry2 = binNumberFromBytes(rsrcDataStream,pos_icon_resEntry1+4,4) - 2147483648
		
		str_entryName2 = binNumberFromBytes(rsrcDataStream,pos_icon_resEntry2 + 16,4)
		pos_icon_resEntry3 = binNumberFromBytes(rsrcDataStream,pos_icon_resEntry2+20,4)
		
		pos_iconRVA = binNumberFromBytes(rsrcDataStream,pos_icon_resEntry3,4)
		siz_iconData = binNumberFromBytes(rsrcDataStream,pos_icon_resEntry3+4,4)		
		pos_iconData = pos_iconRVA - rva_section + pos_sectionData
		
		Set iconDataStream = binExtractBytesAsStream(exeStream,pos_iconData,siz_iconData)
		str_pngHeader = binStringFromBytes(iconDataStream,1,3)
		If str_pngHeader = "PNG" then
			strBaseFileName = filGetBaseName(strFilePath)
			Call iconDataStream.SaveToFile(strOutputFolder & "\" & strBaseFileName & "_" & icon_resEntry_count & ".png",2)
		Else
			iconWidth = binNumberFromBytes(iconDataStream,4,4)
			iconHeight = binNumberFromBytes(iconDataStream,8,4)
			planes = binNumberFromBytes(iconDataStream,12,2)
			bitCount = binNumberFromBytes(iconDataStream,14,2)
			If vbAns = "6" then
				bitCountMin = 0
				iconWidthMin = 32
			End If
			If bitCount >= bitCountMin and iconWidth >= iconWidthMin then
				strInfo = 	"icon: " & icon_resEntry_count & chr(13) & _
							"width: " & iconWidth & chr(13) & _
							"height: " & iconHeight & chr(13) & _
							"planes: " & planes & chr(13) & _
							"bitCount: " & bitCount
				
				Set templateIconStream = binReadFile(Object.Directory & "iconTemplate.ico")
				Call binWriteDecNumber(templateIconStream,6,iconWidth,1,strdebug)
				Call binWriteDecNumber(templateIconStream,7,iconHeight,1,strdebug)
				Call binWriteDecNumber(templateIconStream,10,planes,2,strdebug)
				'bitCount - by setting this to zero, windows figures out bit depth and color count/table usage for itself!
				Call binWriteDecNumber(templateIconStream,12,0,2,strdebug)
				Call binWriteDecNumber(templateIconStream,14,siz_iconData,4,strdebug)
				
				iconDataStream.Position = 0
				bytes_iconDataStream = iconDataStream.Read(-1)
						
				Call binWriteBytes(templateIconStream,22,bytes_iconDataStream)
				strBaseFileName = filGetBaseName(strFilePath)
				Call templateIconStream.SaveToFile(strOutputFolder & "\" & strBaseFileName & "_" & icon_resEntry_count & ".ico",2)
				If Err.Number <> 0 Then Err.Clear: exeExtractIconsFromPE = False
				
			End If
		End If
	Next
	exeExtractIconsFromPE = True
End Function

'binary file functions
Function binNewFile()
	On Error Resume Next
	Set binNewFile = CreateObject("ADODB.Stream")
	binNewFile.Mode = 3	'read/write
	binNewFile.Type = 1	'binary
	Call binNewFile.Open
	If Err.Number <> 0 Then
		Err.Clear:binNewFile = False:Exit Function
	End If
End Function

Function binWriteBytes(adodbStream,fromPos,byteArray)
	oldPosition = adodbStream.Position
	
	Set xmlDom = CreateObject("Microsoft.XMLDOM")
	Set nodeNew = xmlDom.createElement("tmp")
	nodeNew.DataType = "bin.hex"
	nodeNew.NodeTypedValue = byteArray
	'magic!
	byteArray = nodeNew.NodeTypedValue
	
	adodbStream.Position = fromPos
	adodbStream.Write(byteArray)
	adodbStream.Position = oldPosition
	binWriteBytes = True
End Function

Function binReadFile(strFilePath)
	On Error Resume Next
	Set binReadFile = CreateObject("ADODB.Stream")
	binReadFile.Mode = 3	'read/write
	binReadFile.Type = 1	'binary
	Call binReadFile.Open
	Call binReadFile.LoadFromFile(strFilePath)
	If Err.Number <> 0 then
		Err.Clear:Set binReadFile = Nothing:Exit Function
	End If
End Function

Function binExtractBytesAsStream(adodbStream,fromPos,numBytes)
	oldPosition = adodbStream.Position
	adodbStream.Position = fromPos
	
	Set binNew = CreateObject("ADODB.Stream")
	binNew.Mode = 3	'read/write
	binNew.Type = 1	'binary
	Call binNew.Open
	Call adodbStream.CopyTo(binNew,numBytes)
	adodbStream.Position = oldPosition
	Set binExtractBytesAsStream = binNew
End Function

Function binWriteDecNumber(adodbStream,fromPos,decNumber,numBytes,strdebug)
	strZeroes = Replace(Space(numBytes * 2)," ","0")
	strHex = Right(strZeroes & Hex(decNumber),numBytes * 2)
	If strdebug = true then
		MsgBox(Hex(decNumber) & "=" & strHex & "=" & decNumber)
	End If
	For byteCount = 1 To Len(strHex) Step 2
		strByte = Mid(strHex,byteCount,2)
		strHexR = strByte & strHexR
	Next
	If strdebug = true then
		MsgBox(strHexR & "=" & decNumber)
	End If
	
	Set xmlDom = CreateObject("Microsoft.XMLDOM")
	Set nodeNew = xmlDom.createElement("tmp")
	nodeNew.DataType = "bin.hex"
	nodeNew.Text = strHexR
	byteArray = nodeNew.NodeTypedValue
	Set nodeNew = Nothing
	Set xmlDom = Nothing
	
	oldPosition = adodbStream.Position
	adodbStream.Position = fromPos
	adodbStream.Write(byteArray)
	adodbStream.Position = oldPosition
	binWriteDecNumber = True
End Function

Function binNumberFromBytes(adodbStream,fromPos,numBytes)
	oldPosition = adodbStream.Position
	adodbStream.Position = fromPos
	byteArray = adodbStream.Read(numBytes)
	For byteArrayPos = 1 To LenB(byteArray)
		valByte = AscB(MidB(byteArray,byteArrayPos,1))
		binNumberFromBytes = binNumberFromBytes + valByte*(256^(byteArrayPos-1))
	Next
	adodbStream.Position = oldPosition
End Function

Function binHexFromBytes(adodbStream,fromPos,numBytes)
	oldPosition = adodbStream.Position
	adodbStream.Position = fromPos
	byteArray = adodbStream.Read(numBytes)
	For byteArrayPos = 1 To LenB(byteArray)
		valByte = AscB(MidB(byteArray,byteArrayPos,1))
		binNumberFromBytes = binNumberFromBytes + valByte*(256^(byteArrayPos-1))
	Next
	MsgBox(CStr(binNumberFromBytes))
	binHexFromBytes = Hex(binNumberFromBytes)
	adodbStream.Position = oldPosition
End Function

Function binStringFromBytes(adodbStream,fromPos,numBytes)
	oldPosition = adodbStream.Position
	adodbStream.Position = fromPos
	byteArray = adodbStream.Read(numBytes)
	For byteArrayPos = 1 To LenB(byteArray)
		valByte = AscB(MidB(byteArray,byteArrayPos,1))
		strByte = Chr(valByte)
		binStringFromBytes = binStringFromBytes & strByte
	Next
	adodbStream.Position = oldPosition
End Function

'audio functions
Function sound(inState)
	'DesktopX sound making system
	'Uses sounder_object desktopx object if it exists and plays a sound by changing the object to the matching inState state.
	'On first use it will create the clones required for multiple channels.
	'On Error Resume Next
	If DesktopX.IsObject(sounder_objname) then
		id = Cint(3*RND())
		sound = id
		If DesktopX.IsObject(sounder_objname & id) then
			For a = 0 to 4
				If DesktopX.ScriptObject(sounder_objname & a).Control.playState = 10 or DesktopX.ScriptObject(sounder_objname & a).Control.playState = 1 then
					Call DesktopX.ScriptObject(sounder_objname & a).playIndex(inState)
					Exit For
				End If
			Next
			REM strSoundFile = "c:\windows\media\" & DesktopX.Object(sounder_objname & id).States(inState).Sound
			REM Set objShell = CreateObject("Wscript.Shell")
			REM strCommand = "c:\windows\system32\mplay32.exe /play " & strSoundFile
			REM objShell.Run strCommand, 7, False

			REM Set oAutoIt = CreateObject("AutoItX3.Control")
			REM Call oAutoIt.SoundPlay(strSoundFile,0)
			REM debug("dxSounder "&id&": playing """&inState&"""")
			'DesktopX.Object(sounder_objname & id).State = inState
			REM 'DesktopX.Object(sounder_objname).State = "z"
		Else
			'debug("dxSounder: initializing")
			For a = 0 To 4
				If DesktopX.IsObject(sounder_objname & a) Then
					DesktopX.Object(sounder_objname & a).Delete
				End If
				Call DesktopX.Object(sounder_objname).Clone(sounder_objname & a,-100,-100)
				DesktopX.Object(sounder_objname & a).Visible = False
			Next
			sound = sound(inState)
		End If
	End If
	'bugme()
End Function

'DesktopX Form functions
' these functions were created to make form creation in DesktopX a little less cluttered and provide some generically common forms.
Function frmValue(frmObject,prefName,returnType)
	If returnType = 0 then			'default
		frmValue = frmObject.Preference(prefName).Value
	End If
	If returnType = 1 then			'string
		frmValue = CStr(frmObject.Preference(prefName).Value)
	End If
	If returnType = 2 then			'number
		If IsNull(frmObject.Preference(prefName).Value) Then
			frmValue = 0
		Else
			frmValue = CInt(frmObject.Preference(prefName).Value)
		End If
	End If
End Function

Function frmSetCaption(frmObject,frmCaption)
	frmObject.Caption = frmCaption
End Function

Function frmAddSlider(frmObject,prefName,prefCaption,prefDesc,prefDefault,prefMin,prefMax,prefTicks)
	On Error Resume Next
	frmObject.AddPreference prefName
	frmObject.Preference(prefName).Type = "slider"
	frmObject.Preference(prefName).DefaultValue = prefDefault
	frmObject.Preference(prefName).Caption = prefCaption
	frmObject.Preference(prefName).Description = prefDesc
	frmObject.Preference(prefName).MinValue = prefMin
	frmObject.Preference(prefName).MaxValue = prefMax
	frmObject.Preference(prefName).Ticks = prefTicks
	
	If Err.Number <> 0 Then
		frmAddSlider = False
		Err.Clear
	Else
		frmAddSlider = True
	End If
End Function

Function frmAddPref(frmObject,prefName,prefType,prefCaption,prefDesc,prefDefault)
	REM "Hidden": No control will be displayed in the Widget properties panel. Hidden is the default type.
	REM "Text": Text box control type.
	REM "Password": Text box with obfuscated characters for password entries.
	REM "Checkbox": Checkbox control. Values for checkboxes are "1" or "0".
	REM "ComboEdit": Editable text combobox control.
	REM "ComboList": Dropdown list combobox control.
	REM "Slider": Slider control. Values for sliders are still in string form.
	REM "File": Edit control with Browse File feature
	REM "Folder": Edit control with Browse Folder feature
	REM "Font": It is a "ComboEdit" preference, but it is automatically filled with available Font names.
	REM "Color": It provides a color picker preference.
	REM "Hotkey": Hotkey selection control. You can directly pass preference value to Object.RegisterHotkey like:
	
	'On Error Resume Next
	frmObject.AddPreference prefName
	frmObject.Preference(prefName).Type = prefType
	frmObject.Preference(prefName).DefaultValue = prefDefault
	frmObject.Preference(prefName).Description = prefDesc
	frmObject.Preference(prefName).Caption = prefCaption
	
	'If Err.Number <> 0 Then
	'	frmAddPref = False
	'	Err.Clear
	'Else
	'	frmAddPref = True
	'End If
End Function

Function frmFontSelect(objName)
	'pass objName = "" to not set default values
	'pass objName = any valid DesktopX Object name to use default values of that text object
	Set frmSetting = DesktopX.CreateForm
	If DesktopX.IsObject(objName) and objName <> "" Then
		Set oText = DesktopX.Object(objName)
	Else
		objname = ""
	End If
	
	frmSetting.AddPreference "FontName"
	frmSetting.Preference("FontName").Type = "Font"
	If objName <> "" Then frmSetting.Preference("FontName").DefaultValue = oText.fontName
	frmSetting.Preference("FontName").Caption = "Font Name"
	
	frmSetting.AddPreference "FontSize"
	frmSetting.Preference("FontSize").Type = "Text"
	If objName <> "" Then frmSetting.Preference("FontSize").DefaultValue = oText.FontSize
	frmSetting.Preference("FontSize").Caption = "Font Size"
	
	frmSetting.AddPreference "FontBold"
	frmSetting.Preference("FontBold").Type = "Checkbox"
	If objName <> "" Then frmSetting.Preference("FontBold").DefaultValue = oText.FontBold
	frmSetting.Preference("FontBold").Caption = "Font Bold"
	
	frmSetting.AddPreference "FontItalic"
	frmSetting.Preference("FontItalic").Type = "Checkbox"
	If objName <> "" Then frmSetting.Preference("FontItalic").DefaultValue = oText.FontItalic
	frmSetting.Preference("FontItalic").Caption = "Font Italic"
	
	frmSetting.AddPreference "FontUnderline"
	frmSetting.Preference("FontUnderline").Type = "Checkbox"
	If objName <> "" Then frmSetting.Preference("FontUnderline").DefaultValue = oText.FontUnderline
	frmSetting.Preference("FontUnderline").Caption = "Font Underline"
	
	frmSetting.AddPreference "FontStrikeout"
	frmSetting.Preference("FontStrikeout").Type = "Checkbox"
	If objName <> "" Then frmSetting.Preference("FontStrikeout").DefaultValue = oText.FontStrikeout
	frmSetting.Preference("FontStrikeout").Caption = "Font Strikeout"
	
	frmSetting.AddPreference "FontColor"
	frmSetting.Preference("FontColor").Type = "Color"
	If objName <> "" Then frmSetting.Preference("FontColor").DefaultValue = oText.TextColor
	frmSetting.Preference("FontColor").Caption = "Font Color"
	
	frmSetting.AddPreference "FontBorder"
	frmSetting.Preference("FontBorder").Type = "Checkbox"
	If objName <> "" Then frmSetting.Preference("FontBorder").DefaultValue = oText.TextBorder
	frmSetting.Preference("FontBorder").Caption = "Font Border"
	
	frmSetting.AddPreference "FontBorderColor"
	frmSetting.Preference("FontBorderColor").Type = "Color"
	If objName <> "" Then frmSetting.Preference("FontBorderColor").DefaultValue = oText.TextBorderColor
	frmSetting.Preference("FontBorderColor").Caption = "Font Border Color"
	
	frmSetting.Caption = objName & " Property: Font"
	
	If frmSetting.Prompt Then
		frmFontSelect = Join(Array(frmSetting.Preference("FontName").Value, frmSetting.Preference("FontSize").Value, frmSetting.Preference("FontBold").Value, frmSetting.Preference("FontItalic").Value, frmSetting.Preference("FontUnderline").Value, frmSetting.Preference("FontStrikeout").Value,frmSetting.Preference("FontColor").Value,frmSetting.Preference("FontBorder").Value,frmSetting.Preference("FontBorderColor").Value),",")
	Else
		frmFontSelect = False
	End If
End Function

Function frmObjectSelect()
	frmObjectSelect = False
	Set frm = DesktopX.CreateForm
	Call frmSetCaption(frm,"dxControls Config")
	Call frmAddPref(frm,"objs","ComboList","Choose Object","","")
	For each obj in DesktopX.Objects
		frm.Preference("objs").AddValue obj.Name
	Next
	
	result = frm.Prompt
	If result = True then
		val = frmValue(frm,"objs",0)
		If val <> "" Then
			frmObjectSelect = val
		End If
	End If
End Function

Function frmFileSelect(defaultValue)
	frmFileSelect = False
	Set frmSetting = DesktopX.CreateForm
	
	frmSetting.AddPreference "Filename"
	frmSetting.Preference("Filename").Type = "File"
	frmSetting.Preference("Filename").Caption = "Type in a filepath or browse for a file."
	If defaultValue <> "" then
		frmSetting.Preference("Filename").DefaultValue = defaultValue
	End If
	
	frmSetting.Caption = "File selector"
	
	If frmSetting.Prompt Then
		frmFileSelect = frmSetting.Preference("Filename").Value
	Else
		frmFileSelect = False
	End If
End Function

'media 
Function media_openFile(strFilePath)
	Set mplayer = DesktopX.ScriptObject(mplayer_objname)
	mplayer.Control.URL = strFilePath
End Function

Function media_getDVDplaylist(dvdLetter,pathType)
	Set mplayer = DesktopX.ScriptObject(mplayer_objname)
	mplayer.Control.settings.autoStart = True
	mplayer.Control.URL = ""
	mplayer.Control.close
	
	If pathType = 0 then
		dvdDrive = "wmpdvd://F?contentdir=" & dvdLetter & "\VIDEO_TS\"
		mplayer.Control.URL = dvdDrive
		mplayer.Control.URL = dvdDrive
		While mplayer.Control.openState <> 6
			Object.Sleep 1000
		Wend
		Set dvdPL = mplayer.Control.currentPlaylist
	Else
		Set dvdDrive = mplayer.Control.cdromCollection.getByDriveSpecifier(dvdLetter)
		Set dvdPL = dvdDrive.Playlist
	End If
	
	For itemNum = 0 to dvdPL.Count-1
		'MsgBox(dvdPL.Item(itemNum).sourceURL)
		strTitles = strTitles & dvdPL.Item(itemNum).sourceURL & ","
		'mplayer.Control.URL = dvdPL.Item(itemNum).sourceURL
		
		'dvdTitles = dvdTitles & "Title " & itemNum & " - " & mplayer.Control.dvdPL.Item(itemNum).getItemInfo("Duration") & ","
	Next
	MsgBox(strTitles)
	arrTitles = split(strTitles,",")
	mplayer.Control.settings.autoStart = True
	For itemNum = 1 to UBound(arrTitles)-1
		mplayer.Control.URL = ""
		mplayer.Control.URL = arrTitles(itemNum)
		
	'	msgbox(arrTitles(itemNum))
		While mplayer.Control.openState <> 13
			Object.Sleep 1000
		Wend
	'
	'	msgbox(mplayer.Control.currentMedia.durationString)
	'	msgbox(mplayer.Control.currentMedia.durationString)
		dvdTitles = dvdTitles & "Title " & itemNum & " - " & mplayer.Control.currentMedia.durationString & ","
	Next
	
	mplayer.Control.close
	media_getDVDplaylist = dvdTitles
End Function

'animation theory sub-system
Dim animDic
Dim animFrameDic
Dim animCount

Sub dxInit()
	Set animDic = CreateObject("Scripting.Dictionary")
	Set animFrameDic = CreateObject("Scripting.Dictionary")
End Sub

Sub animStart(obj,strAnimType,intFrames,intTimer)
	Set dicObjects = CreateObject("Scripting.Dictionary")
	Select Case strAnimType
		Case "fadeIn"
			'add initial object to dicObjects
			intFinalOpacity = obj.Opacity
			intOpacityStep = intFinalOpacity/intFrames
			Call dicObjects.Add(obj.Name,Array(obj,intFinalOpacity,intOpacityStep))
			
			'add all children objects to dicObjects
			arrObjects = Split(dxChildListPlus(obj),",")
			For each strObjectName in arrObjects
				Set objChild = DesktopX.Object(strObjectName)
				If objChild.Visible = True Then
					intFinalOpacity = objChild.Opacity
					intOpacityStep = intFinalOpacity/intFrames
					Call dicObjects.Add(strObjectName,Array(objChild,intFinalOpacity,intOpacityStep))
				End If
			Next
			animCount = animCount + 1
			Call animDic.Add("a" & animCount,Array(dicObjects,intFrames,0))
			Call animFrameDic.Add("a" & animCount,0)
			Call animCreateTimer(animCount,intTimer,"animFadeIn")
	
	End Select
End Sub

Sub animFadeIn(intAnimNumber)
	'get the current frame number
	Set dicObjects = animDic("a"  & intAnimNumber)(0)
	intFrames = animDic("a" & intAnimNumber)(1)
	intFrame = animFrameDic("a" & intAnimNumber)
	DesktopX.Object("dxEdit_debug").Text = intFrame & " " & intFrames
	If Cint(intFrame) > CInt(intFrames) Then
		Execute("Object.KillTimer " & intAnimNumber)
		For each strKeyName in dicObjects.Keys
			Set obj = dicObjects(strKeyName)(0)
			intFinalOpacity = dicObjects(strKeyName)(1)
			obj.Opacity = intFinalOpacity
		Next
	
		Call animDic.Remove("a" & intAnimNumber)
		Exit Sub
	End If
	
	For each strKeyName in dicObjects.Keys
		Set obj = dicObjects(strKeyName)(0)
		intNewOpacity = dicObjects(strKeyName)(2) * intFrame
		obj.Opacity = intNewOpacity
	Next
	
	If intFrame = 0 Then
		For each strKeyName in dicObjects.Keys
			Set obj = dicObjects(strKeyName)(0)
			obj.Visible = True
		Next
	End If
	animFrameDic("a" & intAnimNumber) = intFrame + 1
End Sub

Sub animCreateTimer(animCount,intTimer,strFunction)
	strTimer = 	"Sub Object_OnTimer" & animCount & "():" & _
				"	Call " & strFunction & "(" & animCount & "):" & _
				"End Sub"
	ExecuteGlobal(strTimer)
	Execute("Object.SetTimer " & animCount & "," & intTimer)
End Sub

Sub anim_slideOut(strObjectName,strDirection)
	On Error Resume Next
	Set dxEditXML = DesktopX.ScriptObject("dxEdit_script").dxEditXML
	Set sliderXML = dxEditXML.selectSingleNode("//controls/control[@name = '" & strObjectName & "' and @type='slider']")
	intState = sliderXML.selectSingleNode("state").text
	If intState = "out" Then
		Exit Sub
	End If
	
	If DesktopX.IsObject(strObjectName) Then
		Set objTray = DesktopX.Object(strObjectName)
		Select Case strDirection
			Case "left"
				startX = objTray.Left
				startY = objTray.Top
				For xPos = startX To -objTray.Width Step -1
					objTray.Move xPos,startY
				Next
				
			Case "right"
				startX = objTray.Left
				startY = objTray.Top
				For xPos = startX To Object.Width Step 1
					objTray.Move xPos,startY
				Next
				
			Case "up"
				startX = objTray.Left
				startY = objTray.Top
				For yPos = startY To -objTray.Height Step -1
					objTray.Move startX,yPos
				Next
				
			Case "down"
				startX = objTray.Left
				startY = objTray.Top
				For yPos = startY To Object.Height Step 1
					objTray.Move startX,yPos
				Next
			
			Case "instant"
				objTray.Move -objTray.Width,-objTray.Height
				
		End Select
		sliderXML.selectSingleNode("state").text = "out"
		Call dxEditXML.Save(Object.Directory & "dxEdit.xml")
		
	End If
	On Error Goto 0
End Sub

Sub anim_slideToggle(strObjectName,strDirection)
	On Error Resume Next
	Set dxEditXML = DesktopX.ScriptObject("dxEdit_script").dxEditXML
	Set sliderXML = dxEditXML.selectSingleNode("//controls/control[@name = '" & strObjectName & "' and @type='slider']")
	intState = sliderXML.selectSingleNode("state").text
	If intState = "out" Then
		Call anim_slideIn(strObjectName,strDirection)
	Else
		Call anim_slideOut(strObjectName,strDirection)
	End If
	On Error Goto 0
End Sub

Sub anim_slideIn(strObjectName,strDirection)
	On Error Resume Next
	Set dxEditXML = DesktopX.ScriptObject("dxEdit_script").dxEditXML
	Set sliderXML = dxEditXML.selectSingleNode("//controls/control[@name = '" & strObjectName & "' and @type='slider']")
	If DesktopX.IsObject(strObjectName) Then
		Set objTray = DesktopX.Object(strObjectName)
	Else
		Exit Sub
	End If
	
	intState = sliderXML.selectSingleNode("state").text
	fixedPos = sliderXML.selectSingleNode("fixedPos").text
	If fixedPos = "yes" Then
		initX = CInt(sliderXML.selectSingleNode("initX").text)
		initY = CInt(sliderXML.selectSingleNode("initY").text)
	ElseIf fixedPos = "center" Then
		If objTray.ParentName = "" Then
			initX = System.ScreenWidth/2 - objTray.Width/2
			initY = System.ScreenHeight/2 - objTray.Height/2
		Else
			Set objParent = DesktopX.Object(objTray.ParentName)
			If obj.IsChild Then
				initX = objParent.Width/2 - objTray.Width/2
				initY = objParent.Height/2 - objTray.Height/2
			Else
				initX = objParent.Left + objParent.Width/2 - objTray.Width/2
				initY = objParent.Top + objParent.Height/2 - objTray.Height/2
			End If
		End If
	Else
		initX = 0
		initY = 0
	End If
	
	If intState = "in" Then
		Exit Sub
	End If

	Select Case strDirection
		Case "left"
			startX = objTray.Left
			startY = objTray.Top
			For xPos = startX To initX Step 1
				objTray.Move xPos,startY
			Next
			
		Case "right"
			startX = objTray.Left
			startY = objTray.Top
			For xPos = startX To initX Step -1
				objTray.Move xPos,startY
			Next
			
		Case "up"
			startX = objTray.Left
			startY = objTray.Top
			For yPos = startY To initY Step -1
				objTray.Move startX,yPos
			Next
			
		Case "down"
			startX = objTray.Left
			startY = objTray.Top
			For yPos = startY To initY Step 1
				objTray.Move startX,yPos
			Next
		
		Case "instant"
			objTray.Move initX,initY
			
	End Select
	sliderXML.selectSingleNode("state").text = "in"
	Call dxEditXML.Save(Object.Directory & "dxEdit.xml")
	On Error Goto 0
End Sub


'-----------------------------------------
Class vbListCollection
	Dim d
	
	Private Sub Class_Initialize
		Set d = CreateObject("Scripting.Dictionary")
	End Sub
	
	Public Function newList(listName)
		d.Add listName,""
		newList = True
	End Function
	
	Public Property Let setList(listName,strArray)
		If d.Exists(listName) then
			d.Item(listName) = strArray
			setList = True
		Else
			d.Add listName,""
			d.Item(listName) = strArray
			setList = True
		End If
	End Property
	
	Public Function getList(listName)
		If d.Exists(listName) then
			getList = d.Item(listName)
		Else
			getList = False
		End If
	End Function
	
	Public Function getListIndex(listName,index)
		getListIndex = False
		If d.Exists(listName) then
			arrList = Split(d.Item(listName),",")
			If index <= UBound(arrList) Then
				getListIndex = arrList(index)
			End If
		End If
	End Function
	
	Public Function getListNames()
		getListNames = ""
		For each key in d.keys
			getListNames = getListNames & key & ","
		Next
		If getListNames <> "" Then
			getListNames = Left(getListNames, len(getListNames)-1)
		End If
	End Function
	
	Public Function removeList(listName)
		If d.Exists(listName) Then
			d.Remove(listName)
		End If
	End Function
	
	Public Function getCrossListIndex(index)
		getCrossListIndex = ""
		arrList = d.Keys
		For each list in arrList
			getCrossListIndex = getCrossListIndex & d.Item(list) &","
		Next
		
		If getCrossListIndex <> "" Then
			getCrossListIndex = Left(getCrossListIndex,Len(getCrossListIndex) - 1)
		End If
	End Function
	
	Public Property Let addListItem(listName,value)
		If d.Exists(listName) = False Then
			d.newList(listName)
		End If
		
		If d.Item(listName) = "" then
			d.Item(listName) = value
		Else
			d.Item(listName) = d.Item(listName) & "," & value
		End If
	End Property
End Class

'dxScript generic constants
'Keyboard
Const 	VK_CTRL			= &H11
Const 	VK_SHIFT		= &H10
Const 	KEY_UP			= 38
Const 	KEY_DOWN		= 40
Const 	VK_SPACE		= 32
Const 	VK_ENTER		= 13

'Menus
Const 	M_ENABLED		= &H00000000
Const 	M_GRAYED		= &H00000001
Const 	M_DISABLED		= &H00000002
Const 	M_CHECKED		= &H00000008
Const 	M_POPUP			= &H00000010
Const 	M_SEPARATOR 	= &H00000800
Const 	M_BAR_BREAK		= &H00000020
Const 	M_BREAK			= &H00000040
Const 	M_HILITE		= &H00000080
Const 	M_CENTER		= &H00000004
Const 	M_RIGHT			= &H00000008
Const 	M_VCENTER		= &H00000010
Const 	M_BOTTOM		= &H00000020



