Surfing

Textured text - VB-Script

' Visual Basic Scripting Example 03
'
' "Textured Text"
'

Texture

Sub Texture()

Dim imageobj1
Dim imageobj2
Dim imageobj3

Dim width
Dim height
Dim top
Dim left

Dim text
Dim fontobj
Dim extra
Dim shadow
Dim path

' Fix path
path = Server.MapPath("..\..\images") + "\"

' Set extra space for alpha blend text
extra = 1

' Shadow space
shadow = 15

Set imageobj1 = Server.CreateObject("W3Image.Image")
Set imageobj2 = Server.CreateObject("W3Image.Image")
Set imageobj3 = Server.CreateObject("W3Image.Image")

' Load texture
if (imageobj1.LoadImage(path & "tools.jpg") = False ) Then
  ' Do your error handling here...
  DisplayError "Error when loading image 'tools.jpg'."
  ' Jump out - otherwise the code will continue
  Exit Sub
End If

' Create a small surface (to get text size)
imageobj2.CreateEmptySurface 1,1

' Load background image
if (imageobj3.LoadImage(path & "surf.jpg") = False ) Then
  ' Do your error handling here...
  DisplayError "Error when loading image 'surf.jpg'."
  ' Jump out - otherwise the code will continue
  Exit Sub
End If

' Create a white font
Set fontobj = imageobj2.CreateFont("Arial",180,0,"normal",0, &H00FFFFFF&,false,false,false)
imageobj2.SetFont fontobj

' Text to center
text = "w3 Image"

' Get size of the text
width = imageobj2.GetTextWidth(text)
height = imageobj2.GetTextHeight(text)

' Calc postion for text
top = ((imageobj3.height - height) - 20)
If (top < 0) then
  top = 0
End If

left = ((imageobj3.width - width)/2)
If (left <= 0) then
  left = 0
End If

' Set background to black
imageobj2.bkColor = &H00000000&

' Finally create the computed surface to use as a mask (text is white)
imageobj2.CreateEmptySurface imageobj3.width, imageobj3.height

' Important!!!! Select the font again (is lost when creating a new surface)
imageobj2.SetFont fontobj

' Draw the text
imageobj2.DrawText text, left, top

imageobj1.StretchBltExt imageobj2, 0, 0, imageobj2.width, imageobj2.height, 0, 0, imageobj1.width, imageobj1.height, "srcand"

' Make a shadow text
imageobj2.StretchBltExt imageobj3, left + shadow, top + shadow, (left + width) + shadow, (top + height) + shadow, left, top, (left + width), (top + height), "alpha", 20

' Fix antialised text
imageobj2.StretchBltExt imageobj3, left, top, (left + width), (top + height), left, top, (left + width), (top + height), "alpha", 64
imageobj2.StretchBltExt imageobj3, left, top + extra, (left + width), (top + height) + extra, left, top, (left + width), (top + height), "alpha", 64
imageobj2.StretchBltExt imageobj3, left + extra, top, (left + width) + extra, (top + height), left, top, (left + width), (top + height), "alpha", 64
imageobj2.StretchBltExt imageobj3, left + extra, top + extra, (left + width) + extra, (top + height) + extra, left, top, (left + width), (top + height), "alpha", 64

If (imageobj3.StreamImage(Response, "JPG", 24) = False ) Then
  ' Do your error handling here...
  DisplayError "Error when streaming the image."
End If

End Sub

' Example of a error handler - Displaying the error as a image
Sub DisplayError(msgcode)

' Create an error image
Dim errorimage
Dim fontobj
Dim width
Dim height

Set errorimage = Server.CreateObject("W3Image.Image")
errorimage.CreateEmptySurface 1,1

' Create and select the font
Set fontobj = errorimage.CreateFont("Tahoma",24,0,"normal",0,&H00000000&,False,False,True)
errorimage.SetFont fontobj

' Get size of the text
width = errorimage.GetTextWidth(msgcode)
height = errorimage.GetTextHeight(msgcode)

' Create a surface as large as the error message
errorimage.CreateEmptySurface width,height

' Select the font again (font is deselected when creating a new surface)
errorimage.SetFont fontobj

' Write out error message
errorimage.DrawText msgcode,0,0

' Stream the image
errorimage.StreamImage Response, "JPG", 24

End Sub