VB.NET寫的一個圖片處理組件,用於在ASP中處理圖片,縮放圖片,成比例縮放,有固定比例背景的縮放,加半透明LOGO小圖標等功能.
dImage.vb
Imports System
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