VB图像处理！怎么样用VB实现两张图片两张图片叠加生成一张新图片！！

[老北漂]

VB图像处理！怎么样用VB实现两张图片两张图片叠加生成一张新图片！！

[三杯倒]

1111

[wizbear]

用柯达控件，功能很强大，用一句话形容：“只有想不到的，没有做不到的”

[cuiyxy]

主　　题：请问如何将2幅图片加载到内存中进行处理然后显示在PICTUREBOX上！
作　　者：textstar
所属论坛：Visual Basic
问题点数：50
回复次数：9
发表时间：2001-8-19 21:34:43


例如要将两幅图片进行合并，如果通过在PICTUREBOX中进行处理速度很慢，是否可以先载如内存处理完后再在PICTUREBOX中显示呢？


回复贴子：
回复人：　charset(神奈川)　(2001-8-19 21:38:46) 得0分
50分呢！用BITBLT。
给我5分我再向下说。
我在CSDN里回答了好多可是没有分
这次要留个心眼……
用BitBlt进行对DC的操作。
回复人：　charset(神奈川)　(2001-8-19 21:44:47) 得0分
我前几天才知道的一种很快的办法！
LoadImage 和CreateCompatibleDC
CreateCompatibleBitmap
SelectObject
DeleteDC
DeleteObject
的确很快、很稳定！
回复人：　sssa2000()　(2001-8-19 22:28:45) 得0分
loadimage createcompatibleDC ........
能说一下详细用法吗？

我觉得还是用 bitblt,还有 rea*(我记不太清了） 是用来释放内存的，这两个函数要配合使用，明天再告书你吧，记得给我加分呀。
回复人：　wxj_lake(蔚蓝的风)　(2001-8-19 23:05:44) 得0分
图片进行合并？拿去看一下


Public Declare Function AlphaBlend Lib "msimg32" (ByVal hdcDest As Long, _
ByVal nXOriginDest As Long, ByVal nYOriginDest As Long, _
ByVal nWidthDest As Long, ByVal hHeightDest As Long, _
ByVal hdcSrc As Long, ByVal nXOriginSrc As Long, _
ByVal nYOriginSrc As Long, ByVal nWidthSrc As Long, _
ByVal nHeightSrc As Long, ByVal blendFunc As Long) As Boolean
'以上是module中的声明

'在Pic(1)中画渐变色
Private Sub Command1_Click()
Dim i As Long, j As Long

Pic(1).Cls
For i = 0 To Pic(1).ScaleWidth - 1
For j = 0 To Pic(1).ScaleHeight - 1
Pic(1).PSet (i, j), RGB(Fix(i * 255 / Pic(1).ScaleWidth), _
0, 255 - Fix(j * 255 / Pic(1).ScaleHeight))
Next
Pic(1).Refresh
Next
End Sub

'合并Pic(0)和Pic(1)的图像
Private Sub Command2_Click()
Dim SourceConstantAlpha As Long, r As Byte, StrRes As String

StrRes = InputBox("Give a number from 0 to 255 (the greater the " + _
"value the farest you get from the clouds):", _
"Alpha blend example...", 100)

If StrRes = "" Then Exit Sub

r = CLng(StrRes) Mod 256

SourceConstantAlpha = r * 65536
Pic(0).Cls
Call AlphaBlend(Pic(0).hDC, 0, 0, Pic(0).ScaleWidth, Pic(0).ScaleHeight, _
Pic(1).hDC, 0, 0, Pic(1).ScaleWidth, Pic(1).ScaleHeight, _
SourceConstantAlpha)
Pic(0).Refresh
End Sub

回复人：　wxj_lake(蔚蓝的风)　(2001-8-19 23:15:58) 得0分
如果一定要VB代码作合并，会慢一些。看看这个是半透明的窗体，VB即时混合的

'模块中的代码
Option Explicit

Public Type BITMAPINFOHEADER
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 RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type

Public Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End Type

Public 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
Public Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Public Declare Function SetDIBits Lib "gdi32" (ByVal hdc As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Public Declare Function SetDIBitsToDevice 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 Scan As Long, ByVal NumScans As Long, Bits As Any, BitsInfo As BITMAPINFO, ByVal wUsage As Long) As Long
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Public Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Public Function ShadeColors(ByVal Dst As Long, ByVal Src As Long, ByVal Shade As Byte)
Select Case Shade
Case 0: ShadeColors = Dst
Case 255: ShadeColors = Src
Case Else:
ShadeColors = (Src And &HFF) * Shade / 255 + (Dst And &HFF) * (255 - Shade) / 255 Or _
((Src And &HFF00&) * Shade / 255 + (Dst And &HFF00&) * (255 - Shade) / 255) And &HFF00& Or _
((Src And &HFF0000) * (Shade / 255) + (Dst And &HFF0000) * ((255 - Shade) / 255)) And &HFF0000
End Select
End Function

Public Function AlphaBlend(ByVal DstDC As Long, ByVal DstX As Long, ByVal DstY As Long, ByVal DstW As Long, ByVal DstH As Long, ByVal SrcDC As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal Alpha As Byte, ByVal TransColor As Long, ByVal Flags As Long) As Long
If Alpha = 0 Or DstW = 0 Or DstH = 0 Then Exit Function
Dim B As Long, H As Long, F As Long, I As Long
Dim TmpDC As Long, TmpBmp As Long, TmpObj As Long
Dim Sr2DC As Long, Sr2Bmp As Long, Sr2Obj As Long
Dim Data1() As Long, Data2() As Long
Dim Info As BITMAPINFO


TmpDC = CreateCompatibleDC(SrcDC)
Sr2DC = CreateCompatibleDC(SrcDC)
TmpBmp = CreateCompatibleBitmap(DstDC, DstW, DstH)
Sr2Bmp = CreateCompatibleBitmap(DstDC, DstW, DstH)
TmpObj = SelectObject(TmpDC, TmpBmp)
Sr2Obj = SelectObject(Sr2DC, Sr2Bmp)
ReDim Data1(DstW * DstH * 4 - 1)
ReDim Data2(DstW * DstH * 4 - 1)
Info.bmiHeader.biSize = Len(Info.bmiHeader)
Info.bmiHeader.biWidth = DstW
Info.bmiHeader.biHeight = DstH
Info.bmiHeader.biPlanes = 1
Info.bmiHeader.biBitCount = 32
Info.bmiHeader.biCompression = 0

BitBlt TmpDC, 0, 0, DstW, DstH, DstDC, DstX, DstY, vbSrcCopy
BitBlt Sr2DC, 0, 0, DstW, DstH, SrcDC, SrcX, SrcY, vbSrcCopy
GetDIBits TmpDC, TmpBmp, 0, DstH, Data1(0), Info, 0
GetDIBits Sr2DC, Sr2Bmp, 0, DstH, Data2(0), Info, 0

For H = 0 To DstH - 1
F = H * DstW
For B = 0 To DstW - 1
I = F + B
If (Flags And &H1) And ((Data2(I) And &HFFFFFF) = TransColor) Then
Else
Data1(I) = ShadeColors(Data1(I), Data2(I), Alpha)
End If
Next B
Next H

SetDIBitsToDevice DstDC, DstX, DstY, DstW, DstH, 0, 0, 0, DstH, Data1(0), Info, 0

Erase Data1
Erase Data2
DeleteObject SelectObject(TmpDC, TmpObj)
DeleteObject SelectObject(Sr2DC, Sr2Obj)
DeleteDC TmpDC
DeleteDC Sr2DC
End Function
'----------------------------------------

'窗体中的代码
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 GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Dim CurX As Single, CurY As Single
Dim WH As Long, WD As Long

Dim TPPX As Integer
Dim TPPY As Integer

Private Sub Form_Load()
Picture3.Picture = LoadPicture("back.bmp")
Width = Picture3.Width
Height = Picture3.Height
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Picture1_MouseDown Button, Shift, x, y
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Picture1_MouseMove Button, Shift, x, y
End Sub

Private Sub Image1_Click()
Me.WindowState = vbMinimized
End Sub

Private Sub Image2_Click()
Unload Me
End Sub

Private Sub Image3_Click()
MsgBox "Test"
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbLeftButton Then
CurX = x
CurY = y
End If
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim DeltaX As Long, DeltaY As Long
Dim WH As Long, WD As Long
If Button = 1 Then
WH = GetDesktopWindow
WD = GetDC(WH)
DeltaX = x - CurX
DeltaY = y - CurY
BitBlt Picture2.hdc, 0, 0, ScaleWidth \ TPPX, ScaleHeight \ TPPY, Picture2.hdc, DeltaX \ TPPX, DeltaY \ TPPY, vbSrcCopy
If DeltaX > 0 Then
BitBlt Picture2.hdc, (ScaleWidth - DeltaX) \ TPPX, 0, DeltaX \ TPPX, ScaleHeight \ TPPY, WD, (Left + Width) \ TPPX, (Top + DeltaY) \ TPPX, vbSrcCopy
ElseIf DeltaX < 0 Then
BitBlt Picture2.hdc, 0, 0, -DeltaX \ TPPX, ScaleHeight \ TPPY, WD, (Left + DeltaX) \ TPPX, (Top + DeltaY) \ TPPY, vbSrcCopy
End If
If DeltaY > 0 Then
BitBlt Picture2.hdc, 0, (ScaleHeight - DeltaY) \ TPPY, ScaleWidth \ TPPX, DeltaY \ TPPY, WD, (Left + DeltaX) \ TPPX, (Top + Height) \ TPPY, vbSrcCopy
ElseIf DeltaY < 0 Then
BitBlt Picture2.hdc, 0, 0, ScaleWidth \ TPPX, -DeltaY \ TPPY, WD, (Left + DeltaX) \ TPPX, (Top + DeltaY) \ TPPY, vbSrcCopy
End If
'Picture2.Refresh
BitBlt Picture1.hdc, 0, 0, ScaleWidth \ TPPX, ScaleHeight \ TPPY, Picture2.hdc, 0, 0, vbSrcCopy
AlphaBlend Picture1.hdc, 0, 0, ScaleWidth \ TPPX, ScaleHeight \ TPPY, Picture3.hdc, 0, 0, 128, &HFF00FF, 1
Move Left + DeltaX, Top + DeltaY
Picture1.Refresh
BitBlt Me.hdc, 0, 0, ScaleWidth \ TPPX, ScaleHeight \ TPPY, Picture1.hdc, 0, 0, vbSrcCopy
ReleaseDC WH, WD
End If
End Sub

Private Sub Form_Resize()
TPPX = Screen.TwipsPerPixelX
TPPY = Screen.TwipsPerPixelY
Picture1.Move 0, 0, Width, Height
Picture2.Move 0, 0, Width, Height
WH = GetDesktopWindow
WD = GetDC(WH)
BitBlt Picture2.hdc, 0, 0, ScaleWidth \ TPPX, ScaleHeight \ TPPY, WD, Left \ TPPX, Top \ TPPY, vbSrcCopy
BitBlt Picture1.hdc, 0, 0, ScaleWidth \ TPPX, ScaleHeight \ TPPY, Picture2.hdc, 0, 0, vbSrcCopy

AlphaBlend Picture1.hdc, 0, 0, ScaleWidth \ TPPX, ScaleHeight \ TPPY, Picture3.hdc, 0, 0, 128, &HFF00FF, 1
ReleaseDC WH, WD
End Sub

回复人：　jixian(极限)　(2001-8-20 1:26:26) 得0分
.....@.......
回复人：　textstar(小熊)　(2001-8-20 22:12:13) 得0分
to charset(神奈川):你能告诉我你的方法吗？分数吗可以给啊，我很讲信誉的！
另外谢谢　wxj_lake(蔚蓝的风)　你给我的代码我试一下，看看行不行，一定给分！
回复人：　charset(神奈川)　(2001-8-21 9:28:28) 得0分
'不用PictureBox和其他控件的方法！一级棒！
Public 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

Public 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

Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long

Public Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long

Public Declare Function LoadBitmap Lib "user32" Alias "LoadBitmapA" (ByVal hInstance As Long, ByVal lpBitmapName As String) As Long

Public Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long

Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long

Public Const SRCAND = &H8800C6
Public Const SRCCOPY = &HCC0020
Public Const SRCERASE = &H440328
Public Const SRCINVERT = &H660046
Public Const SRCPAINT = &HEE0086
Public Const BLACKNESS = &H42
Public Const WHITENESS = &HFF0062

Public Const LR_LOADFROMFILE = &H10
Public Const IMAGE_BITMAP = 0
Const IMAGE_ICON = 1
Const IMAGE_CURSOR = 2
Const IMAGE_ENHMETAFILE = 3
Const CF_BITMAP = 2

Public Function LoadBitmap2DC(hDC As Long, ByVal PicturePath As String, Optional ByVal nWidth As Long, Optional ByVal nHeight As Long) As Long
Dim PicPath As String
PicPath = PicturePath
Dim hBitmap As Long
hBitmap = LoadImage(0, PicPath, IMAGE_BITMAP, nWidth, nHeight, LR_LOADFROMFILE)
If hBitmap = 0 Then
LoadBitmap2DC = hBitmap
Exit Function
End If
hDC = CreateCompatibleDC(0)
SelectObject hDC, hBitmap
DeleteObject hBitmap
LoadBitmap2DC = -1
End Function

Public Sub CreateBlackness(hDC as long,ByVal nWidth as long,Byval nHeight as long)
hDC = CreateCompatibleDC(0)
Dim hBitmap As Long
hBitmap = CreateCompatibleBitmap(hDC, 100, 100)
SelectObject hDC, hBitmap
BitBlt hDC, 0, 0, 100, 100, 0, 0, 0, BLACKNESS
DeleteObject hBitmap
End Sub

'你用CREATEBLACKNESS造个可以容纳两个图片的大小的HDC
'在这里是两个图片横放
CREATEBLACKNESS(hBlackness,p1Width+p2Width,p1Height)
dim p1Path As String
dim p2Path as string
p1path=app.path &"p1.bmp"
p2path=app.path &"p2.bmp"
LoadBitmap2DC Hpic1DC,p1path
loadbitmap2DC Hpic2DC,p2path
'不可以LoadBitmap2DC hDC,app.path &"some.bmp"
'这样会出错
bitblt MainDC,0,0,p1Width,p1Height,hpic1DC,0,0,srccopy
bitblt Maindc,p1Width,0,p2Width,p2Height,hpic2dc,0,0,srccopy
'在MainDC里就是两副图片的东西。
'最后不要忘了把DC们都DELETEDC
'谢谢你的赏光，有空多联系：[e-mail]

[老北漂]

如何用VB做一个图片上传的控件，用户每次上传图片时自动的为图片加上一个我自己的水印。请多多指教!！我现在最多只能加72分，请多多原谅！！谢谢！！