.NET开发

本类阅读TOP10

·NHibernate快速指南(翻译)
·vs.net 2005中文版下载地址收藏
·【小技巧】一个判断session是否过期的小技巧
·VB/ASP 调用 SQL Server 的存储过程
·?dos下编译.net程序找不到csc.exe文件
·通过Web Services上传和下载文件
·学习笔记(补)《.NET框架程序设计(修订版)》--目录
·VB.NET实现DirectDraw9 (2) 动画
·VB.NET实现DirectDraw9 (1) 托管的DDraw
·建站框架规范书之——文件命名

分类导航
VC语言Delphi
VB语言ASP
PerlJava
Script数据库
其他语言游戏开发
文件格式网站制作
软件工程.NET开发
一个VB.NET写的简单图片缩放处理组件源代码,支持添加半透明效果小图标

作者:未知 来源:月光软件站 加入时间:2005-2-28 月光软件站

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




相关文章

相关软件