to kevin_qing 请关注
我最近在做图形处理,用vb但是,我用了pset,biblt,setpixel等方法处理图像三原色
但是,处理后的图片很不清晰,有马赛克.我请教了很多人,最后大家想我推荐您,
冒昧发信至此,请帮我一把,我在csdn的vb版的,很多天一直再问这个问题,但是
大多说是颜色设置错误,可是我一直没有真正的方法,希望能给与帮助
以下是我的代码
Option Explicit
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
'Constants for the GenerateDC function
'**LoadImage Constants**
Const IMAGE_BITMAP As Long = 0
'*****************"""""""""""""""""""
Const LR_LOADFROMFILE As Long = &H10
Const LR_CREATEDIBSECTION As Long = &H2000
'"""""""""""""""""""""""""""""""""""""""""
Const LR_DEFAULTCOLOR As Long = &H0
Const LR_COLOR As Long = &H2
'****************************************
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Dim BitmapImage As Long 'Bitmap DC
Dim bm As BITMAP 'bitmap structure
Dim hbm As Long 'Bitmap handle
Dim OriginalBits() As Byte
Dim BitmapWidth As Long
Dim BitmapHeight As Long
'IN: FileName: The file name of the graphics
' BitmapHandle: The receiver of the loaded bitmap handle
'OUT: The Generated DC
Public Function GenerateDC(FileName As String, ByRef BitmapHandle As Long) As Long
Dim DC As Long
Dim hBitmap As Long
'Create a Device Context, compatible with the screen
DC = CreateCompatibleDC(0)
If DC < 1 Then
GenerateDC = 0
'Raise error
Err.Raise vbObjectError + 1
Exit Function
End If
'Load the image....BIG NOTE: This function is not supported under NT, there you can not
'specify the LR_LOADFROMFILE flag
hBitmap = LoadImage(0, FileName, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_CREATEDIBSECTION)
If hBitmap = 0 Then 'Failure in loading bitmap
DeleteDC DC
GenerateDC = 0
'Raise error
Err.Raise vbObjectError + 2
Exit Function
End If
'Throw the Bitmap into the Device Context
SelectObject DC, hBitmap
'Return the device context and handle
BitmapHandle = hBitmap
GenerateDC = DC
End Function
'Deletes a generated DC
Private Function DeleteGeneratedDC(DC As Long) As Long
If DC > 0 Then
DeleteGeneratedDC = DeleteDC(DC)
Else
DeleteGeneratedDC = 0
End If
End Function
''''''''''''''''''''''''''''''''''
Private Sub HScroll1_Change()
Dim BitmapWidthBytes As Long
Dim ByteArray() As Byte
ReDim ByteArray(1 To bm.bmWidthBytes, 1 To bm.bmHeight)
Dim i As Long, j As Long
Dim IJOri As Long
Dim I1JOri As Long
Dim I2JOri As Long
Dim ijres
Text1.Text = HScroll1.Value
colorr = HScroll1.Value
For i = 1 To bm.bmWidthBytes Step 3
For j = 1 To bm.bmHeight
IJOri = OriginalBits(i, j) - colorr
If IJOri < 0 Then IJOri = 0
If IJOri > 255 Then IJOri = 255
I1JOri = OriginalBits(i + 1, j) - colorg
If I1JOri < 0 Then I1JOri = 0
If I1JOri > 255 Then I1JOri = 255
I2JOri = OriginalBits(i + 2, j) - colorb
If I2JOri < 0 Then I2JOri = 0
If I2JOri > 255 Then I2JOri = 255
ByteArray(i, j) = IJOri
ByteArray(i + 1, j) = I1JOri
ByteArray(i + 2, j) = I2JOri
Next j
Next i
SetBitmapBits hbm, bm.bmWidthBytes * bm.bmHeight, ByteArray(1, 1)
Picture2.AutoRedraw = True
BitBlt Picture2.hdc, 0, 0, Picture2.Width, Picture2.Height, BitmapImage, 0, 0, vbSrcCopy
'Picture2.AutoRedraw = False
SavePicture Picture2.Image, App.Path + "\tem.bmp"
回复贴子：
回复人：liusuanse(菜鸟一) (2001-7-14 12:50:20) 得0分
关注
回复人：liusuanse(菜鸟一) (2001-7-14 13:01:22) 得0分
UP!!
问题还没解决
请各位在关注,
SetGrayBitmap方法产生很多马赛克
是不是我参数错误
我用BIBLT也是,还是颜色处理方法部队??
回复人：enmity(真我的风采) (2001-7-14 13:13:27) 得0分
应该是颜色取值有问题
回复人：liusuanse(菜鸟一) (2001-7-14 13:31:03) 得0分
老哥
听你说很多遍了
可是我还是不会
教教我了
应该是那个参数??
问题点数：20、回复次数：5Top
1 楼c_z_y（用力）回复于 2001-07-14 15:53:49 得分 0
产生马赛克是很正常的！放大图片以后肯定会有马赛克，除非你自己做2次线性过滤之类的算法！Top
2 楼c_z_y（用力）回复于 2001-07-14 16:03:05 得分 0
vc中使用StretchBlt vb中就不知道了！Top
3 楼Kevin_qing（）回复于 2001-08-03 11:32:23 得分 20
StretchBlt在2000下面可以使用SetStretchBltMode的参数HALFTONE来使用插值
VB代码不太会看，给你一个伪码，自己改成你像要的东西了Top
4 楼Kevin_qing（）回复于 2001-08-03 11:44:18 得分 0
你的这个代码是干什么事情的？
Top
5 楼liusuanse（真心人）回复于 2001-08-13 20:16:40 得分 0
谢谢： Kevin_qing(Kevin) 热情回复,好久不来了,没有回答,非常抱歉,一会结分Top
