注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

古城风~~~

竹密无妨溪水过,天高不碍白云飞。这天下总有一份是属于我古城的天地!

 
 
 

日志

 
 

Aspjpeg组件写的一个类  

2010-12-10 09:08:20|  分类: asp |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |

<%
''ASPJPEG综合操作CLASS
''Authour: tony 05/09/05
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 取图片宽度

调用方法:

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者结合


本文来自编程入门网:http://www.bianceng.cn/webkf/asp/200911/12093_2.htm

  评论这张
 
阅读(322)| 评论(0)
推荐 转载

历史上的今天

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017