一个奇怪的图像灰度问题,高手请进,急啊!!!!!

ayuu 2003-05-07 12:52:10
我先将图像中某点(比如说0,0点)的灰度读取出来:
rgb1 = GetPixel(picbox.hdc, 0, 0)
bblue1 = Blue(rgb1)
bred1 = Red(rgb1)
bgreen1 = Green(rgb1)
grayvalue = 0.3 * bred1 + 0.59 * bgreen1 + 0.11 * bblue1'灰度

然后我希望使该点(0,0点)的灰度值提升2,于是:
SetPixelV hdc1, 0, 0, RGB(grayvalue+2,grayvalue+2,grayvalue+2)
SavePicture , App.Path & "\test.bmp"

但是,当我打开重新打开文件,发现,灰度并没有改变。
picbox.picture=loadpicture app.path & "\test.bmp"
rgb1 = GetPixel(picbox.hdc, 0, 0)
bblue1 = Blue(rgb1)
bred1 = Red(rgb1)
bgreen1 = Green(rgb1)
grayvalue = 0.3 * bred1 + 0.59 * bgreen1 + 0.11 * bblue1'灰度
此时的grayvalue还是等于以前的那个。


为什么啊????????
...全文
85 18 打赏 收藏 转发到动态 举报
写回复
用AI写文章
18 条回复
切换为时间正序
请发表友善的回复…
发表回复
ayuu 2003-05-08
  • 打赏
  • 举报
回复
多谢~:)
KiteGirl 2003-05-07
  • 打赏
  • 举报
回复
priBMP_ApplicData.baPixels()数组就是图片的所有像素数据。这个数组的每个元素都是一个 tpPixelRGB24。tpPixelRGB24这个类型有三个子变量rgbRed、rgbBlue、rgbGreen。

tIndex=X+Y*Width

priBMP_ApplicData.baPixels(tIndex)就是对应坐标的像素。

你想怎么收拾它就怎么收拾它。呵呵!

其实上面的程序本可以写得简单一些,不过我这个人很喜欢偷懒,总喜欢把许多数据包在一起包成一个大行李包扔来扔去的。

在form1.frm里有个

priBMP_ApplicData.baPixels(tIndex) = PixelAddBrightnes(priBMP_ApplicData.baPixels(tIndex), 50)

其中的50就是对图片一半的部分做了提升亮度处理,提升的亮度数值就是50/255。
KiteGirl 2003-05-07
  • 打赏
  • 举报
回复
上面关于Form1的部分有错误,补充Form1.frm的完整代码。

VERSION 5.00
Begin VB.Form Form1
AutoRedraw = -1 'True
Caption = "Form1"
ClientHeight = 5475
ClientLeft = 60
ClientTop = 345
ClientWidth = 6525
LinkTopic = "Form1"
ScaleHeight = 365
ScaleMode = 3 'Pixel
ScaleWidth = 435
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 255
Left = 5640
TabIndex = 1
Top = 120
Width = 855
End
Begin VB.TextBox Text1
Height = 270
Left = 120
TabIndex = 0
Text = "Text1"
Top = 120
Width = 735
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private priBMP_FileName As String
Private priBMP_ApplicData As tpBMP_Applic

Private Sub Command1_Click()
Dim tApplic As tpBMP_Applic
Dim tBitMapInfo As tpBitMapInfo

tBitMapInfo.bmiHeader = priBMP_ApplicData.baHeader.bhInfoHeader

Dim tX As Long
Dim tY As Long
Dim tC As Long

Dim tIndex As Long
Dim tIndexBase As Long

Dim tWidth As Long
Dim tHeight As Long

tWidth = priBMP_ApplicData.baHeader.bhInfoHeader.biWidth
tHeight = priBMP_ApplicData.baHeader.bhInfoHeader.biHeight

For tY = 0 To tHeight - 1
tIndexBase = tY * tWidth
For tX = 0 To tWidth - 1
tIndex = tX + tIndexBase
priBMP_ApplicData.baPixels(tIndex) = PixelAddBrightnes(priBMP_ApplicData.baPixels(tIndex), 50)
Next
Next

Text1.Text = BMP_Applic_ShowToForm(Form1, priBMP_ApplicData)
BMP_Applic_PutToFile "TestOut1.bmp", priBMP_ApplicData
End Sub

Private Sub Form_Load()
priBMP_ApplicData = BMP_Applic_GetByFile("Test.bmp")
End Sub

Private Sub Form_Resize()
Text1.Text = BMP_Applic_ShowToForm(Form1, priBMP_ApplicData)
End Sub
KiteGirl 2003-05-07
  • 打赏
  • 举报
回复
嘿嘿!不好意思,是我的亮度改变函数写错了。下面是刚刚写好的好使的新代码:

'Form1.frm内容:

Private Sub Command1_Click()
Dim tApplic As tpBMP_Applic
Dim tBitMapInfo As tpBitMapInfo

tBitMapInfo.bmiHeader = priBMP_ApplicData.baHeader.bhInfoHeader

Dim tX As Long
Dim tY As Long
Dim tC As Long

Dim tIndex As Long
Dim tIndexBase As Long

Dim tWidth As Long
Dim tHeight As Long

tWidth = priBMP_ApplicData.baHeader.bhInfoHeader.biWidth
tHeight = priBMP_ApplicData.baHeader.bhInfoHeader.biHeight

For tY = 0 To tHeight - 1
tIndexBase = tY * tWidth
For tX = 0 To tWidth - 1
tIndex = tX + tIndexBase
priBMP_ApplicData.baPixels(tIndex) = PixelAddBrightnes(priBMP_ApplicData.baPixels(tIndex), 50)
Next
Next

Text1.Text = BMP_Applic_ShowToForm(Form1, priBMP_ApplicData)
BMP_Applic_PutToFile "TestOut1.bmp", priBMP_ApplicData
End Sub

Private Sub Form_Load()
priBMP_ApplicData = BMP_Applic_GetByFile("Test.bmp")
End Sub

Private Sub Form_Resize()
Text1.Text = BMP_Applic_ShowToForm(Form1, priBMP_ApplicData)
End Sub

'BMP.bas模块内容

Attribute VB_Name = "Module1"
Public Type tpBitMapFileHeader
bfType As Integer
bfSize As Long
bfReserved1 As Integer
bfReserved2 As Integer
bfOffBits As Long
End Type

Public Type tpBitMapInfoHeader
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type

Public Type tpRGBQuad
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type

Public Type tpPixelRGB24
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
End Type

Public Type tpBitMapInfo
bmiHeader As tpBitMapInfoHeader
bmiColors As tpRGBQuad
End Type

Public Type tpBMP_FileHeader
bhFileHeader As tpBitMapFileHeader
bhInfoHeader As tpBitMapInfoHeader
End Type

Public Type tpBMP_Applic
baHeader As tpBMP_FileHeader
baPixels() As tpPixelRGB24
End Type

Public Declare Function StretchDIBits Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal wSrcWidth As Long, ByVal wSrcHeight As Long, lpBits As Any, lpBitsInfo As tpBitMapInfo, ByVal wUsage As Long, ByVal dwRop As Long) As Long

Public Const DIB_PAL_COLORS = 1

Public Const DIB_RGB_COLORS = 0

Public Const SRCCOPY = &HCC0020

Function BMP_Applic_ShowToForm(ByRef pForm As Form, ByRef pApplicData As tpBMP_Applic) As Long
'将一个BMP_Applic显示在一个Form里。
Dim tOutLng As Long

Dim tBitMapInfo As tpBitMapInfo
Dim tPixels() As tpPixelRGB24

Dim tDesWidth As Long
Dim tDesHeight As Long
Dim tSurWidth As Long
Dim tSurHeight As Long

tBitMapInfo.bmiHeader = pApplicData.baHeader.bhInfoHeader
tPixels() = pApplicData.baPixels()

tDesWidth = pForm.ScaleWidth
tDesHeight = pForm.ScaleHeight

tSurWidth = tBitMapInfo.bmiHeader.biWidth
tSurHeight = tBitMapInfo.bmiHeader.biHeight

pForm.AutoRedraw = True
tOutLng = StretchDIBits(pForm.hDC, 0, 0, tDesWidth, tDesHeight, 0, 0, tSurWidth, tSurHeight, tPixels(0), tBitMapInfo, 0, SRCCOPY)
pForm.AutoRedraw = False
pForm.Cls

BMP_Applic_ShowToForm = tOutLng
End Function

Function BMP_Applic_PutToFile(ByVal pFileName As String, ByRef pApplicData As tpBMP_Applic)
'将一个BMP_Applic储存成BMP文件
Dim tFileNumber As Integer

tFileNumber = FreeFile

Open pFileName For Binary As #tFileNumber

Put #tFileNumber, 1, pApplicData.baHeader
Put #tFileNumber, Len(pApplicData.baHeader) + 1, pApplicData.baPixels()

Close #tFileNumber
End Function

Function BMP_Applic_GetByFile(ByVal pFileName As String) As tpBMP_Applic
'从文件读取一个BMP_Applic
Dim tOutAny As tpBMP_Applic

Dim tFileNumber As Integer

tFileNumber = FreeFile

Open pFileName For Binary As #tFileNumber
Dim tWidth As Long
Dim tHeight As Long
Dim tPixelsCount As Long

Get #tFileNumber, 1, tOutAny.baHeader

tWidth = tOutAny.baHeader.bhInfoHeader.biWidth
tHeight = tOutAny.baHeader.bhInfoHeader.biHeight
tPixelsCount = (tWidth * tHeight) - 1

ReDim tOutAny.baPixels(tPixelsCount)

Get #tFileNumber, Len(tOutAny.baHeader) + 1, tOutAny.baPixels()

Close #tFileNumber

BMP_Applic_GetByFile = tOutAny
End Function

Function PixelAddBrightnes(ByRef pPixel As tpPixelRGB24, ByVal pBrightnes As Byte) As tpPixelRGB24
'将一个Pixel表示的像素增加(或减少)亮度。
Dim tOutPixel As tpPixelRGB24

Dim tR As Long, tG As Long, tB As Long

tOutPixel.rgbRed = DataRulesLockSeg_Long(CLng(pPixel.rgbRed) + pBrightnes, 0, 255)
tOutPixel.rgbGreen = DataRulesLockSeg_Long(CLng(pPixel.rgbGreen) + pBrightnes, 0, 255)
tOutPixel.rgbBlue = DataRulesLockSeg_Long(CLng(pPixel.rgbBlue) + pBrightnes, 0, 255)

PixelAddBrightnes = tOutPixel
End Function

Function DataRulesLockSeg_Long(ByVal pValue As Long, ByVal pMin As Long, ByVal pMax As Long) As Long
'保证一个值Value在Min和Max之间。
If pValue > pMax Then
DataRulesLockSeg_Long = pMax
ElseIf pValue < pMin Then
DataRulesLockSeg_Long = pMin
Else
DataRulesLockSeg_Long = pValue
End If
End Function
ayuu 2003-05-07
  • 打赏
  • 举报
回复
发现一个很严重的问题:

就是图像数据的保存。当我读取后再保存,数据竟然变了很多啊。怎么回事?

ayuu 2003-05-07
  • 打赏
  • 举报
回复
每次计算RGB颜色时,50是什么意思呀??

dwei 2003-05-07
  • 打赏
  • 举报
回复
异路同归!

两个方法都可以试试。

^_^
KiteGirl 2003-05-07
  • 打赏
  • 举报
回复
重要修改!!下面是临时修改好的新测试代码。原来的代码是800*600的常量测试代码。现在是根据图片尺寸的变量代码。还有更新的程序正在调试当中。
Private Sub Form_Load()
Dim tApplic As tpBMP_Applic
Dim tBitMapInfo As tpBitMapInfo

tApplic = BMP_Applic_GetByFile("Test7.bmp")
tBitMapInfo.bmiHeader = tApplic.baHeader.bhInfoHeader

Dim tX As Long
Dim tY As Long
Dim tC As Long

For tX = 0 To tApplic.baHeader.bhInfoHeader.biWidth
For tY = 0 To tApplic.baHeader.bhInfoHeader.biHeight \ 2
'tY = Cos(tX) * 100 + 50
Select Case tY
Case 0 To tApplic.baHeader.bhInfoHeader.biHeight
tC = tApplic.baPixels(tX + tY * tApplic.baHeader.bhInfoHeader.biWidth).rgbBlue + 50 * 0.11
If tC > 255 Then tC = 255
tApplic.baPixels(tX + tY * tApplic.baHeader.bhInfoHeader.biWidth).rgbBlue = tC
tC = tApplic.baPixels(tX + tY * tApplic.baHeader.bhInfoHeader.biWidth).rgbGreen + 50 * 0.5
If tC > 255 Then tC = 255
tApplic.baPixels(tX + tY * tApplic.baHeader.bhInfoHeader.biWidth).rgbGreen = tC
tC = tApplic.baPixels(tX + tY * tApplic.baHeader.bhInfoHeader.biWidth).rgbRed + 50 * 0.39
If tC > 255 Then tC = 255
tApplic.baPixels(tX + tY * tApplic.baHeader.bhInfoHeader.biWidth).rgbRed = tC

End Select
Next tY
Next

'Form1.Show

Form1.AutoRedraw = True
Text1.Text = StretchDIBits(Form1.hDC, 0, 0, Form1.ScaleWidth, Form1.ScaleHeight, 0, 0, tBitMapInfo.bmiHeader.biWidth, tBitMapInfo.bmiHeader.biHeight, tApplic.baPixels(0), tBitMapInfo, 0, SRCCOPY)
BMP_Applic_PutToFile "TestOut1.bmp", tApplic
'Form1.AutoRedraw = False
'Text1.Text = StretchDIBits(Form1.hDC, 0, 0, Form1.ScaleWidth, Form1.ScaleHeight, 0, 0, tBitMapInfo.bmiHeader.biWidth, tBitMapInfo.bmiHeader.biHeight, tApplic.baPixels(0), tBitMapInfo, 0, SRCCOPY)
'Form1.Cls
End Sub
KiteGirl 2003-05-07
  • 打赏
  • 举报
回复
你检查pFileName是不是指向一个有效的BMP图片,该图片必须是RGB的24Bit图片。如果你打开一个空文件必定出错!同时该图片应该是一个800*600或者640*480的尺寸,其他尺寸可能产生错位现象(原因上面已经说了)。

Open语句打开文件如果不存在会自动建立一个新文件,所以不会提示你出错信息。
Dickson 2003-05-07
  • 打赏
  • 举报
回复
纠正:
OPEN在不同文件时可用INPUT,WRITE,PUT三种语句写入。
ayuu 2003-05-07
  • 打赏
  • 举报
回复
ReDim tOutAny.baPixels(tPixelsCount)
出错,说下标越界。

调试程序发现,Get #tFileNumber, 1, tOutAny.baHeader

tWidth = tOutAny.baHeader.bhInfoHeader.biWidth
tHeight = tOutAny.baHeader.bhInfoHeader.biHeight
tPixelsCount = (tWidth * tHeight) - 1
都是空的,也就是根本没有读取到文件头信息啊。
应该是这个语句:Get #tFileNumber, 1, tOutAny.baHeader有问题。

期待解答,谢谢
KiteGirl 2003-05-07
  • 打赏
  • 举报
回复
关于以上程序的解释:

1、由于BMP图片要求是2的倍数。但是上述程序并没有加入这种功能。所以测试的时候尽量采用800*600、640*480。具体完善楼主自己像像吧。

2、API函数StretchDIBits仅仅是用来直观地显示图片的。它对整个图片处理过程没有任何作用。这个程序是个纯手工的代码。

3、BMP_Applic_PutToFile和BMP_Applic_GetByFile分别负责将tpBMP_Applic类型的数据从文件读取和写回。上面的程序仅仅提供了这两个核心函数。其他的具体处理代码还是需要自己动手去写的。

4、上述代码仅考虑了24Bit RGB非压缩格式的标准BMP图片。

5、tApplic.baPixels(tX + tY * 800).rgbGreen = tC这句当中,tX + tY * 800这个算式就是根据坐标计算像素地址的。标准写法是PixelAddress=X + Y * Width。这个所谓的像素地址仅仅是RGB24类型的像素数组的索引,并不是真正的字节地址。可以通过tApplic.baPixels(PixelAddress)去访问指定地址的像素。在这个程序当中,图象是以RGB24类型数组存在的数据而不是图片对象。
KiteGirl 2003-05-07
  • 打赏
  • 举报
回复
窗体文件Form1.frm

VERSION 5.00
Begin VB.Form Form1
AutoRedraw = -1 'True
Caption = "Form1"
ClientHeight = 5475
ClientLeft = 60
ClientTop = 345
ClientWidth = 6525
LinkTopic = "Form1"
ScaleHeight = 365
ScaleMode = 3 'Pixel
ScaleWidth = 435
StartUpPosition = 3 '窗口缺省
Begin VB.TextBox Text1
Height = 270
Left = 120
TabIndex = 0
Text = "Text1"
Top = 120
Width = 735
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Form_Load()
Dim tApplic As tpBMP_Applic
Dim tBitMapInfo As tpBitMapInfo

tApplic = BMP_Applic_GetByFile("Test.bmp")
tBitMapInfo.bmiHeader = tApplic.baHeader.bhInfoHeader

Dim tX As Long
Dim tY As Long
Dim tC As Long

For tX = 0 To 800
For tY = 0 To 200
'tY = Cos(tX) * 100 + 50
Select Case tY
Case 0 To tApplic.baHeader.bhInfoHeader.biHeight
tC = tApplic.baPixels(tX + tY * 800).rgbBlue + 50 * 0.11
If tC > 255 Then tC = 255
tApplic.baPixels(tX + tY * 800).rgbBlue = tC
tC = tApplic.baPixels(tX + tY * 800).rgbGreen + 50 * 0.5
If tC > 255 Then tC = 255
tApplic.baPixels(tX + tY * 800).rgbGreen = tC
tC = tApplic.baPixels(tX + tY * 800).rgbRed + 50 * 0.39
If tC > 255 Then tC = 255
tApplic.baPixels(tX + tY * 800).rgbRed = tC

End Select
Next tY
Next

'Form1.Show

Form1.AutoRedraw = True
Text1.Text = StretchDIBits(Form1.hDC, 0, 0, Form1.ScaleWidth, Form1.ScaleHeight, 0, 0, tBitMapInfo.bmiHeader.biWidth, tBitMapInfo.bmiHeader.biHeight, tApplic.baPixels(0), tBitMapInfo, 0, SRCCOPY)
BMP_Applic_PutToFile "TestOut1.bmp", tApplic
'Form1.AutoRedraw = False
'Text1.Text = StretchDIBits(Form1.hDC, 0, 0, Form1.ScaleWidth, Form1.ScaleHeight, 0, 0, tBitMapInfo.bmiHeader.biWidth, tBitMapInfo.bmiHeader.biHeight, tApplic.baPixels(0), tBitMapInfo, 0, SRCCOPY)
'Form1.Cls
End Sub

模块文件BMP.bas

Attribute VB_Name = "Module1"
Public Type tpBitMapFileHeader
bfType As Integer
bfSize As Long
bfReserved1 As Integer
bfReserved2 As Integer
bfOffBits As Long
End Type

Public Type tpBitMapInfoHeader
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type

Public Type tpRGBQuad
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type

Public Type tpPixelRGB24
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
End Type

Public Type tpBitMapInfo
bmiHeader As tpBitMapInfoHeader
bmiColors As tpRGBQuad
End Type

Public Type tpBMP_FileHeader
bhFileHeader As tpBitMapFileHeader
bhInfoHeader As tpBitMapInfoHeader
End Type

Public Type tpBMP_Applic
baHeader As tpBMP_FileHeader
baPixels() As tpPixelRGB24
End Type

Public Declare Function StretchDIBits Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal wSrcWidth As Long, ByVal wSrcHeight As Long, lpBits As Any, lpBitsInfo As tpBitMapInfo, ByVal wUsage As Long, ByVal dwRop As Long) As Long

Public Const DIB_PAL_COLORS = 1

Public Const DIB_RGB_COLORS = 0

Public Const SRCCOPY = &HCC0020

Function BMP_Applic_PutToFile(ByVal pFileName As String, ByRef pApplicData As tpBMP_Applic)
Dim tFileNumber As Integer

tFileNumber = FreeFile

Open pFileName For Binary As #tFileNumber

Put #tFileNumber, 1, pApplicData.baHeader
Put #tFileNumber, Len(pApplicData.baHeader) + 1, pApplicData.baPixels()

Close #tFileNumber
End Function

Function BMP_Applic_GetByFile(ByVal pFileName As String) As tpBMP_Applic
Dim tOutAny As tpBMP_Applic

Dim tFileNumber As Integer

tFileNumber = FreeFile

Open pFileName For Binary As #tFileNumber
Dim tWidth As Long
Dim tHeight As Long
Dim tPixelsCount As Long

Get #tFileNumber, 1, tOutAny.baHeader

tWidth = tOutAny.baHeader.bhInfoHeader.biWidth
tHeight = tOutAny.baHeader.bhInfoHeader.biHeight
tPixelsCount = (tWidth * tHeight) - 1

ReDim tOutAny.baPixels(tPixelsCount)

Get #tFileNumber, Len(tOutAny.baHeader) + 1, tOutAny.baPixels()

Close #tFileNumber

BMP_Applic_GetByFile = tOutAny
End Function
ayuu 2003-05-07
  • 打赏
  • 举报
回复
谢谢,期待中!!
KiteGirl 2003-05-07
  • 打赏
  • 举报
回复
有两个办法,但两个办法都是采用Open语句打开文件,Get语句读取数据,Put语句写数据。

这里我大概说一下思路,但详细的精确写入文件像素的程序我稍后编出来写给你。

图象本身是一个矩阵,而这个二维矩阵其实存储在文件当中是个一维的地址。只要你知道图象的宽度,就可以计算出指定坐标的地址。最基本的地址计算是这样的:

像素地址=Y*Width+X
存储地址=坐标地址*色深+偏移量

在BMP文件当中,坐标地址是反的。也就是最后一个像素减去当前像素才是。

如果你听不懂,稍后我会写出一个函数提供给你。
ayuu 2003-05-07
  • 打赏
  • 举报
回复
怎么样才可以读取文件里的信息,并且写到文件里呢?

能不能说具体点?谢谢。
KiteGirl 2003-05-07
  • 打赏
  • 举报
回复
你这个办法我真是狂晕,至于这样麻烦吗?

只要你直接修改文件里的像素就可以了。

Public Type tpBitMapFileHeader
bfType As Integer
bfSize As Long
bfReserved1 As Integer
bfReserved2 As Integer
bfOffBits As Long
End Type

Public Type tpBitMapInfoHeader
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type

Public Type tpBitMapHeader
bhFileHeader As tpBitMapFileHeader
bhInfoHeader As tpBitMapInfoHeader
End Type

先从tpBitMapInfoHeader里得到Width和Height,然后定义一个RGB数组。RGB类型是这样定义的:

Type tpRGB24
Blue As Byte
Green As Byte
Red As Byte
End Type

然后定义数组

Dim sysPixs(Width,Height) As tpRGB24

接着你从文件里读取数组。然后可以这样。

L=2
sysPixs(X,Y).Blue=sysPixs(X,Y).Green+0.11*L
sysPixs(X,Y).Green=sysPixs(X,Y).Green+0.59*L
sysPixs(X,Y).Red=sysPixs(X,Y).Green+0.3*L

接着写到文件里就可以了。
用户 昵称 2003-05-07
  • 打赏
  • 举报
回复
easy

SetPixelV hdc1, 0, 0, RGB(grayvalue+2,grayvalue+2,grayvalue+2)
....
picture1.autoredraw=true
set picture1.picture=picture1.image
SavePicture , App.Path & "\test.bmp"

7,763

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧