VB.NET簡單圖片縮放處理組件原始碼,支援添加半透明效果小表徵圖

來源:互聯網
上載者:User
透明|原始碼 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




相關文章

E-Commerce Solutions

Leverage the same tools powering the Alibaba Ecosystem

Learn more >

Apsara Conference 2019

The Rise of Data Intelligence, September 25th - 27th, Hangzhou, China

Learn more >

Alibaba Cloud Free Trial

Learn and experience the power of Alibaba Cloud with a free trial worth $300-1200 USD

Learn more >

聯繫我們

該頁面正文內容均來源於網絡整理,並不代表阿里雲官方的觀點,該頁面所提到的產品和服務也與阿里云無關,如果該頁面內容對您造成了困擾,歡迎寫郵件給我們,收到郵件我們將在5個工作日內處理。

如果您發現本社區中有涉嫌抄襲的內容,歡迎發送郵件至: info-contact@alibabacloud.com 進行舉報並提供相關證據,工作人員會在 5 個工作天內聯絡您,一經查實,本站將立刻刪除涉嫌侵權內容。