WIA.Vector object 在调用其 ImageFile 属性 后失去其像素的透明度
The WIA.Vector object loses the transparency of its pixels after invoking its ImageFile property
这个问题的标题也可以是，“WIA.Vector object 中的 alpha 值不起作用。”
我正在尝试使用我自己发现的算法在透明背景上渲染一个椭圆，然后将生成的图像保存到 .bmp 文件中。椭圆用黑色描边正确光栅化，但我的程序没有使图像背景透明。
当我检查程序时，发现当我从 Vector object 中检索 ImageFile object 时，它的 IsAlphaPixelFormat 属性 被设置为 false，表示 alpha 通道在输出图像中不可用。即使我在向量中将背景颜色的 alpha 值设置为零，ImageFile object 也会生成不透明的白色背景。
那你能帮我把背景变透明吗？这是我的 VBScript 代码，它必须是 运行 和 cscript.exe.
注意：此程序需要 Windows Image Acquisition (WIA) 库 v2.0 才能创建 .bmp 图像文件。所以在 Window Vista 或更高版本上必须是 运行。
Const width = 500
Const height = 500
color_transparent = GetARGB(0, 255, 255, 255) ' This does not work, renders as opaque white
color_black = GetARGB(255, 0, 0, 0)
PI = 4 * Atn(1)
Dim oVector, oImageFile
Set oVector = NewBlankPage()
rasterizeEllipse oVector, 220, 120, 200, 100, color_black
Set oImageFile = oVector.ImageFile(width, height)
oImageFile.SaveFile "ellipse.bmp"
WScript.StdOut.WriteLine "Done! Press Enter to quit."
WScript.StdIn.SkipLine
Function NewBlankPage()
Dim oVector, i
WScript.StdOut.WriteLine "Creating a new blank page... Please wait..."
Set oVector = CreateObject("WIA.Vector")
For i = 1 To (width * height)
oVector.Add color_transparent
Next
Set NewBlankPage = oVector
End Function
Function getPointOnEllipse(cx, cy, rx, ry, d)
Dim theta
theta = d * Sqr(2 / (rx * rx + ry * ry))
' theta = 2 * PI * d / getEllipsePerimeter(rx, ry)
Dim point(1)
point(0) = Fix(cx + Cos(theta) * rx)
point(1) = Fix(cy - Sin(theta) * ry)
getPointOnEllipse = point
End Function
Function getEllipsePerimeter(rx, ry)
getEllipsePerimeter = Fix(PI * Sqr(2 * (rx * rx + ry * ry)))
End Function
Sub SetPixel(oVector, x, y, color)
x = x + 1
y = y + 1
If x > width Or x < 1 Or y > height Or y < 1 Then
Exit Sub
End If
oVector(x + (y - 1) * width) = color
End Sub
Sub rasterizeEllipse(oVector, cx, cy, rx, ry, color)
Dim perimeter, i
WScript.StdOut.WriteLine "Rendering ellipse..."
perimeter = getEllipsePerimeter(rx, ry)
For i = 0 To (perimeter - 1)
Dim point
point = getPointOnEllipse(cx, cy, rx, ry, i)
SetPixel oVector, point(0), point(1), color
Next
End Sub
' These functions are taken from examples in the documentation
Function Get1ByteHex(val)
Dim s
s = Hex(val)
Do While Len(s) < 2
s = "0" & s
Loop
Get1ByteHex = Right(s, 2)
End Function
Function GetARGB(a, r, g, b)
Dim s
s = "&h" & Get1ByteHex(a) & Get1ByteHex(r) & Get1ByteHex(g) & Get1ByteHex(b)
GetARGB = CLng(s)
End Function
在 运行 代码之后，您可以使用这个简单的 HTA 测试输出图像的透明度：
<html>
<head>
<title>Test</title>
</head>
<body bgcolor="blue">
<img src="ellipse.bmp">
</body>
</html>
然后你会看到椭圆后面显示了一个白框，表示non-transparent背景。
这可以通过使用 ARGB 过滤器将所有白色像素更改为透明并将图像保存为 PNG 文件来完成。不幸的是，这意味着遍历每个像素，因此您的脚本将花费两倍的时间 运行。我找不到创建具有透明度的初始图像的方法。有关性能问题的信息，请参阅 here。这是修改后的脚本：
Const wiaFormatPNG = "{B96B3CAF-0728-11D3-9D7B-0000F81EF32E}"
Const width = 500
Const height = 500
color_white = GetARGB(255, 255, 255, 255)
color_transparent = GetARGB(0, 255, 255, 255)
color_black = GetARGB(255, 0, 0, 0)
PI = 4 * Atn(1)
Dim oVector, oImageFile
Set oVector = NewBlankPage()
rasterizeEllipse oVector, 220, 120, 200, 100, color_black
Set oImageFile = oVector.ImageFile(width, height)
Set IP = CreateObject("WIA.ImageProcess")
IP.Filters.Add IP.FilterInfos("ARGB").FilterID
Set oVector = oImageFile.ARGBData
Wscript.StdOut.WriteLine "Changing white pixels to transparent... Please wait..."
For i = 1 To oVector.Count
If oVector.Item(i) = color_white Then oVector.Item(i) = color_transparent
Next
IP.Filters(1).Properties("ARGBData").Value = oVector
IP.Filters.Add IP.FilterInfos("Convert").FilterID
IP.Filters(2).Properties("FormatID").Value = wiaFormatPNG
Set oImageFile = IP.Apply(oImageFile)
oImageFile.SaveFile "ellipse.png"
Wscript.StdOut.WriteLine "Done! Press Enter to quit."
Wscript.StdIn.SkipLine
Function NewBlankPage()
Dim oVector, i
Wscript.StdOut.WriteLine "Creating a new blank page... Please wait..."
Set oVector = CreateObject("WIA.Vector")
For i = 1 To (width * height)
oVector.Add color_white
Next
Set NewBlankPage = oVector
End Function
Function getPointOnEllipse(cx, cy, rx, ry, d)
Dim theta
theta = d * Sqr(2 / (rx * rx + ry * ry))
' theta = 2 * PI * d / getEllipsePerimeter(rx, ry)
Dim point(1)
point(0) = Fix(cx + Cos(theta) * rx)
point(1) = Fix(cy - Sin(theta) * ry)
getPointOnEllipse = point
End Function
Function getEllipsePerimeter(rx, ry)
getEllipsePerimeter = Fix(PI * Sqr(2 * (rx * rx + ry * ry)))
End Function
Sub SetPixel(oVector, x, y, color)
x = x + 1
y = y + 1
If x > width Or x < 1 Or y > height Or y < 1 Then
Exit Sub
End If
oVector(x + (y - 1) * width) = color
End Sub
Sub rasterizeEllipse(oVector, cx, cy, rx, ry, color)
Dim perimeter, i
Wscript.StdOut.WriteLine "Rendering ellipse..."
perimeter = getEllipsePerimeter(rx, ry)
For i = 0 To (perimeter - 1)
Dim point
point = getPointOnEllipse(cx, cy, rx, ry, i)
SetPixel oVector, point(0), point(1), color
Next
End Sub
' These functions are taken from examples in the documentation
Function Get1ByteHex(val)
Dim s
s = Hex(val)
Do While Len(s) < 2
s = "0" & s
Loop
Get1ByteHex = Right(s, 2)
End Function
Function GetARGB(a, r, g, b)
Dim s
s = "&h" & Get1ByteHex(a) & Get1ByteHex(r) & Get1ByteHex(g) & Get1ByteHex(b)
GetARGB = CLng(s)
End Function
注意：如果您的 HTA 中只需要一个椭圆，可以使用 CSS:
立即完成
<!DOCTYPE html>
<html>
<head>
<title>Test</title>
<meta http-equiv="X-UA-Compatible" content="IE=9">
<style>
.ellipseDiv
{
height:200px;
width:400px;
border: 1px solid #005;
border-radius:200px / 100px;
}
</style>
</head>
<body bgcolor="blue">
<div class=ellipseDiv>
</div>
</body>
</html>
这个问题的标题也可以是，“WIA.Vector object 中的 alpha 值不起作用。”
我正在尝试使用我自己发现的算法在透明背景上渲染一个椭圆，然后将生成的图像保存到 .bmp 文件中。椭圆用黑色描边正确光栅化，但我的程序没有使图像背景透明。
当我检查程序时，发现当我从 Vector object 中检索 ImageFile object 时，它的 IsAlphaPixelFormat 属性 被设置为 false，表示 alpha 通道在输出图像中不可用。即使我在向量中将背景颜色的 alpha 值设置为零，ImageFile object 也会生成不透明的白色背景。
那你能帮我把背景变透明吗？这是我的 VBScript 代码，它必须是 运行 和 cscript.exe.
注意：此程序需要 Windows Image Acquisition (WIA) 库 v2.0 才能创建 .bmp 图像文件。所以在 Window Vista 或更高版本上必须是 运行。
Const width = 500
Const height = 500
color_transparent = GetARGB(0, 255, 255, 255) ' This does not work, renders as opaque white
color_black = GetARGB(255, 0, 0, 0)
PI = 4 * Atn(1)
Dim oVector, oImageFile
Set oVector = NewBlankPage()
rasterizeEllipse oVector, 220, 120, 200, 100, color_black
Set oImageFile = oVector.ImageFile(width, height)
oImageFile.SaveFile "ellipse.bmp"
WScript.StdOut.WriteLine "Done! Press Enter to quit."
WScript.StdIn.SkipLine
Function NewBlankPage()
Dim oVector, i
WScript.StdOut.WriteLine "Creating a new blank page... Please wait..."
Set oVector = CreateObject("WIA.Vector")
For i = 1 To (width * height)
oVector.Add color_transparent
Next
Set NewBlankPage = oVector
End Function
Function getPointOnEllipse(cx, cy, rx, ry, d)
Dim theta
theta = d * Sqr(2 / (rx * rx + ry * ry))
' theta = 2 * PI * d / getEllipsePerimeter(rx, ry)
Dim point(1)
point(0) = Fix(cx + Cos(theta) * rx)
point(1) = Fix(cy - Sin(theta) * ry)
getPointOnEllipse = point
End Function
Function getEllipsePerimeter(rx, ry)
getEllipsePerimeter = Fix(PI * Sqr(2 * (rx * rx + ry * ry)))
End Function
Sub SetPixel(oVector, x, y, color)
x = x + 1
y = y + 1
If x > width Or x < 1 Or y > height Or y < 1 Then
Exit Sub
End If
oVector(x + (y - 1) * width) = color
End Sub
Sub rasterizeEllipse(oVector, cx, cy, rx, ry, color)
Dim perimeter, i
WScript.StdOut.WriteLine "Rendering ellipse..."
perimeter = getEllipsePerimeter(rx, ry)
For i = 0 To (perimeter - 1)
Dim point
point = getPointOnEllipse(cx, cy, rx, ry, i)
SetPixel oVector, point(0), point(1), color
Next
End Sub
' These functions are taken from examples in the documentation
Function Get1ByteHex(val)
Dim s
s = Hex(val)
Do While Len(s) < 2
s = "0" & s
Loop
Get1ByteHex = Right(s, 2)
End Function
Function GetARGB(a, r, g, b)
Dim s
s = "&h" & Get1ByteHex(a) & Get1ByteHex(r) & Get1ByteHex(g) & Get1ByteHex(b)
GetARGB = CLng(s)
End Function
在 运行 代码之后，您可以使用这个简单的 HTA 测试输出图像的透明度：
<html>
<head>
<title>Test</title>
</head>
<body bgcolor="blue">
<img src="ellipse.bmp">
</body>
</html>
然后你会看到椭圆后面显示了一个白框，表示non-transparent背景。
这可以通过使用 ARGB 过滤器将所有白色像素更改为透明并将图像保存为 PNG 文件来完成。不幸的是，这意味着遍历每个像素，因此您的脚本将花费两倍的时间 运行。我找不到创建具有透明度的初始图像的方法。有关性能问题的信息，请参阅 here。这是修改后的脚本：
Const wiaFormatPNG = "{B96B3CAF-0728-11D3-9D7B-0000F81EF32E}"
Const width = 500
Const height = 500
color_white = GetARGB(255, 255, 255, 255)
color_transparent = GetARGB(0, 255, 255, 255)
color_black = GetARGB(255, 0, 0, 0)
PI = 4 * Atn(1)
Dim oVector, oImageFile
Set oVector = NewBlankPage()
rasterizeEllipse oVector, 220, 120, 200, 100, color_black
Set oImageFile = oVector.ImageFile(width, height)
Set IP = CreateObject("WIA.ImageProcess")
IP.Filters.Add IP.FilterInfos("ARGB").FilterID
Set oVector = oImageFile.ARGBData
Wscript.StdOut.WriteLine "Changing white pixels to transparent... Please wait..."
For i = 1 To oVector.Count
If oVector.Item(i) = color_white Then oVector.Item(i) = color_transparent
Next
IP.Filters(1).Properties("ARGBData").Value = oVector
IP.Filters.Add IP.FilterInfos("Convert").FilterID
IP.Filters(2).Properties("FormatID").Value = wiaFormatPNG
Set oImageFile = IP.Apply(oImageFile)
oImageFile.SaveFile "ellipse.png"
Wscript.StdOut.WriteLine "Done! Press Enter to quit."
Wscript.StdIn.SkipLine
Function NewBlankPage()
Dim oVector, i
Wscript.StdOut.WriteLine "Creating a new blank page... Please wait..."
Set oVector = CreateObject("WIA.Vector")
For i = 1 To (width * height)
oVector.Add color_white
Next
Set NewBlankPage = oVector
End Function
Function getPointOnEllipse(cx, cy, rx, ry, d)
Dim theta
theta = d * Sqr(2 / (rx * rx + ry * ry))
' theta = 2 * PI * d / getEllipsePerimeter(rx, ry)
Dim point(1)
point(0) = Fix(cx + Cos(theta) * rx)
point(1) = Fix(cy - Sin(theta) * ry)
getPointOnEllipse = point
End Function
Function getEllipsePerimeter(rx, ry)
getEllipsePerimeter = Fix(PI * Sqr(2 * (rx * rx + ry * ry)))
End Function
Sub SetPixel(oVector, x, y, color)
x = x + 1
y = y + 1
If x > width Or x < 1 Or y > height Or y < 1 Then
Exit Sub
End If
oVector(x + (y - 1) * width) = color
End Sub
Sub rasterizeEllipse(oVector, cx, cy, rx, ry, color)
Dim perimeter, i
Wscript.StdOut.WriteLine "Rendering ellipse..."
perimeter = getEllipsePerimeter(rx, ry)
For i = 0 To (perimeter - 1)
Dim point
point = getPointOnEllipse(cx, cy, rx, ry, i)
SetPixel oVector, point(0), point(1), color
Next
End Sub
' These functions are taken from examples in the documentation
Function Get1ByteHex(val)
Dim s
s = Hex(val)
Do While Len(s) < 2
s = "0" & s
Loop
Get1ByteHex = Right(s, 2)
End Function
Function GetARGB(a, r, g, b)
Dim s
s = "&h" & Get1ByteHex(a) & Get1ByteHex(r) & Get1ByteHex(g) & Get1ByteHex(b)
GetARGB = CLng(s)
End Function
注意：如果您的 HTA 中只需要一个椭圆，可以使用 CSS:
立即完成<!DOCTYPE html>
<html>
<head>
<title>Test</title>
<meta http-equiv="X-UA-Compatible" content="IE=9">
<style>
.ellipseDiv
{
height:200px;
width:400px;
border: 1px solid #005;
border-radius:200px / 100px;
}
</style>
</head>
<body bgcolor="blue">
<div class=ellipseDiv>
</div>
</body>
</html>