当前位置： 文江博客话题详情

WIA.Vector 对象在调用其 ImageFile 属性后失去其像素的透明度

发布于 2025-01-17 19:15:17 字数 2985 浏览 0 评论 0原文

这个问题的标题也可以是：“ wia.vector对象中的alpha值不起作用。”
我正在尝试使用自己发现的算法在透明背景上渲染一个椭圆，然后将结果图像保存到A .bmp 文件中。椭圆用黑色笔触正确栅格化，但我的程序并没有使图像的背景透明。
当我检查程序时，事实证明，当我从vector对象检索imagefile对象时，其isalphapixelformat属性设置为false，false，表明输出图像中没有Alpha通道。即使我将背景颜色的alpha值设置为向量中的零，imageFile对象也会生成不透明的白色背景。

那么，您能帮我让我的背景透明吗？这是我的vbscript代码，必须使用cscript.exe。
运行 注意：此程序需要Windows Image采集（WIA）库V2.0才能创建 .bmp 图像文件。因此，它必须在窗口远景上运行或更高。

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>

您会看到椭圆后面显示一个白色框，这表明非透明背景。

原文

The title of this question can also be, "The alpha values in the WIA.Vector object don't work."
I'm trying to render an ellipse on a transparent background using my own discovered algorithm, and then save the resulting image into a .bmp file. The ellipse is rasterized properly with a black stroke, but my program does not make the background of the image transparent.
As I examined the program, it turned out that when I retrieve an ImageFile object from the Vector object, its IsAlphaPixelFormat property is set to false, indicating that the alpha channel is not available in the output image. Even though I set the alpha value of the background color to zero in the vector, the ImageFile object generates an opaque white background.

So could you please help me make the background transparent? Here is my VBScript code, which must be run with cscript.exe.
Note: This program requires Windows Image Acquisition (WIA) library v2.0 in order to create a .bmp image file. So it must be run on Window Vista or higher.

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

After running the code, you can test the transparency of the output image using this simple HTA:

<html>
<head>
<title>Test</title>
</head>
<body bgcolor="blue">
<img src="ellipse.bmp">
</body>
</html>

And you will see that a white box is displayed behind the ellipse, which indicates non-transparent background.

如果你对这篇内容有疑问，欢迎到本站社区发帖提问 参与讨论，获取更多帮助，或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论， 你可以免费 注册 一个本站的账号。

评论（1）

尴尬癌患者 2025-01-24 19:15:17

这可以通过使用argb过滤器来更改所有白色像素以透明并保存图像作为png文件来完成。不幸的是，这意味着通过每个像素进行迭代，因此您的脚本将需要两倍的运行时间。我找不到使用透明度创建初始图像的方法。参见在这里有关性能问题的信息。这是修订后的脚本：

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>

This can be done by using the ARGB filter to change all white pixels to transparent and saving the image as a PNG file. Unfortunately, this means iterating through every pixel, so your script will take twice as long to run. I could not find a way to create the initial image with transparency. See here for info regarding the performance issue. Here's the revised script:

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

Note: If you only need an ellipse in your HTA, it can be done instantly with 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>
回复 原文
~没有更多了~

关于作者

物价感观

暂无简介

文章
评论
26 人气
发私信

相关话题

更多

热门标签

操作系统 程序设计 IT运维 Linux系统管理 JavaScript 服务器应用 solaris C/C++ PHP Shell BSD Vue.js aix Oracle Python HTML 系统管理 HTML5 CSS 前端
更多

推荐作者

饮湿

文章 0 评论 0

明月

文章 0 评论 0

02

文章 0 评论 0

hs1283

文章 0 评论 0

风向决定发型

文章 0 评论 0

落花浅忆

文章 0 评论 0

更多

友情链接

文江博客
    我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站，即表示您同意使用 Cookies 和您的相关数据。
    原文