ASPJPEG全面综合操作的CLASS

    作者:课课家更新于: 2015-11-06 11:23:01

    大神带你学编程,欢迎选课
    今天由小编为大家讲解有关语言编程的文章,相信对大家一定有很大的帮助

    <%

    c语言编程入门PEG综合操作CLASS
    Class AspJpeg
    Dim AspJpeg_Obj,obj
    Private Img_MathPath_From,Img_MathPath_To,Img_Reduce_Size,CoverIf
    Private Img_Frame_Size,Img_Frame_Color,Img_Frame_Solid,Img_Frame_Width,Img_Frame_Height
    Private Img_Font_Content,Img_Font_Family,Img_Font_Color,Img_Font_Quality,Img_Font_Size,Img_Font_Bold,Img_Font_X,Img_Font_Y
    Private Img_PicIn_Path,Img_PicIn_X,Img_PicIn_Y
    '--------------取原文件路径
    Public Property Let MathPathFrom(StrType)
    Img_MathPath_From=StrType
    End Property

    '--------------取文件保存路径
    Public Property Let MathPathTo(strType)
    Img_MathPath_To=strType
    End Property

    '--------------保存文件时是否覆盖已有文件
    Public Property Let CovePro(LngSize)
    If LngSize=0 or LngSize=1 or LngSize=true or LngSize=false then
    CoverIf=LngSize
    End If
    End Property

    '---------------取缩略图/放大图 缩略值
    Public Property Let ReduceSize(LngSize)
    If isNumeric(LngSize) then
    Img_Reduce_Size=LngSize
    End If
    End Property

     

    '---------------取描边属性
    '边框粗细
    Public Property Let FrameSize(LngSize)
    If isNumeric(LngSize) then
    Img_Frame_Size=Clng(LngSize)
    End If
    End Property
    '边框宽度
    Public Property Let FrameWidth(LngSize)
    If isNumeric(LngSize) then
    Img_Frame_Width=Clng(LngSize)
    End If
    End Property
    '边框高度
    Public Property Let FrameHeight(LngSize)
    If isNumeric(LngSize) then
    Img_Frame_Height=Clng(LngSize)
    End If
    End Property
    '边框颜色
    Public Property Let FrameColor(strType)
    If strType<>"" then
    Img_Frame_Color=strType
    End If
    End Property
    '边框是否加粗
    Public Property Let FrameSolid(LngSize)
    If LngSize=1 or LngSize=0 or LngSize=true or LngSize=false then
    Img_Frame_Solid=LngSize
    End If
    End Property

     

    '---------------取插入文字属性
    '插入的文字
    Public Property Let Content(strType)
    If strType<>"" then
    Img_Font_Content=strType
    End If
    End Property
    '文字字体
    Public Property Let FontFamily(strType)
    If strType<>"" then
    Img_Font_Family=strType
    End If
    End Property
    '文字颜色
    Public Property Let FontColor(strType)
    If strType<>"" then
    Img_Font_Color=strType
    End If
    End Property
    '文字品质
    Public Property Let FontQuality(LngSize)
    If isNumeric(LngSize) then
    Img_Font_Quality=Clng(LngSize)
    End If
    End Property
    '文字大小
    Public Property Let FontSize(LngSize)
    If isNumeric(LngSize) then
    Img_Font_Size=Clng(LngSize)
    End If
    End Property
    '文字是否加粗
    Public Property Let FontBold(LngSize)
    If LngSize=1 or LngSize=0 or LngSize=true or LngSize=false then
    Img_Font_Bold=LngSize
    End If
    End Property
    '输入文字的X坐标
    Public Property Let FontX(LngSize)
    If isNumeric(LngSize) then
    Img_Font_X=Clng(LngSize)
    End If
    End Property
    '输入文字的Y坐标
    Public Property Let FontY(LngSize)
    If isNumeric(LngSize) then
    Img_Font_Y=Clng(LngSize)
    End If
    End Property


    Private Sub Class_Initialize()
    Set AspJpeg_Obj=createObject("Persits.Jpeg")
    Img_MathPath_From=""
    Img_MathPath_To=""
    Img_Reduce_Size=150
    Img_Frame_Size=1
    'Img_Frame_Width=0
    'Img_Frame_Height=0
    'Img_Frame_Color="&H000000"
    'Img_Frame_Bold=false
    Img_Font_Content="GoldenLeaf"
    'Img_Font_Family="Al"
    'Img_Font_Color="&H000000"
    Img_Font_Quality=3
    Img_Font_Size=14
    'Img_Font_Bold=False
    Img_Font_X=10
    Img_Font_Y=5
    'Img_PicIn_X=0
    'Img_PicIn_Y=0
    CoverIf=1

    End Sub
    Private Sub Class_Terminate()
    Err.Clear
    Set AspJpeg_Obj=Nothing
    End Sub
    '判断文件是否存在
    Private Function FileIs(path)
    Set fsos=Server.createObject("Scripting.FileSystemObject")
    FileIs=fsos.FileExists(path)
    Set fsos=Nothing
    End Function

    '判断目录是否存在
    Private Function FolderIs(path)
    Set fsos=Server.createObject("Scripting.FileSystemObject")
    FolderIs=fsos.FolderExists(path)
    Set fsos=Nothing
    End Function
    '*******************************************
    '函数作用:取得当前文件的上一级路径
    '*******************************************
    Private Function UpDir(ByVal D)
    If Len(D) = 0 then
    UpDir=""
    Else
    UpDir=Left(D,InStrRev(D,"\\\\")-1)
    End If
    End Function

    在过去三年中 XML 经历了许多反复,所以目前存在不同版本的 Microsoft XML 分析器也不奇怪。Internet Explorer 4.0 包含早期版本的 XML 分析器,它比 XSL、XML 数据或者大多数其他的 XML 技术(并且有完全不同的 DOM 模型)要早。该早期版本的分析器包含在 MSXML.dll 库中。从 MSDN XML 开发人员中心(英文)可将分析器升级到较新的一种。
      我们极力建议您升级到新的分析器,因为它要强大得多。Internet Explorer 5.0 包括 MSXML 2.0 分析器,它包含 XSL 和 XML 架构的基本版本。MSXML2 是 SQL Server 2000 附带的分析器版本。MSXML2 包含了许多性能增强的功能,并且在总体上提高了性能和可伸缩性。MSXML3 是当前作为“技术预览”附带的版本。MSXML3 包括 XSLT 和 XPath 支持以及 SAX 接口。

    Private Function Errors(Errors_id)
    select Case Errors_id
    Case "0"
    Errors="C语言视频教程指定文件不存在"
    Case 1
    Errors="指定目录不存在"
    Case 2
    Errors="已存在相同名称文件"
    Case 3
    Errors="参数溢出"
    End select
    End Function

    '取图片宽度
    Public Function ImgInfo_Width(Img_MathPath)
    If Not(FileIs(Img_MathPath)) then
    'Exit Function
    ImgInfo_Width=Errors(0)
    Else
    AspJpeg_Obj.Open Img_MathPath
    ImgInfo_Width=AspJpeg_Obj.width
    End If
    End Function
    '取图片高度
    Public Function ImgInfo_Height(Img_MathPath)
    If Not(FileIs(Img_MathPath)) then
    'Exit Function
    ImgInfo_Height=Errors(0)
    Else
    AspJpeg_Obj.Open Img_MathPath
    ImgInfo_Height=AspJpeg_Obj.height
    End If
    End Function
    '生成缩略图/放大图
    Public Function Img_Reduce()
    If Not(FileIs(Img_MathPath_From)) then
    Img_Reduce=Errors(0)
    Exit Function
    End If
    If Not(FolderIs(UpDir(Img_MathPath_To))) then
    Img_Reduce=Errors(1)
    Exit Function
    End If
    If CoverIf=0 or CoverIf=False then
    If FileIs(Img_MathPath_To) then
    Img_Reduce=Errors(2)
    Exit Function
    End If
    End If
    AspJpeg_Obj.Open Img_MathPath_From
    AspJpeg_Obj.PreserveAspectRatio = True
    If AspJpeg_Obj.OriginalWidth>AspJpeg_Obj.OriginalHeight Then
    AspJpeg_Obj.Width=Img_Reduce_Size
    Else
    AspJpeg_Obj.Height=Img_Reduce_Size
    End If
    If AspJpeg_Obj.OriginalWidth>Img_Reduce_Size or AspJpeg_Obj.OriginalHeight>Img_Reduce_Size Then
    If AspJpeg_Obj.Width Set AspJpeg_Obj_New=createObject("Persits.Jpeg")
    AspJpeg_Obj_New.new Img_Reduce_Size,Img_Reduce_Size,&HFFFFFF
    AspJpeg_Obj_New.DrawImage (150-AspJpeg_Obj.width)/2,(150-AspJpeg_Obj.height)/2,AspJpeg_Obj
    If Img_Frame_Size>0 then
    Call Img_Pen(AspJpeg_Obj_New)
    End If
    If Img_Font_Content<>"" then
    Img_Font_X=AspJpeg_Obj_New.Width/2
    Img_Font_Y=AspJpeg_Obj_New.Height-15
    Call Img_Font(AspJpeg_Obj_New)
    End If
    AspJpeg_Obj_New.Sharpen 1, 130
    AspJpeg_Obj_New.Save Img_MathPath_To
    Set AspJpeg_Obj_New=Nothing
    Else
    If Img_Frame_Size>0 then
    Call Img_Pen(AspJpeg_Obj)
    End If
    If Img_Font_Content<>"" then
    Img_Font_X=AspJpeg_Obj.Width/2
    Img_Font_Y=AspJpeg_Obj.Height-15
    Call Img_Font(AspJpeg_Obj)
    End If
    AspJpeg_Obj.Sharpen 1, 130
    AspJpeg_Obj.Save Img_MathPath_To
    End If
    Else
    If Img_Frame_Size>0 then
    Call Img_Pen(AspJpeg_Obj)
    End If
    If Img_Font_Content<>"" then
    Img_Font_X=AspJpeg_Obj.Width/2
    Img_Font_Y=AspJpeg_Obj.Height-15
    Call Img_Font(AspJpeg_Obj)
    End If
    AspJpeg_Obj.Sharpen 1, 130
    AspJpeg_Obj.Save Img_MathPath_To
    End If
    End Function
    '生成水印
    Public Function Img_WaterMark()
    If Not(FileIs(Img_MathPath_From)) then
    Img_WaterMark=Errors(0)
    Exit Function
    End If
    If Img_MathPath_To="" then
    Img_MathPath_To=Img_MathPath_From
    ElseIf Not(FolderIs(UpDir(Img_MathPath_To))) then
    Img_WaterMark=Errors(1)
    Exit Function
    End If
    If CoverIf=0 or CoverIf=false then
    If Img_MathPath_To<>Img_MathPath_From and FileIs(Img_MathPath_To) then
    Img_WaterMark=Errors(2)
    Exit Function
    End If
    End If
    AspJpeg_Obj.Open Img_MathPath_From
    If Img_PicIn_Path<>"" then
    If Not(FileIs(Img_PicIn_Path)) then
    Img_WaterMark=Errors(0)
    Exit Function
    End If
    Set AspJpeg_Obj_New=createObject("Persits.Jpeg")
    AspJpeg_Obj_New.Open Img_PicIn_Path
    AspJpeg_Obj.PreserveAspectRatio = True
    AspJpeg_Obj_New.PreserveAspectRatio = True
    If AspJpeg_Obj.OriginalWidth Img_WaterMark=Errors(3)
    Exit Function
    End If
    If AspJpeg_Obj_New.OriginalWidth>AspJpeg_Obj_New.OriginalHeight Then
    AspJpeg_Obj_New.Width=Img_Reduce_Size
    Else
    AspJpeg_Obj_New.Height=Img_Reduce_Size
    End If
    If Img_PicIn_X="" then Img_PicIn_X=AspJpeg_Obj.Width-AspJpeg_Obj_New.Width
    If Img_PicIn_Y="" then Img_PicIn_Y=AspJpeg_Obj.Height-AspJpeg_Obj_New.Height
    AspJpeg_Obj.DrawImage Img_PicIn_X,Img_PicIn_Y,AspJpeg_Obj_New
    Set AspJpeg_Obj_New=Nothing
    End If
    If Img_Frame_Size>0 then
    Call Img_Pen(AspJpeg_Obj)
    End If
    If Img_Font_Content<>"" then
    Call Img_Font(AspJpeg_Obj)
    End If
    'AspJpeg_Obj.Sharpen 1, 130
    AspJpeg_Obj.Save Img_MathPath_To
    End Function
    '生成框架
    Private Function Img_Pen(Obj)
    If Img_Frame_Width=0 then Img_Frame_Width=Obj.Width
    If Img_Frame_Height=0 then Img_Frame_Height=Obj.Height
    Obj.Canvas.Pen.Color = Img_Frame_Color
    Obj.Canvas.Pen.Width = Img_Frame_Size
    Obj.Canvas.Brush.Solid = Img_Frame_Solid
    Obj.Canvas.Bar 1,1,Img_Frame_Width,Img_Frame_Height
    End Function
    '生成水印字
    Private Function Img_Font(Obj)
    Obj.Canvas.Font.Color = Img_Font_Color
    Obj.Canvas.Font.Family = Img_Font_Family
    Obj.Canvas.Font.Quality=Img_Font_Quality
    Obj.Canvas.Font.Size=Img_Font_Size
    Obj.Canvas.Font.Bold = Img_Font_Bold
    Obj.Canvas.Print Img_Font_X,Img_Font_Y,Img_Font_Content
    End Function
    End Class
    %>


    这个类可以公开调用
    C语言教程1. ImgInfo_Height 取图片高度
    2. ImgInfo_Width 取图片宽度
    调用方法:
    程序代码
    Dim NewObj,Pic_h,Pic_w
    Set NewObj=New AspJpeg
    Pic_h=NewObj.ImgInfo_Height("f:/test.jpg")
    Pic_w=NewObj.ImgInfo_Width("f:/test.jpg")
    Set NewObj=Nothing
    Response.Write "This Picture's Height is "&Pic_h
    Response.Write "This Picture's Width is "&Pic_w
    Response.End

     

    3. Img_Reduce 对指定图片缩小或放大并保存(可选择是否加水印,是否加框架)
    必须定义声明 MathPathFrom,MathPathTo
    默认为缩放至150X150 图案 如按比例缩放后图案小于该尺寸,则补充空白图片
    默认文件自动覆盖
    实例:

    程序代码
    Dim NewObj,NewCommand
    Set NewObj=New AspJpeg
    NewObj.MathPathFrom="f:/test.jpg"
    NewObj.MathPathTo="f:/reduce.jpg"
    NewCommand=NewObj.Img_Reduce
    Set NewObj=Nothing
    If NewCommand<>"" then
    Response.Write "Success"
    Else
    '图片操作过程中出现错误
    Response.Write "Failed"
    End If
    4. Img_WaterMark 给指定图片添加水印
    水印可以为图片 文字 或 2者结合

     

    今天由小编为大家讲解有关语言编程的文章,相信对大家一定有很大的帮助

课课家教育

未登录

1