截取屏幕并生成HTML格式的图形 IMG2HTML

功能：截取屏幕并生成HTML格式的图形

原理：用按键精灵的接口，取得屏幕上的颜色，然后用单元格背景颜色的方式生成html网页，把图形输出

意义：好像不太大，好玩，试试把自己的照片生成一下：）

使用方法：

第一步：如果你已经安装了按键精灵，第一步就可以跳过了，因为用的三个dll就是从按键精灵的文件夹中拿过来的

下载QMDispatch.rar ，解压后，注册QMDispatch.dll　(regsvr32 ....)

第二步：把下面代码另存为 vbs文件，然后双击就可以运行了。

有兴趣的自己试一下。

下面是一个生成html文件（机器配置不太好的朋友，要注意哦，别把你的浏览器搞崩溃了）

直接看（1.28M）　请下载后解压缩再看

这里还有一个在线转换的：http://neil.fraser.name/software/img2html/

'////////////////////////////////////////
'//功能：截取屏幕并生成HTML格式的图形
'//作者：海娃，haiwa
'//网址：http://www.51windows.net
'//日期：2008-7-11
'////////////////////////////////////////

Dim QMDispatchObj
Set QMDispatchObj = CreateObject("QMDispatch.QMFunction")

function GetCursorPos(ByRef CursorX,ByRef CursorY)	'这个函数用来得到鼠标当前位置
	CursorPos = QMDispatchObj.GetCursorPos()
	CursorY = CursorPos Mod 8192
	CursorX = CInt(CursorPos / 8192)
end function

function GetPixelColor(PosX,PosY)	'这个函数得到某个指定点的颜色（用字符串表示）
	GetPixelColor = QMDispatchObj.GetPixelColor(PosX,PosY)
end function

function truepath(filename)
	dim newfilename
	newfilename = filename
	if instr(newfilename,":") > 0 then
		truepath = newfilename
	else
		Set fsox = CreateObject("Scripting.FileSystemObject")
		truepath = fsox.GetAbsolutePathName(filename)
		set fsox = nothing
	end if
end function

function formatcolor(c)
	formatcolor = right(c,2) & mid(c,3,2) & left(c,2)
end function

'msgbox GetPixelColor(500,500)

widthpx = 320
heightpx = 180

toppx = 1
leftpx = 1

dim lll,ttt
msgbox "将鼠标放在开始的位置(左上角)再确定"
call GetCursorPos(leftpx,toppx)
'msgbox "top:" & toppx & vbnewline & "left:" & leftpx
msgbox "将鼠标放在结束的位置(右下角)再确定"
call GetCursorPos(lll,ttt)

widthpx = lll - leftpx
heightpx = ttt - toppx

if int(widthpx) < 1 or int(heightpx) < 1 then
	msgbox "选择的区域不对"
	wscript.quit()
end if

wscript.sleep(500)

st = timer
set FSO=CreateObject("scripting.filesystemobject")
Set fout = fso.CreateTextFile(truepath("td.htm"))
fout.WriteLine "<html>"
fout.WriteLine "<head>"
fout.WriteLine "<title>img2html</title>"
fout.WriteLine "<meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312"" />"
fout.WriteLine "<meta name=""author"" content=""img2html,51winodws.Net,haiwa,海娃"" />"
fout.WriteLine "<style type=""text/css"">td{height:1px;}</style>"
fout.WriteLine "</head>"
fout.WriteLine "<body>"

precolor = ""
thiswidth = 1

for topi = toppx to toppx+heightpx-1
	precolor = ""
	fout.Write "<table cellpadding=0 cellspacing=0 border=0><tr>"
	for lefti = leftpx to leftpx+widthpx-1
		ccc = GetPixelColor(lefti,topi)

if lefti = leftpx then
			precolor = ccc
			thiswidth = 1
		else
			if precolor <> ccc then
				fout.Write "<td width="& thiswidth &" bgcolor="&formatcolor(precolor)&"></td>"
				thiswidth = 1
			end if
		end if
		if precolor = ccc then
			thiswidth = thiswidth + 1
		else
			precolor = ccc
		end if
	next
	fout.Write "<td width="& thiswidth &" bgcolor="&formatcolor(precolor)&"></td>"
	fout.Write "</tr></table>" & vbnewline
next
fout.WriteLine "</body>"& vbnewline &"</html>"
fout.close
set FSO = nothing
'msgbox timer-st

msgbox "OK"