Asp组件高级入门与精通系列之二

'按照指定大小创建一幅与设备有关位图
Dim hmD As Long
hmD = CreateCompatibleBitmap(hdcSrc, vw * iRate, vh * iRate)
SelectObject hdcDest, hmD

'处理伸缩模式
Dim lOrigMode As Long
Dim lRet As Long
lOrigMode = SetStretchBltMode(hdcDest, STRETCH_HALFTONE)
'按照比例缩放
StretchBlt hdcDest, 0, 0, vw * iRate, vh * iRate, hdcSrc, 0, 0, vw, vh, SRCCOPY

'恢复以前的设置
lRet = SetStretchBltMode(hdcDest, lOrigMode)

'生成jpeg文件
SaveJPG hmD, filename

'删除设备场景
DeleteDC hdcDest
DeleteDC hdcSrc
'删除位图对象
DeleteObject nn
DeleteObject hFont
DeleteObject hmD

End Sub

'图片水印
Public Sub OutputMarkImgFile(ByVal filename As String, Optional ByVal iLeft As Single = 10, Optional ByVal iTop As Single = 100, Optional Alpha As Single = 70)

Dim picture1 As New StdPicture
Dim picture2 As New StdPicture

'判断文件是否存在，不存在抛出错误
If Dir(SourceFileName) <> "" Then
Set picture1 = LoadPicture(SourceFileName)
Else
Err.Raise vbObjectError 513, , Err.Description "装载文件时发生了错误,请检查"
Exit Sub
End If

If Dir(MaskFileName) <> "" Then
Set picture2 = LoadPicture(MaskFileName)
Else
Err.Raise vbObjectError 514, , Err.Description "装载水印图片文件时发生了错误,请检查"
Exit Sub
End If

Dim vh As Long
Dim vw As Long
Dim bm As Bitmap
GetObject picture1.handle, Len(bm), bm

vw = bm.bmWidth
vh = bm.bmHeight

Dim vhmark As Long
Dim vwmark As Long
Dim bmm As Bitmap
GetObject picture2.handle, Len(bmm), bmm

vwmark = bmm.bmWidth
vhmark = bmm.bmHeight

'创建一个内存设备场景
Dim hdcSrc As Long
Dim hdcSrcMark As Long
Dim hdcDest As Long

hdcSrc = CreateCompatibleDC(0)
hdcSrcMark = CreateCompatibleDC(0)
hdcDest = CreateCompatibleDC(0)

'将创建的位图选入设备场景
SelectObject hdcSrc, picture1.handle
SelectObject hdcSrcMark, picture2.handle

SetBkMode hdcSrc, TRANSPARENT

Dim lBlend As Long
Dim bf As BLENDFUNCTION

bf.BlendOp = AC_SRC_OVER
bf.BlendFlags = 0
bf.SourceConstantAlpha = Alpha
bf.AlphaFormat = 0
CopyMemory lBlend, bf, 4
AlphaBlend hdcSrc, iLeft, iTop, vwmark, vhmark, hdcSrcMark, 0, 0, vwmark, vhmark, lBlend

'按照指定大小创建一幅与设备有关位图
Dim hmD As Long
hmD = CreateCompatibleBitmap(hdcSrc, vw * iRate, vh * iRate)
SelectObject hdcDest, hmD

'处理伸缩模式
Dim lOrigMode As Long
Dim lRet As Long
lOrigMode = SetStretchBltMode(hdcDest, STRETCH_HALFTONE)
'按照比例缩放
StretchBlt hdcDest, 0, 0, vw * iRate, vh * iRate, hdcSrc, 0, 0, vw, vh, SRCCOPY

'恢复以前的设置
lRet = SetStretchBltMode(hdcDest, lOrigMode)

'生成jpeg文件
SaveJPG hmD, filename
'删除设备场景
DeleteDC hdcDest
DeleteDC hdcSrcMark
DeleteDC hdcSrc
'删除位图对象
DeleteObject hmD

End Sub

编译成flysoft.dll即可

文章整理：西部数码--专业提供域名注册、虚拟主机服务
http://www.west263.com
以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息，谢谢!