' ------------------------------------------------------------------------------------
' ChangeType.vbs
' Change the type of the current picture.
' Thanks to...
' ------------------------------------------------------------------------------------
Option Explicit
'const TYPE_WMF = 8
'const TYPE_VID = 31
'const STATE_METAFILE = &H0800
'const STATE_VIDEO = &H1000
app.cleartrace
dim alb, pic, st, newType, nT, mask
set alb = app.GetCurrentAlbum
if not alb is nothing then
set pic = alb.GetVisiblePicture( alb.nCurrentPicture )
if not pic is nothing then
st = pic.lStatus
newType = AskForNewType()
if newType <> -1 and newType<> "-" then
mask = &HFFFFFF00
nT = cint(newType)
' Special case for metafiles and videos
if nT = TYPE_VID then
nT = nT or STATE_VIDEO
else
mask = mask and not STATE_VIDEO
end if
if nT = TYPE_WMF then
nT = nT or STATE_METAFILE
else
mask = mask and not STATE_METAFILE
end if
' Change the type but not the other info
st = (st and mask) or nT
pic.lStatus = st
end if
end if
end if
function AskForNewType()
AskForNewType = -1
Const ForReading = 1, ForWriting = 2
' First create a simple HTML file with a form
Dim fso, f, m, s, tempfolder, newFile, k
Set fso = CreateObject("Scripting.FileSystemObject")
' We will create a HTML file with the script so no other file is required
' Get a temporary file and set it with a HTML suffix
Const TemporaryFolder = 2
Set tempfolder = fso.GetSpecialFolder( TemporaryFolder )
newFile = tempfolder.Path & "\" & fso.GetTempName
k = instrrev( newFile, "." )
newFile = left( newFile, k ) & "html"
Set f = fso.OpenTextFile( newFile, ForWriting, True)
f.WriteLine ""
f.WriteLine ""
f.WriteLine "Changing the type of the current picture"
f.WriteLine ""
f.WriteLine ""
f.WriteLine ""
f.WriteLine ""
f.WriteLine ""
f.WriteLine ""
f.WriteLine ""
f.WriteLine "
"
f.WriteLine "Select the new type for the picture:"
f.WriteLine ""
f.WriteLine ""
f.WriteLine "
"
f.WriteLine "
"
f.WriteLine "
"
f.WriteLine ""
f.WriteLine ""
f.Close
' Now, open the created file as a dialog box
s = app.HTMLDialog( newFile, "", "dialogWidth:320px;dialogHeight:140px")
'MsgBox "The new type = '" & s &"'"
AskForNewType = s
end function