Option Explicit
'Demonstration of generating a BMP graphics file under 
'VBS control. Draw a 15x15 pixel winking happy face.
Dim MyArray()
Dim intRow, intCol
Dim strBmp, strImageData
Const IMAGE_HEIGHT = 15
Const IMAGE_WIDTH = 15
	'Create the image data in an easy to manipulate string format
	strImageData = ""
	strImageData = strImageData & "000000111000000"
	strImageData = strImageData & "000111777111000"
	strImageData = strImageData & "001777777777100"
	strImageData = strImageData & "001777777777100"
	strImageData = strImageData & "017727777777710"
	strImageData = strImageData & "017222777333710"
	strImageData = strImageData & "177727777777771"
	strImageData = strImageData & "177777777777771"
	strImageData = strImageData & "177777777777771"
	strImageData = strImageData & "017777777777710"
	strImageData = strImageData & "017744474447710"
	strImageData = strImageData & "017777444777710"
	strImageData = strImageData & "001177777771100"
	strImageData = strImageData & "000011777110000"
	strImageData = strImageData & "000000111000000"
	'Stuff the image data into an array
	ReDim MyArray(IMAGE_WIDTH, IMAGE_HEIGHT)
	For intRow = 0 To IMAGE_HEIGHT - 1
		For intCol = 0 To IMAGE_WIDTH - 1
			MyArray(intRow, intCol) = Mid(strImageData, (intCol + 1) + (intRow * IMAGE_WIDTH) , 1)
		Next
	Next
	'Now call the ArrayToBmp function to generate a BMP string
	strBmp = ArrayToBmp(MyArray)
	'Now save the string as a file so we can view it.
	String2File strBmp, FileNameLikeMine("bmp")



Function ArrayToBmp(vArray)
'vArray must be a two dimensional array of ones and zeros 
'vArray is arranged in row, col. For example, in a 255x255 graphic, 
'top left of picture will be vArray(0,0) and top right is vArray(0,254) 
Dim intWidth, intHeight
Dim strBuffer, strLineBuffer, strPictureBuffer
Dim intBuffer, intNybble, intRowCount, intColCount
Dim lngFileSize, lngImageSize
	'Get the image height and width from the array dimensions
	intHeight = UBound(vArray, 1)
	intWidth = UBound(vArray, 2)
	'Calculate the image size taking any padding bits into account
	lngImageSize = ((intWidth + ((intWidth Mod 8)\2)) / 2) * intHeight
	'Calculate the file size
	lngFileSize = lngImageSize + 118 'First 117 bytes are all header stuff
	'Build a header for a 16-color bitmap
	strBuffer = "BM" ' The bitmap identifier
	'Four file size bytes, LSB first
	strBuffer = strBuffer & Chr(lngFileSize And &HFF)
	strBuffer = strBuffer & Chr((lngFileSize And &HFF00) \ &H100)
	strBuffer = strBuffer & Chr((lngFileSize And &HFF0000) \ &H10000)
	strBuffer = strBuffer & Chr((lngFileSize And &HFF000000) \ &H1000000)
	'Four zeros (reserved part of the header)
	strBuffer = strBuffer & Chr(0) & Chr(0) & Chr(0) & Chr(0)
	'Four picture start location bytes (always &H76 for a 16-color bitmap)
	strBuffer = strBuffer & Chr(&H76) & Chr(0) & Chr(0) & Chr(0)
	'Four header size bytes (always &H28 for a 16-color bitmap)
	strBuffer = strBuffer & Chr(&H28) & Chr(0) & Chr(0) & Chr(0)
	'Four image width bytes, LSB first
	strBuffer = strBuffer & Chr(intWidth And &HFF)
	strBuffer = strBuffer & Chr((intWidth And &HFF00) \ &H100)
	strBuffer = strBuffer & Chr((intWidth And &HFF0000) \ &H10000)
	strBuffer = strBuffer & Chr((intWidth And &HFF000000) \ &H1000000)
	'Four image height bytes, LSB first
	strBuffer = strBuffer & Chr(intHeight And &HFF)
	strBuffer = strBuffer & Chr((intHeight And &HFF00) \ &H100)
	strBuffer = strBuffer & Chr((intHeight And &HFF0000) \ &H10000)
	strBuffer = strBuffer & Chr((intHeight And &HFF000000) \ &H1000000)
	'Two image planes count bytes (always 1 because there is only one plane in a bitmap)
	strBuffer = strBuffer & Chr(1) & Chr(0)
	'Two bits per pixel bytes (always 4 bits per pixel in a 16-color bitmap)
	strBuffer = strBuffer & Chr(4) & Chr(0)
	'Four compression type bytes (zero because no compression)
	strBuffer = strBuffer & Chr(0) & Chr(0) & Chr(0) & Chr(0)
	'Four image size (length in bytes) bytes, LSB first
	strBuffer = strBuffer & Chr(lngImageSize And &HFF)
	strBuffer = strBuffer & Chr((lngImageSize And &HFF00) \ &H100)
	strBuffer = strBuffer & Chr((lngImageSize And &HFF0000) \ &H10000)
	strBuffer = strBuffer & Chr((lngImageSize And &HFF000000) \ &H1000000)
	'Four horizontal resolution bytes (zero because I ignore it)
	strBuffer = strBuffer & Chr(0) & Chr(0) & Chr(0) & Chr(0)
	'Four vertical resolution bytes (zero because I ignore it)
	strBuffer = strBuffer & Chr(0) & Chr(0) & Chr(0) & Chr(0)
	'Four bytes to count number of colors (always 16 in a 16-color bitmap)
	strBuffer = strBuffer & Chr(16) & Chr(0) & Chr(0) & Chr(0)
	'Four bytes to count number of IMPORTANT colors (0 for all colors or specify 16)
	strBuffer = strBuffer & Chr(16) & Chr(0) & Chr(0) & Chr(0)
	'Four bytes to specify each of 16 palette entries. 
	'These are in BGR (not RGB!) order with last byte always zero.
	'Feel free to change the order or the actual values. These are Windows colors.
	'It's in this order because it is easy for me to remember.
	strBuffer = strBuffer & Chr(255) & Chr(255) & Chr(255) & Chr(0) 'White - 0
	strBuffer = strBuffer & Chr(0) & Chr(0) & Chr(0) & Chr(0) 'Black - 1
	strBuffer = strBuffer & Chr(0) & Chr(0) & Chr(255) & Chr(0) 'Red - 2
	strBuffer = strBuffer & Chr(0) & Chr(255) & Chr(0) & Chr(0) 'Green - 3
	strBuffer = strBuffer & Chr(255) & Chr(0) & Chr(0) & Chr(0) 'Blue - 4
	strBuffer = strBuffer & Chr(255) & Chr(255) & Chr(0) & Chr(0) 'Cyan - 5
	strBuffer = strBuffer & Chr(255) & Chr(0) & Chr(255) & Chr(0) 'Magenta - 6
	strBuffer = strBuffer & Chr(0) & Chr(255) & Chr(255) & Chr(0) 'Yellow - 7
	strBuffer = strBuffer & Chr(192) & Chr(192) & Chr(192) & Chr(0) 'Light Gray - 8
	strBuffer = strBuffer & Chr(128) & Chr(128) & Chr(128) & Chr(0) 'Dark Gray - 9
	strBuffer = strBuffer & Chr(0) & Chr(0) & Chr(128) & Chr(0) 'Dark Red - 10
	strBuffer = strBuffer & Chr(0) & Chr(128) & Chr(0) & Chr(0) 'Dark Green - 11
	strBuffer = strBuffer & Chr(128) & Chr(0) & Chr(0) & Chr(0) 'Dark Blue - 12
	strBuffer = strBuffer & Chr(128) & Chr(128) & Chr(0) & Chr(0) 'Dark Cyan - 13
	strBuffer = strBuffer & Chr(128) & Chr(0) & Chr(128) & Chr(0) 'Dark Magenta - 14
	strBuffer = strBuffer & Chr(0) & Chr(128) & Chr(128) & Chr(0) 'Dark Yellow - 15
	'Now get the picture data! Each byte will contain two pixels at one nybble per pixel.
	strPictureBuffer = ""
	For intRowCount = (intHeight - 1) To 0 Step -1 'Gotta read bitmaps starting from the last row
		strLineBuffer = ""
		For intColCount = 0 To intWidth - 1 Step 2
			If intColCount <= intWidth - 2 Then
				strLineBuffer = strLineBuffer & Chr((16 * vArray(intRowCount, intColCount)) + vArray(intRowCount, intColCount + 1))
			Else
				strLineBuffer = strLineBuffer & Chr(16 * vArray(intRowCount, intColCount))
			End If
		Next
		'Line must end on a four-byte boundary. Pad with zeros as needed.
		Do Until Len(strLineBuffer) Mod 4 = 0
			strLineBuffer = strLineBuffer & Chr(0)
		Loop
		strPictureBuffer = strPictureBuffer & strLineBuffer
	Next
	strBuffer = strBuffer & strPictureBuffer
	ArrayToBmp = strBuffer
End Function 

Function FileNameLikeMine(strFileExtension) 'As String
'Returns a file name the same as the script name except
'for the file extension. 
Dim fs 'As Object
Dim strExtension 'As String
	Set fs = CreateObject("Scripting.FileSystemObject")
	strExtension = strFileExtension
	If Len(strExtension) < 1 Then strExtension = "txt"
	If strExtension = "." Then strExtension = "txt"
	If Left(strExtension,1) = "." Then strExtension = Mid(strExtension, 2)
	FileNameLikeMine = Left(Wscript.ScriptFullName, InstrRev(Wscript.ScriptFullName, ".")) & strExtension
End Function

Sub String2File(strData, strFileName)
'Writes a string to a file
Dim fs 'As Scripting.FileSystemObject
Dim ts 'As Scripting.TextStream
Const ForWriting = 2
	Set fs = CreateObject("Scripting.FileSystemObject")
	Set ts = fs.OpenTextFile(strFileName, ForWriting, True)
	ts.Write(strData)
	ts.Close
End Sub