源码网商城,靠谱的源码在线交易网站 我的订单 购物车 帮助

源码网商城

ASPJPEG综合操作的CLASS类

  • 时间:2020-08-28 15:09 编辑: 来源: 阅读:
  • 扫一扫,手机访问
摘要:ASPJPEG综合操作的CLASS类
<%  'ASPJPEG综合操作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  '---------------取插入图片属性  '插入图片的路径  Public Property Let PicInPath(strType)  Img_PicIn_Path=strType  End Property  '图片插入的X坐标  Public Property Let PicInX(LngSize)  If isNumeric(LngSize) then  Img_PicIn_X=Clng(LngSize)  End If  End Property  '图片插入的Y坐标  Public Property Let PicInY(LngSize)  If isNumeric(LngSize) then  Img_PicIn_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="Arial"  '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  Private Function Errors(Errors_id)  select Case Errors_id  Case "0"  Errors="指定文件不存在"  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<Img_Reduce_Size or AspJpeg_Obj.Height<Img_Reduce_Size then  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_Reduce_Size or AspJpeg_Obj.OriginalHeight<Img_Reduce_Size then  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  %>  这个类可以公开调用  1. ImgInfo_Height 取图片高度  2. ImgInfo_Width 取图片宽度  调用方法: 
[u]复制代码[/u] 代码如下:
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 图案 如按比例缩放后图案小于该尺寸,则补充空白图片  默认文件自动覆盖  实例: 
[u]复制代码[/u] 代码如下:
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者结合 
  • 全部评论(0)
联系客服
客服电话:
400-000-3129
微信版

扫一扫进微信版
返回顶部