[原创] vbs bitmap类

jyswjjgdwtdtj

改了一版，删去了原来的line，shape函数
添加了crop的负数形式，即向外拓张abs(负数)个白色像素
添加读写pixel属性
读：
返回一个BitmapColor对象，直接使用返回argb值，有red,green,blue,alpha,argb四个属性
写：
写入一个argb值，修改图片

class Bitmap
	private imagefile
	private argbdata
	private imagevector
	private fso
	private from
	private imagetype
	public pixels()
	private mywidth,myheight

	public default function cons(byval address)
		loadpicture address
		set cons=me
	end function
	
	private sub class_initialize
		set imagefile=	createobject("WIA.ImageFile")
		set imagevector=	createobject("WIA.Vector")
		set fso=		createobject("scripting.filesystemobject")
	end sub
	
	private sub loadpicture(byval img_address)
		from=img_address
		imagefile.loadfile from
		mywidth=imagefile.width:myheight=imagefile.height
		redim pixels(mywidth,myheight)
		set argbdata=imagefile.argbdata
		dim k:k=0
		dim i,j
		for i=1 to myheight
			for j=1 to mywidth
				k=k+1
				pixels(j,i)=argbdata(k)
			next
		next
	end sub

	public sub turn(byval degree)
		dim newpixels
		newpixels=pixels
		dim i,j,t
		select case degree
			case 90
				redim pixels(myheight,mywidth)
				for i=1 to mywidth
					for j=1 to myheight
						pixels(j,i)=newpixels(i,myheight+1-j)
					next
				next
				t=mywidthmywidth=myheightmyheight=t
			case 270
				redim pixels(myheight,mywidth)
				for i=1 to mywidth
					for j=1 to myheight
						pixels(j,i)=newpixels(mywidth+1-i,j)
					next
				next
				t=mywidthmywidth=myheightmyheight=t
			case 180
				redim pixels(mywidth,myheight)
				for i=1 to mywidth
					for j=1 to myheight
						pixels(i,j)=newpixels(mywidth+1-i,myheight+1-j)
					next
				next
					
		end select
	end sub

	private function dec(byval sixteen)
		dim result
		result=0
		sixteen=ucase(sixteen)
		dim i,l
		l=len(sixteen)
		for i=l to 1 step -1
			dim ir
			ir=mid(sixteen,i,1)
			if isnumeric(ir) then
				result=result+16^(l-i)*ir
			else
				result=result+16^(l-i)*(asc(ir)-65+10)
			end if
		next
		dec=result
	end function
	
	private sub filedelete(byval address)
		if fso.fileexists(address) then fso.deletefile(address)
	end sub
	
	public sub crop(top,bottom,left,right)'这里用了“下标越界”错误来判断，或许可能也许大概有些问题，有兴趣改成正紧的
		on error resume next
		top=int(top):bottom=int(bottom):left=int(left):right=int(right)
		dim newpixels
		newpixels=pixels
		if mywidth-left-right<0 or myheight-top-bottom<0 then redim pixels(1,1):myheight=1:mywidth=1:exit sub
		redim pixels(mywidth-left-right,myheight-top-bottom)
		dim ip,jp,i,j
		ip=0
		for i=top+1 to myheight-bottom
			ip=ip+1:jp=0
			for j=left+1 to mywidth-right
				jp=jp+1
				pixels(jp,ip)=newpixels(j,i)
				if err.number=9 or j=0 or i=0 then pixels(jp,ip)=&HFFFFFF:err.clear
			next
		next
		mywidth=mywidth-left-right:myheight=myheight-top-bottom
	end sub
		
	private function setcolor(byval argb)
		argb=hex(argb)
		argb=string("0",8-len(argb))&argb
		alpha=dec(mid(argb,1,2))
		red=dec(mid(argb,3,2))
		green=dec(mid(argb,5,2))
		blue=dec(mid(argb,7,2))
		argb=dec(argb)
		setcolor=	"class BitmapColor"			&vbcrlf&_ 
				"public property get red()"	&vbcrlf&_
					"red="&red	&vbcrlf&_
				"end property"		&vbcrlf&_
				"public property get green()"	&vbcrlf&_
					"green="&green	&vbcrlf&_
				"end property"		&vbcrlf&_
				"public property get blue()"	&vbcrlf&_
					"blue="&blue	&vbcrlf&_
				"end property"		&vbcrlf&_
				"public property get alpha()"	&vbcrlf&_
					"alpha="&alpha	&vbcrlf&_
				"end property"		&vbcrlf&_
				"public property get argb()"	&vbcrlf&_
					"argb="&argb	&vbcrlf&_
				"end property"		&vbcrlf&_
				"public default function dargb()"&vbcrlf&_
					"dargb="&argb	&vbcrlf&_
				"end function"		&vbcrlf&_
			"end class"
	end function
				
	public sub save
		dim i,j
		dim k:k=0
		imagevector.clear
		for i=1 to myheight
			for j=1 to mywidth
				imagevector.add pixels(j,i)
				k=k+1
			next
		next
		set im=imagevector.imagefile(mywidth,myheight)
		filedelete from
		im.savefile from
		imagevector.clear
	end sub

	public property get pixel(x,y)
		execute(setcolor(pixels(x,y)))
		set pixel=new BitmapColor
	end property
	public property let pixel(x,y,byval num)
		pixels(x,y)=hex(int(num))
	end property
	public property get height()
		height=myheight
	end property
	public property get width()
		width=mywidth
	end property
	public sub reset()
		for i=1 to mywidth
			for j=1 to myheight
				pixels(i,j)=&HFFFFFF
			next
		next
	end sub
end class



set pic=(new bitmap)("1.bmp")
pic.crop -30,-40,-20,-60
pic.reset
for i=50 to 150
msgbox pic.pixel(i,i)
wscript.echo pic.pixel(i,i).red
pic.pixel(i,i)=0
next
pic.save
复制代码

至于像素的其他方法，需要自己实现（自由度高了？）

老刘1号

vbs居然有constructor，屑微软的文档里边怎么没写

jyswjjgdwtdtj

回复 2# 老刘1号


    呃呃呃 你别误会 他可以不叫constructor 也可以叫wobushigouzaohanshu
这里利用了一个vbs独有的default
比如：

class a
public default function c(var)'叫啥名都可以
msgbox var
set c=me
end function
end class
set b=new a
b(1)
所以你也可以这样
set d=(new a)(111)'可以利用类名来直接调用这个默认函数（子程序）
复制代码

这里是demon大佬想出来的一个歪招
就是这个函数返回“ME”，就类似于js里的this
来达到构造函数的效果