注册 登录
编程论坛 → VB6论坛

VBS生成BMP位图无法准确的指定大小，如何修正？

yuma 发布于 2023-12-22 10:37， 2023 次点击
' 图片宽度和高度
imgWidth = 100
imgHeight = 200

' 计算图像数据的大小
imgDataSize = imgWidth * imgHeight * 3

' 创建 BMP 文件头
bmpHeader = Chr(66) & Chr(77) & _
            Chr(imgDataSize And 255) & _
            Chr((imgDataSize \ 256) And 255) & _
            Chr(((imgDataSize \ 256) \ 256) And 255) & _
            Chr((((imgDataSize \ 256) \ 256) \ 256) And 255) & _
            Chr(0) & Chr(0) & Chr(0) & Chr(0) & _
            Chr(54) & Chr(0) & Chr(0) & Chr(0) & _
            Chr(40) & Chr(0) & Chr(0) & Chr(0) & _
            Chr(imgWidth And 255) & Chr((imgWidth \ 256) And 255) & _
            Chr(0) & Chr(0) & _
            Chr(imgHeight And 255) & Chr((imgHeight \ 256) And 255) & _
            Chr(0) & Chr(0) & _
            Chr(1) & Chr(0) & _
            Chr(24) & Chr(0) & _
            Chr(0) & Chr(0) & _
            Chr(0) & Chr(0) & _
            Chr(0) & Chr(0) & _
            Chr(0) & Chr(0) & _
            Chr(0) & Chr(0)

' 创建图像数据
' 这里仅是一个示例，将图像数据设置为彩虹
imageData = ""
For i = 1 To imgHeight
    For j = 1 To imgWidth
        ' BMP 中的像素数据是 BGR 格式
        imageData = imageData & Chr(i Mod 256) & Chr((i + j) Mod 256) & Chr(j Mod 256)
    Next
Next

' 将图像数据添加到 BMP 文件头后面
bmpData = bmpHeader & imageData

' 将 BMP 数据写入文件
Dim fs, outFile
Set fs = CreateObject("Scripting.FileSystemObject")
Set outFile = fs.CreateTextFile("output.bmp", True)
outFile.Write bmpData
outFile.Close
5 回复
#2
冬瓜汤2023-12-22 12:09
回复 楼主 yuma
VB、VBA、VBS简易的图像处理 Windows Image Acquisition (WIA) 的用法

二、裁剪滤镜：裁剪图片
Dim Img 'As ImageFile
Dim IP 'As ImageProcess
Set Img = CreateObject("WIA.ImageFile")
Set IP = CreateObject("WIA.ImageProcess")
Img.LoadFile "C:\WINDOWS\Web\Wallpaper\Bliss.bmp"
IP.Filters.Add IP.FilterInfos("Crop").FilterID
IP.Filters(1).Properties("Left") = Img.Width \ 4
IP.Filters(1).Properties("Top") = Img.Height \ 4
IP.Filters(1).Properties("Right") = Img.Width \ 4
IP.Filters(1).Properties("Bottom") = Img.Height \ 4
Set Img = IP.Apply(Img)
Img.SaveFile "C:\WINDOWS\Web\Wallpaper\BlissCrop.bmp"

三、缩放滤镜：调整图像的大小
Dim Img 'As ImageFile
Dim IP 'As ImageProcess
Set Img = CreateObject("WIA.ImageFile")
Set IP = CreateObject("WIA.ImageProcess")
Img.LoadFile "C:\WINDOWS\Web\Wallpaper\Bliss.bmp"
IP.Filters.Add IP.FilterInfos("Scale").FilterID
IP.Filters(1).Properties("MaximumWidth") = 100
IP.Filters(1).Properties("MaximumHeight") = 100
Set Img = IP.Apply(Img)
Img.SaveFile "C:\WINDOWS\Web\Wallpaper\BlissThumb.bmp"


注：不太清楚 楼主的意图，只能简单地认为你是为了简易处理图像。

[此贴子已经被作者于2023-12-22 12:10编辑过]
#3
apull2023-12-22 17:14
bmpHeader 声明为数组了设置各元素，元素用CByte转换，Chr转换后都是问号，问号3F导致尺寸不对。
写文件可以用ADODB.Stream二进制模式。

[此贴子已经被作者于2023-12-22 18:54编辑过]
#4
yuma2023-12-22 17:31
以下是引用冬瓜汤在2023-12-22 12:09:01的发言：

VB、VBA、VBS简易的图像处理 Windows Image Acquisition (WIA) 的用法

二、裁剪滤镜：裁剪图片
Dim Img 'As ImageFile
Dim IP 'As ImageProcess
Set Img = CreateObject("WIA.ImageFile")
Set IP = CreateObject("WIA.ImageProcess")
Img.LoadFile "C:\WINDOWS\Web\Wallpaper\Bliss.bmp"
IP.Filters.Add IP.FilterInfos("Crop").FilterID
IP.Filters(1).Properties("Left") = Img.Width \ 4
IP.Filters(1).Properties("Top") = Img.Height \ 4
IP.Filters(1).Properties("Right") = Img.Width \ 4
IP.Filters(1).Properties("Bottom") = Img.Height \ 4
Set Img = IP.Apply(Img)
Img.SaveFile "C:\WINDOWS\Web\Wallpaper\BlissCrop.bmp"

三、缩放滤镜：调整图像的大小
Dim Img 'As ImageFile
Dim IP 'As ImageProcess
Set Img = CreateObject("WIA.ImageFile")
Set IP = CreateObject("WIA.ImageProcess")
Img.LoadFile "C:\WINDOWS\Web\Wallpaper\Bliss.bmp"
IP.Filters.Add IP.FilterInfos("Scale").FilterID
IP.Filters(1).Properties("MaximumWidth") = 100
IP.Filters(1).Properties("MaximumHeight") = 100
Set Img = IP.Apply(Img)
Img.SaveFile "C:\WINDOWS\Web\Wallpaper\BlissThumb.bmp"


注：不太清楚 楼主的意图，只能简单地认为你是为了简易处理图像。



不是让你处理BMP图片，而是让你直接创建一个指定大小的BMP文件，从无到有。
#5
冬瓜汤2023-12-23 09:45
回复 4楼 yuma
如果是从无到有，那有那么多的c/c++大名鼎鼎的图形库（如gdi+,cairo等）可以使用。vbrichclient6里面有完整的cairo的封装，一般图形设计使用是绰绰有余了（除非你有很高的艺术天份，要艺术创作，嘿嘿）。
如果你不喜欢vbrichclient6，你最好打上vb6的cdecl补丁（它非常非常重要！！！），自己声明cairo的函数。
例如：
Option Explicit

Private Declare Function cairo_win32_surface_create CDecl Lib "cairo.dll" ( _
                         ByVal hDc As OLE_HANDLE) As OLE_HANDLE
Private Declare Function cairo_create CDecl Lib "cairo.dll" ( _
                         ByVal pSurface As OLE_HANDLE) As OLE_HANDLE
Private Declare Sub cairo_set_line_width CDecl Lib "cairo.dll" ( _
                    ByVal pCr As OLE_HANDLE, _
                    ByVal dValue As Double)
Private Declare Sub cairo_set_source_rgb CDecl Lib "cairo.dll" ( _
                    ByVal pCr As OLE_HANDLE, _
                    ByVal dR As Double, _
                    ByVal dG As Double, _
                    ByVal dB As Double)
Private Declare Sub cairo_rectangle CDecl Lib "cairo.dll" ( _
                    ByVal pCr As OLE_HANDLE, _
                    ByVal dX As Double, _
                    ByVal dY As Double, _
                    ByVal dW As Double, _
                    ByVal dH As Double)
Private Declare Sub cairo_stroke CDecl Lib "cairo.dll" ( _
                    ByVal pCr As OLE_HANDLE)
Private Declare Sub cairo_destroy CDecl Lib "cairo.dll" ( _
                    ByVal pCr As OLE_HANDLE)
Private Declare Sub cairo_surface_destroy CDecl Lib "cairo.dll" ( _
                    ByVal pSurface As OLE_HANDLE)

……

总之，有很多大名鼎鼎的c/c++图形库是可以利用的，这才是正确的使用之道。


[此贴子已经被作者于2023-12-23 09:47编辑过]
#6
风吹过b2023-12-23 19:24
操作 BMP ，需要使用 二进制 数据，定义为 byte ，直接转换成 字符串，会出问题。
另外，你代码中没有进行对齐处理处理，所以那怕是使用的 byte 数据操作，都可能导致图像文件无效。
1
©2024, BCCN.NET
电脑版