VB.NET写的简单图片缩放处理组件源代码,支持添加半透明效果小图标，转
Imports System.Drawing
<ComClass(dImage.ClassId, dImage.InterfaceId, dImage.EventsId)> _
Public Class dImage
#Region "COM GUIDs"
' 这些 GUID 提供该类的 COM 标识及其 COM 接口。
' 如果您更改它们，现有的客户端将再也无法
' 访问该类。
Public Const ClassId As String = "29641F37-8FA4-4ED9-9118-9DA8EFA306B9"
Public Const InterfaceId As String = "06E4B037-2461-4F83-96BE-2A5D1CAAB0CE"
Public Const EventsId As String = "802EBB14-2D4D-416E-BA26-E8ADCD480E26"
#End Region
' 可创建的 COM 类必须具有不带参数的
' Public Sub New()，否则，该类将不会注册到 COM 注册表中，
' 而且不能通过 CreateObject
' 来创建。
Private myImage As Drawing.Bitmap
Private syimg As Drawing.Bitmap
Private syok As Boolean = False
Private myok As Boolean = False
Public Sub New()
MyBase.New()
End Sub
Public WriteOnly Property bigImage() As String
Set(ByVal Value As String)
Try
myImage = New Bitmap(Value)
myok = True
Catch e As IO.IOException
myok = False
End Try
End Set
End Property
Public WriteOnly Property LogoImage() As String
Set(ByVal Value As String)
Try
syimg = New Bitmap(Value)
syok = True
Catch ex As Exception
syok = False
End Try
End Set
End Property
Public Function SaveAs(ByVal ToFile As String, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal nLogo As Boolean) As String
Try
If myok = False Then
Return "err0"
Exit Function
End If
Dim newbmp As Bitmap = New Bitmap(nWidth, nHeight, Imaging.PixelFormat.Format16bppArgb1555)
Dim iX As Integer
Dim iY As Integer
Dim xMax As Integer
Dim yMax As Integer
For iX = 0 To nWidth - 1
For iY = 0 To nHeight - 1
newbmp.SetPixel(iX, iY, Color.White)
Next
Next
If nWidth < myImage.Width Or nHeight < myImage.Height Then
If myImage.Width / myImage.Height > nWidth / nHeight Then
xMax = nWidth
yMax = myImage.Height * nWidth \ myImage.Width
Else
yMax = nHeight
xMax = myImage.Width * nHeight \ myImage.Height
End If
Else
xMax = myImage.Width
yMax = myImage.Height
End If
Dim tembmp As Bitmap = New Bitmap(myImage, xMax, yMax)
xMax = (newbmp.Width - tembmp.Width) \ 2
yMax = (newbmp.Height - tembmp.Height) \ 2
For iX = 0 To tembmp.Width - 1
For iY = 0 To tembmp.Height - 1
newbmp.SetPixel(iX + xMax, iY + yMax, tembmp.GetPixel(iX, iY))
Next
Next
If syok And nLogo Then
Dim cob As Color
Dim coc As Color
xMax = newbmp.Width - syimg.Width - 4
yMax = newbmp.Height - syimg.Height - 3
For iX = 0 To syimg.Width - 1
For iY = 0 To syimg.Height - 1
cob = syimg.GetPixel(iX, iY)
coc = newbmp.GetPixel(iX + xMax, iY + yMax)
newbmp.SetPixel(iX + xMax, iY + yMax, getnewco(cob, coc))
Next
Next
End If
newbmp.Save(ToFile, Imaging.ImageFormat.Jpeg)
newbmp.Dispose()
tembmp.Dispose()
newbmp = Nothing
tembmp = Nothing
Return "OK"
Catch ex As Exception
Return ex.ToString
End Try
End Function
Public ReadOnly Property Width() As Integer
Get
Return myImage.Width
End Get
End Property
Public ReadOnly Property Height() As Integer
Get
Return myImage.Height
End Get
End Property
Public Sub Close()
myImage.Dispose()
syimg.Dispose()
myImage = Nothing
syimg = Nothing
End Sub
Private Function getnewco(ByVal c1 As Color, ByVal c2 As Color) As Color
Dim a1 As Integer = c1.A
Dim r1 As Integer = c1.R
Dim g1 As Integer = c1.G
Dim b1 As Integer = c1.B
Dim a2 As Integer = c2.A
Dim r2 As Integer = c2.R
Dim g2 As Integer = c2.G
Dim b2 As Integer = c2.B
a2 = 255 - a1
r1 = CInt((r1 * a1 / 255) + (r2 * a2 / 255))
g1 = CInt((g1 * a1 / 255) + (g2 * a2 / 255))
b1 = CInt((b1 * a1 / 255) + (b2 * a2 / 255))
Return Color.FromArgb(a1, r1, g1, b1)
End Function
End Class