[原创] vbs bitmap类

jyswjjgdwtdtj

相当于把wia套了个壳子 呵呵

Class Bitmap
    'width,height可以理解为像素矩阵的上界 与vbs数组保持一致 而非有多少像素
    Private imagefile
    Private argbdata
    Private fso
    Private picturefrom
    Private formatid
    Private picwidth,picheight
    Private pictureto
    Private ip
    
    Public default Property Get pixel_(x,y)
        pixel_ = Me.pixel(x,y)
    End Property
    
    Private Sub Class_Initialize
        Set imagefile = CreateObject("WIA.ImageFile")
        Set argbdata = CreateObject("WIA.Vector")
        Set ip = CreateObject("WIA.ImageProcess")
        Set fso = CreateObject("scripting.filesystemobject")
    End Sub
    
    Public Sub LoadPicture(ByVal img_address)
        picturefrom = img_address
        imagefile.loadfile picturefrom
        picwidth = imagefile.width - 1
        picheight = imagefile.height - 1
        Set argbdata = imagefile.argbdata 'as wiaVector
        formatid = file.formatid
    End Sub
    
    Private Sub filedelete(ByVal address)
        If fso.fileexists(address) Then
            fso.deletefile(address)
        End If
    End Sub
    
    Public Sub saveto(fileaddress)
        pictureto = fileaddress
        Set im = argbdata.imagefile(picwidth + 1,picheight + 1)
        filedelete pictureto
        im.savefile pictureto
    End Sub
    
    Public Sub save
        Call saveto(picturefrom)
    End Sub
    
    Public Property Get pixel(x,y)
        pixel = argbdata.item(y * (picwidth + 1) + x + 1)
    End Property
    
    Public Property Let pixel(x,y,ByVal num)
        argbdata.item(y * (picwidth + 1) + x + 1) = CLng(num)
    End Property
    
    Public Property Get height()
        height = picheight
    End Property
    
    Public Property Get width()
        width = picwidth
    End Property
    
    Public Sub reset(x,y)
        formatid = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"
        argbdata.clear
        picwidth = x
        picheight = y
        For i = 1 To (x + 1) * (y + 1)
            argbdata.add(CLng(&hffffffff))
        Next
    End Sub
    Public Function RGB(r,g,b)
        RGB = r * &h10000 + g * &h100 + b
    End Function
    
    Public Function tomatrix()
        Dim matrix()
        ReDim matrix(picwidth,picheight)
        For i = 0 To picheight
            For j = 0 To picwidth
                matrix(j,i) = argbdata.item(i * (picwidth + 1) + j + 1)
            Next
        Next
        tomatrix = matrix
    End Function
    
    Public Sub setasmatrix(matrix)
        picwidth = UBound(matrix,1)
        picheight = UBound(matrix,2)
        Me.reset picwidth,picheight
        For i = 0 To picheight
            For j = 0 To picwidth
                argbdata.item(i * (picwidth + 1) + j + 1) = matrix(j,i)
            Next
        Next
    End Sub
    
    Public Sub compress(value)
        Set image = argbdata.imagefile(picwidth + 1,picheight + 1)
        ip.Filters.Add ip.FilterInfos("Convert").FilterID
        ip.Filters(1).Properties("FormatID").Value = formatid
        ip.Filters(1).Properties("Quality").Value = value
        Set image = ip.apply(image)
        Set argbdata = image.argbdata
        picwidth = image.width - 1
        picheight = image.height - 1
        ip.filters.remove(1)
    End Sub
    
    Public Sub rotate(degree)
        Set image = argbdata.imagefile(picwidth + 1,picheight + 1)
        ip.Filters.Add ip.FilterInfos("RotateFlip").FilterID
        ip.Filters(1).Properties("RotationAngle") = degree
        Set image = ip.apply(image)
        Set argbdata = image.argbdata
        picwidth = image.width - 1
        picheight = image.height - 1
        ip.filters.remove(1)
    End Sub
    
    Public Sub crop(Left,top,Right,bottom)
        Set image = argbdata.imagefile(picwidth + 1,picheight + 1)
        ip.Filters.Add ip.FilterInfos("Crop").FilterID
        ip.Filters(1).Properties("Left") = Left
        ip.Filters(1).Properties("Top") = top
        ip.Filters(1).Properties("Right") = Right
        ip.Filters(1).Properties("Bottom") = bottom
        Set image = ip.apply(image)
        Set argbdata = image.argbdata
        picwidth = image.width - 1
        picheight = image.height - 1
        ip.filters.remove(1)
    End Sub
    
    Public Sub scale(width,height)
        Set image = argbdata.imagefile(picwidth + 1,picheight + 1)
        ip.Filters.Add ip.FilterInfos("Scale").FilterID
        ip.Filters(1).Properties("MaximumWidth") = width
        ip.Filters(1).Properties("MaximumHeight") = height
        Set image = ip.apply(image)
        Set argbdata = image.argbdata
        picwidth = image.width - 1
        picheight = image.height - 1
        ip.filters.remove(1)
    End Sub
    
End Class

Function rand(n)
    Randomize
    rand = Int(n * Rnd)
End Function

Set pic = New bitmap
pic.reset 1000,1000
For i = 0 To 1000
    For j = 0 To 1000
        pic.pixel(j,i) = pic.RGB(rand(256),rand(256),rand(256))
    Next
Next
pic.compress 5
pic.saveto "2.jpg"
复制代码

老刘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
来达到构造函数的效果