<%@ LANGUAGE = VBScript %>
<%
	' Visual Basic Scripting Example 03
	'
	' "Textured Text"
	'
	' Dimac 2002-02-18 (www.dimac.net)
	
	
	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
		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
		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), "alphatransparent", 20
		
		// Fix antialised text
		imageobj2.StretchBltExt imageobj3, left, top, (left + width), (top + height), left, top, (left + width), (top + height), "alphatransparent", 64
		imageobj2.StretchBltExt imageobj3, left, top + extra, (left + width), (top + height) + extra, left, top, (left + width), (top + height), "alphatransparent", 64
		imageobj2.StretchBltExt imageobj3, left + extra, top, (left + width) + extra, (top + height), left, top, (left + width), (top + height), "alphatransparent", 64
		imageobj2.StretchBltExt imageobj3, left + extra, top + extra, (left + width) + extra, (top + height) + extra, left, top, (left + width), (top + height), "alphatransparent", 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 an 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 the error message
		errorimage.DrawText msgcode,0,0
			
		' Stream the image
		errorimage.StreamImage Response, "JPG", 24	
				
	End Sub

%>