A simple image-zoom processing component source code written by VB.NET, supports adding a translucent effect small icon

VB.NET Write a picture processing component for processing pictures, zooming images, proportional zoom, zooming in ASP, scaling, plus half transparent logo small icon. Dimage.vb imports systemimports system.drawing < COMCLASS (DIMAGE.CLASSID, DIMAGE.INTERFACEID, DIMAGE.Eventsid> _ Public Class Dimage

#REGION "COM Guids" 'These GUID provides COM ID in this class and its COM interface. 'If you change them, existing clients will never have to access this 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 a' public substi () without a parameter, otherwise, the class will not be registered in the COM registry, 'and cannot be created with 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 "E xit 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 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 = 0 to tembmp.height - 1 newbmp .SETPIXEL (IX XMAX, IY YMAX, TEMBMP.GETPIXEL (IX, 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 = 0 to syimg.width - 1 for iy = 0 to syimg.height - 1 COB = S Yimg.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 returno "ok" catch excetion return ex.totring End @ @ tc

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.R DIM G1 AS INTEGER = C1.R DIM B1 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 FunctionEND CLASS