Vb. NET simple picture scaling processing component source code, support to add translucent effect small icon

Transparent | source code VB. NET writes a picture processing component, uses in the ASP to process the picture, the scale picture, proportional scaling, has the fixed proportion background the scaling, plus the translucent logo small icon and so on function.

Dimage.vb


Imports System
Imports System.Drawing
<comclass (Dimage.classid, Dimage.interfaceid, Dimage.eventsid) > _
Public Class Dimage

#Region "COM GUIDs"
' These GUIDs provide the COM identity of the class and its COM interface.
' If you change them, existing clients will no longer be able to
' Access to the class.
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

' The COM class that can be created must have an argument-less
' Public Sub New (), otherwise, the class will not be registered in the COM registry.
' And not through CreateObject
' To create.
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