I have been playing around with VML recently, I think it's defunct now (not much docs at MS) but for VBS-HTA it's pretty cool. I came VERY close to making a full 3D game but it was a bit buggy, so I'd thought I'd map out all of the VML commands that I understand into one script. There are a few I just don't get (not included) and some which are plain odd. I'm also about 25% through making an Asteroids clone using VML....runs pretty well so far.
Anyway, this script is a bit like Xara3D. You can draw 2D shapes with curves then apply fills, extrusions and fit text to a path. I also added load and save functionality for the hell of it.
Just save this as HTA and double click.
<HTML>
<!-- '----------------------- Header ---------------------------- -->
<HEAD>
<TITLE>VML3D By Alan Bond</TITLE>
<HTA:APPLICATION
ID = "frmMain" APPLICATIONNAME = "VML3D"
SINGLEINSTANCE = "yes" SHOWINTASKBAR = "yes"
MAXIMIZEBUTTON = "no" MINIMIZEBUTTON = "no"
BORDER = "thin"
/>
<STYLE TYPE="text/css">
v\: * { behavior:url(#default#VML); display:inline-block }
</STYLE>
<XML:NAMESPACE NS="urn:schemas-microsoft-com:vml" PREFIX="v"/>
</HEAD>
<!-- '------------------------ Body ----------------------------- -->
<BODY ID="BOD" SCROLL="no" BGCOLOR="buttonface">
<INPUT ID="bLoad" TYPE="Button" STYLE="Width:110" VALUE="Load" />
<INPUT ID="bsave" TYPE="Button" STYLE="Width:110" VALUE="Save" />
<br><INPUT ID="togfil" TYPE="CHECKBOX" CHECKED="true" /> Fill
<INPUT ID="tog3d" TYPE="CHECKBOX" CHECKED="true" /> 3D
<INPUT ID="togtxt" TYPE="CHECKBOX" CHECKED="true" /> Text \ shape<hr>
<DIV ID="ControlPanel"></DIV>
<DIV ID="htmFrame">
<V:SHAPE ID="VMLShape">
<V:EXTRUSION ID="VMLExtrusion"/>
<V:FILL ID="VMLFill"/>
<V:PATH TEXTPATHOK="TRUE"/>
<V:TEXTPATH ID="VMLText"/>
</V:SHAPE>
</DIV>
</BODY>
<!-- '----------------------- Script ---------------------------- -->
<SCRIPT LANGUAGE="VBScript">
Option Explicit
Dim CtrlCount : CtrlCount=57 'How many controls to make (changes a lot!)
Dim Ctrls:ReDim Ctrls(CtrlCount) 'Control array for ease of use
Dim MainLoopRunner 'SetInterval for rotating in realtime
Dim RotX,RotY,RotZ 'Rotation of shape\extrusion
Dim AddX,AddY,AddZ 'Rotation to add
'---- For loading and saving scenes
Dim FSO : Set FSO = CreateObject("Scripting.FileSystemObject")
Dim CDO : Set CDO = CreateObject("MSComDlg.CommonDialog")
'---- Control names
Dim CtrlNames : CtrlNames = Array("Background colour","Background image", _
"Background filter","Shape left","Shape top","Shape width","Shape height", _
"Shape coordsize","Shape path","Shape stroke weight","Shape stroke colour", _
"Fill on","Fill mode","Fill colour 1","Fill colour 2","Fill opacity", _
"Fill gradient angle","Fill image source","Fill image align","Fill image position", _
"3D on","3D mode","3D back depth","3D fore depth","3D skew amount","3D skew angle", _
"3D facet detail","3D edge","3D viewpoint XYZ","3D plane","3D rotation centre XYZ", _
"3D rotation X","3D rotation Y","3D rotation Z","3D auto rotation X", _
"3D auto rotation Y","3D auto rotation Z","3D render mode","3D colour mode", _
"3D colour","3D brightness","3D shininess","3D metal","3D diffusity", _
"3D specularity","Light for shape","Light 1 harsh","Light 2 harsh","Light 1 level", _
"Light 2 level","Light 1 position","Light 2 position","Text on","Text fit path", _
"Text string","Text font","Text weight","Text style")
'---- A default scene
Dim Default : Default=Array("Black","","",0,0,800,600,"800 600","M0,300 L800,300 E", _
1,"red",1,1,"white","blue",1,0,"",1,"0 0",1,2,20,0,0,0,1,0,"-2500000emu 0emu 250mm", _
1,"0 0 0",0,0,0,0,0.5,0,1,0,"Gray",0.3,5,0,1,0,1,1,0,38000,"38000","50000,0,10000", _
"-50000,0,10000",1,1," VML3D ","Arial", "Normal","Normal")
'---------------------------- Start up ------------------------------
Sub Window_OnLoad()
'---- Resize window
Self.ResizeTo 1034,629
Self.MoveTo (Screen.Width/2)-512,(Screen.Height/2)-300
'---- Make everything!
BuildControls()
BuildScene()
'---- Start the rotation interval
MainLoopRunner = Window.SetInterval ("Rotate", 1)
End Sub
'------------------------- Build Controls ----------------------------
Sub BuildControls()
Dim L,S
'---- Body style
With Bod.Style
.FontFamily="Microsoft sans serif" : .FontSize="12" : .Margin=0
End With
'---- Make control panel controls
For L = 0 to CtrlCount
'---- <HR> splitters
Select Case L
Case 52,45,20,11,3 : S=S & "<BR><HR><BR>"
End Select
'---- Labels & textareas (not text <inputs>)
S=S & CtrlNames(L) & "<BR>" & "<TEXTAREA ID='txtc" & L & _
"' ONKEYPRESS='TxtKey()' ></TEXTAREA><BR>"
Next
ControlPanel.InnerHTML = S
'---- Set textareas to array and style them
For L = 0 to CtrlCount
Set Ctrls(L)=Document.GetElementByID("txtc" & L)
With Ctrls(L).Style
.Overflow = "Hidden" : .Width = 195 : .Height = 20
.FontFamily="Arial" : .FontSize="12"
End With
'---- Default value
Ctrls(L).Value = Default(L)
Next
'---- These textareas need to be larger
Ctrls(1).style.height=50 : Ctrls(2).style.height=100
Ctrls(8).style.height=160 : Ctrls(17).style.height=50
'---- Control panel style (hidden horz scrollbar)
With ControlPanel.Style
.Overflow="scroll" : .Width=224 : .Height=555 : .Padding="5"
End With
End Sub
'-------------------------- Build a scene -----------------------------
Sub BuildScene()
Dim L,S
On Error Resume Next 'For trapping user input errors (lazy)
'---- Background ----
With htmFrame.Style
.Position="Absolute" : .Overflow="hidden"
.Left=224 : .Top=0 : .Width="800" : .Height="600"
.BackgroundColor=Ctrls(0).value : .Filter=Ctrls(2).value
.BackgroundImage="url(" & Ctrls(1).value & ")"
End with
'---- 2D shape ----
With VMLShape
'---- Position & size
.Style.Position="absolute" : .Style.Left=Ctrls(3).value
.Style.Top=Ctrls(4).value : .Style.Width=Ctrls(5).value
.Style.Height=Ctrls(6).value
'---- Path
.CoordSize=Ctrls(7).value : .Path= Ctrls(8).value
'---- 2D only colour\outline
.StrokeWeight=Ctrls(9).value : .StrokeColor=Ctrls(10).value
End With
'--- Shape's fill ----
With VMLFill
.On=Ctrls(11).value : .Type=Ctrls(12).value
'---- Gradient
.Color=Ctrls(13).value : .Color2=Ctrls(14).value
.Opacity=Ctrls(15).value : .Angle=Ctrls(16).value
'---- Image
.SRC=Ctrls(17).value : .Alignshape= Ctrls(18).value
.Position=Ctrls(19).value
End With
'--- Shape's extrusion ----
With VMLExtrusion
'---- 3D shape data
.On=Ctrls(20).value : .Type=Ctrls(21).value
.BackDepth=Ctrls(22).value : .ForeDepth=Ctrls(23).value
.SkewAmt=cint(Ctrls(24).value) : .SkewAngle=cint(Ctrls(25).value)
.Facet=Ctrls(26).value : .Edge=Ctrls(27).value
.RotationCenter= Ctrls(30).value
'---- Cam stuff
.Viewpoint=Ctrls(28).value : .Plane=Ctrls(29).value
'---- Brush
.Render=Ctrls(37).value : .ColorMode=Ctrls(38).value
.Color = Ctrls(39).value : .Brightness = Ctrls(40).value
.Shininess=Ctrls(41).value : .Metal=Ctrls(42).value
.Diffusity=Ctrls(43).value: .Specularity=Ctrls(44).value
'---- Light
.LightFace=Ctrls(45).value
.LightHarsh=Ctrls(46).value : .LightHarsh2=Ctrls(47).value
.LightLevel=Ctrls(48).value : .LightLevel2=Ctrls(49).value
.LightPosition=Ctrls(50).value : .LightPosition2=Ctrls(51).value
End With
'--- Text ----
With VMLText
.On=Ctrls(52).value : .FitPath=Ctrls(53).value
.String= Replace(Ctrls(54).value,"#",vbcrlf)
.Style.FontFamily = Ctrls(55).value
.style.FontWeight=Ctrls(56).value : .style.FontStyle=Ctrls(57).value
End With
'---- Setup auto rotate ----
RotX=cSng(Ctrls(31).value):RotY=cSng(Ctrls(32).value):RotZ=cSng(Ctrls(33).value)
AddX=cSng(Ctrls(34).value):AddY=cSng(Ctrls(35).value):AddZ=cSng(Ctrls(36).value)
End Sub
'----------------------------- Auto rotate -------------------------------
Sub Rotate()
RotX=RotX+AddX : RotY=RotY+AddY : RotZ=RotZ+AddZ
'---- Wrap rotation
If RotX>360 or RotX<-360 then RotX=0
If RotY>360 or RotY<-360 then RotY=0
If RotZ>360 or RotZ<-360 then RotZ=0
'----Extrusion only rotates Z+Y, shape rotates X
VMLExtrusion.RotationAngle= cStr(RotZ) + " " + cStr(RotY)
VMLShape.Rotation= RotX
End Sub
'--------------------- Press a key in a textarea -------------------------
Sub TxtKey()
If Window.Event.KeyCode = 13 Then
Window.Event.KeyCode=0 'Override enter key
BuildScene()
End If
End Sub
'------------------------- Quick toggle modes ----------------------------
Sub TogFil_OnClick() : Ctrls(11).value=Me.checked : BuildScene(): End Sub
Sub Tog3D_OnClick() : Ctrls(20).value=Me.checked : BuildScene() : End Sub
Sub TogTxt_OnClick() : Ctrls(52).value=Me.checked : BuildScene() : End Sub
'--------------------------- Load a scene --------------------------------
Sub bLoad_OnClick()
Dim oFile,S,Z,L,C
On Error Resume Next 'Only for cancel
'---- Open dialog
With CDO
.CancelError=True : .MaxFileSize = 250
.DialogTitle="Load VML scene" : .Filter="VML scene|*.VML;"
.ShowOpen
If ERR<>0 Then Exit Sub
Set oFile = FSO.OpenTextFile(.FileName,1)
End With
'---- Load as one string
Do While Not oFile.AtEndOfStream
S=S & oFile.ReadLine
Loop
oFile.Close
'---- Parse and update
Z=1
For L=1 To Len(S)
If Mid(S,L,1)="*" THen
Ctrls(C).value = Mid(S,Z,L-Z)
Z=L+1 : C=C+1
End If
Next
BuildScene()
'--- Update quick toggles
TogFil.Checked= Ctrls(11).value
Tog3D.Checked= Ctrls(20).value
TogTxt.Checked= Ctrls(52).value
End Sub
'--------------------------- Save a scene --------------------------------
Sub bsave_OnClick()
Dim oFile,S,Z,L
On Error Resume Next 'Only for cancel
'---- Save dialog
With CDO
.CancelError=True : .MaxFileSize = 250
.DialogTitle="Save VML scene" : .Filter="VML scene|*.VML;"
.FileName = "New scene" : .ShowSave
If ERR<>0 Then Exit Sub
Set oFile = FSO.OpenTextFile(.FileName,2,True)
End With
'---- Weld all values into 1 string, delimited with *
For L=0 to CtrlCount :
S=S & Ctrls(L).value & "*"
Next
'---- Save in 80 columns
For L=1 To Len(S)
Z=Z+1
If Z>80 then
oFile.WriteLine Mid(S,L,1) : Z=0
Else
OFile.Write Mid(S,L,1)
End if
Next
oFile.Close
End Sub
</SCRIPT>
</HTML>
Here are some test scenes, just save each of these files as "whatever.VML", start the script and load 'em in.
A curved textpath:-
Black***0*0*800*600*800 600*M0,300 c300,600 400,0 800,300 E*1*red*1*5*yellow*red*
1*90**1*0 0*True*2*48*0*0*0*1*0*-4000000emu 0emu 150mm*1*0 0 0*0*0*0*0*0*0*1*0*#9
01010*0.3*5*0*1*0*1*1*0*38000*38000*50000,0,10000*-50000,0,10000*True*1* A curve
d path example*Arial*Normal*Normal*
An attempt at a reflection map (needs XP's wallpaper):-
Black*C:\WINDOWS\Web\Wallpaper\Red moon desert.jpg**0*0*800*600*800 600*M0,300 L8
00,300 E*1*red*1*4*white*blue*1*0*C:\WINDOWS\Web\Wallpaper\Red moon desert.jpg*1*
0 0*1*2*5*0*0*0*1*0*-2500000emu 0emu 250mm*1*0 0 0*0*0*0*0*0.5*0*1*0*Black*0.3*5*
0*1*0*1*1*0*38000*38000*50000,0,10000*-50000,0,10000*1*1*Reflection*Impact*Normal
*Normal*
A 3D model of a "Recognizer" from the film TRON:-
Black**progid:DXImageTransform.Microsoft.gradient(startcolorstr=#000000, endcolor
str=#8000FF)*100*50*800*600*1100 800*M0,85 L399,85 399,96 254,96 286,146 512,146
544,96 399,96 399,85 799,85 799,101 647,101 586,190 212,190 151,101 0,101 X M274
,105 L524,105 503,138 295,138 X M377,0 L421,0 421,20 573,76 225,76 377,20 X M324,
198 L474,198 474,210 324,210 X M34,219 L764,219 753,242 477,242 463,259 335,259 3
21,242 45,242 X M620,153 L672,152 672,182 620,182 X M685,117 L749,117 749,212 685
,212 X M126,153 L178,153 178,182 126,182 X M49,117 L113,117 113,212 49,212 X M46,
250 L115,250 115,531 246,599 46,599 X M683,250 L752,250 752,599 551,599 683,531 X
E*1*red*True*5*#5F5FFF*#0F0F9F*1*0**1*0 0*True*2*50*60*0*0*1*0*-2500000emu 0emu
250mm*1*.1 .1 0*0*0*0*.5*0.5*.5*.4*0*#000090*0.3*3*0*1*1*1*1*0*38000*38000*50000,
0,10000*-50000,0,10000*False*0*TRON*Arial*bold*Normal*
I was going to put loads of tooltip info in each control but it was too much text, so if you have any questions about certain modes just yell.
Have fun!