网站地图
【www.gdgbn.com--组件控件开发】
class lyout_image
dim objjpeg " aspjpeg 对象
dim objfso " 文件读写对象
dim intimagewidth " 图像宽度
dim intimageheight " 图像高度
dim strmessage " 当作操作信息
dim flagopen " 文件打开标志
dim intjpegwidth " 水印区域宽度
dim intjpegheight " 水印区域高度
dim intjpegcolor " 水印文字颜色或水印图片透明色
dim strjpegfamily " 水印文字字体
dim flagjpegbold " 水印文字是否粗体
dim intjpegsize " 水印文字大小
dim floatjpegopacity " 水印图片透明度
public property get width()
width = intimagewidth
end property
public property get height()
height = intimageheight
end property
public property let message(byval strmsg)
strmessage = strmsg
end property
public property get message()
message = strmessage
end property
public property get fileisopen()
fileisopen = flagopen
end property
public property let jpegwidth(byval intwidth)
intjpegwidth = intwidth
end property
public property let jpegheight(byval intheight)
intjpegheight = intheight
end property
public property let jpegcolor(byval intcolor)
intjpegcolor = intcolor
end property
public property let jpegfamily(byval strfamily)
strjpegfamily = strfamily
end property
public property let jpegbold(byval flagbold)
flagjpegbold = cbool(flagbold)
end property
public property let jpegsize(byval intsize)
intjpegsize = intsize
end property
public property let jpegopacity(byval floatopacity)
floatjpegopacity = floatopacity
end property
private sub class_initialize
on error resume next
intimagewidth = 0
intimageheight = 0
strmessage = ""
flagopen = false
intjpegcolor = &hffffff
strjpegfamily = "arial"
flagjpegbold = true
intjpegsize = 20
floatjpegopacity = 1
intjpegwidth = 0
intjpegheight = 0
set objjpeg = server.createobject("persits.jpeg")
if err then
set objjpeg = nothing
message = "组件 persits.jpeg 没有安装！"
exit sub
end if
message = ""
set objfso = server.createobject("scripting.filesystemobject")
if err then
set objfso = nothing
message = "组件 scripting.filesystemobject 没有安装！"
exit sub
end if
end sub
" 打开文件 strfilename
public function open(strfilename)
open = false
message = ""
if not fileisopen then
on error resume next
if objfso.fileexists(server.mappath(strfilename)) then
objjpeg.open server.mappath(strfilename)
if err then
message = err.description&"
"
exit function
end if
intimagewidth = objjpeg.originalwidth
intimageheight = objjpeg.originalheight
open = true
flagopen = true
message = "文件打开成功！"
else
message = "文件不存在！"
end if
else
message = "文件已打开！"
end if
end function
" 保存到文件 destfile
public sub saveas(destfile)
message = ""
on error resume next
if fileisopen then
objjpeg.save server.mappath(destfile)
if err then
message = err.description
end if
else
message = "文件已经保存！"
end if
end sub
" 关闭对象
public sub close()
on error resume next
if fileisopen then
objjpeg.close
flagopen = false
end if
end sub
" 缩放到宽度为 intwidth,高度为 intheight
public sub resizeto(intwidth,intheight)
dim destwidth
dim destheight
dim m
dim n
message = ""
if fileisopen then
with objjpeg
m = intimagewidth/intwidth
n = intimageheight/intheight
if intimagewidth>intwidth or intimageheight>intheight then
if m>n then
destwidth = intwidth
destheight = intimageheight/m
elseif mdestheight = intheight
destwidth = intimagewidth/n
else
destwidth = intwidth
destheight = intheight
end if
else
destwidth = intimagewidth
destheight = intimageheight
end if
.width = destwidth
.height = destheight
end with
intimagewidth = destwidth
intimageheight = destheight
else
message = "文件没有打开！"
end if
end sub
" 水印文字
" intdirection:图片位置:
" 如果传进来的是数组 array(left,top)：
" left 表示水印图片相对源图的左上角x方向距离
" top 表示水印图片相对源图的左上角y方向距离
" 如果是单一数字：
" 1:左上 2:上中 3:右上 4:左中 5:中中 6:右中 7:左下 8:中下 9:右下
" intleft 表示水印文字相对源图的左上角x方向距离
" inttop 表示水印文字相对源图的左上角y方向距离
" strtext 水印文字
public sub drawtext(intdirection,strtext)
dim objjpeg2
dim intwidth
dim intheight
dim intleft
dim inttop
message = ""
if fileisopen then
intwidth = intjpegwidth
intheight = intjpegheight
if intwidthif not isarray(intdirection) then
select case intdirection
case 1
intleft = 0
inttop = 0
case 2
intleft = (width-intwidth)/2
inttop = 0
case 3
intleft = width-intwidth
inttop = 0
case 4
intleft = 0
inttop = (height-intheight)/2
case 5
intleft = (width-intwidth)/2
inttop = (height-intheight)/2
case 6
intleft = width-intwidth
inttop = (height-intheight)/2
case 7
intleft = 0
inttop = height-intheight
case 8
intleft = (width-intwidth)/2
inttop = height-intheight
case else
intleft = width-intwidth
inttop = height-intheight
end select
else
intleft = intdirection(0)
inttop = intdirection(1)
end if
on error resume next
with objjpeg.canvas
.font.color = intjpegcolor
.font.family = strjpegfamily
.font.bold = flagjpegbold
.font.size = intjpegsize*2
.print intleft,inttop,strtext
end with
if err then
message = "打文字水印出错！"
end if
else
message = "图片太小或水印区域过大！"
end if
else
message = "文件没有打开！"
end if
end sub
" 图片水印
" intdirection:图片位置:
" 如果传进来的是数组 array(left,top)：
" left 表示水印图片相对源图的左上角x方向距离
" top 表示水印图片相对源图的左上角y方向距离
" 如果是单一数字：
" 1:左上 2:上中 3:右上 4:左中 5:中中 6:右中 7:左下 8:中下 9:右下
" strfilename:用做水印图片的文件名
public sub drawimage(intdirection,strfilename)
dim objjpeg2
dim intwidth
dim intheight
dim intleft
dim inttop
message = ""
if fileisopen then
if objfso.fileexists(server.mappath(strfilename)) then
on error resume next
set objjpeg2 = server.createobject("persits.jpeg")
with objjpeg2
.open server.mappath(strfilename)
if err then
message = err.description
end if
if intjpegwidth = 0 or intjpegheight = 0 then
intwidth = .originalwidth
intheight = .originalheight
else
intwidth = intjpegwidth
intheight = intjpegheight
end if
if intwidthif not isarray(intdirection) then
select case intdirection
case 1
intleft = 0
inttop = 0
case 2
intleft = (width-intwidth)/2
inttop = 0
case 3
intleft = width-intwidth
inttop = 0
case 4
intleft = 0
inttop = (height-intheight)/2
case 5
intleft = (width-intwidth)/2
inttop = (height-intheight)/2
case 6
intleft = width-intwidth
inttop = (height-intheight)/2
case 7
intleft = 0
inttop = height-intheight
case 8
intleft = (width-intwidth)/2
inttop = height-intheight
case else
intleft = width-intwidth
inttop = height-intheight
end select
else
intleft = intdirection(0)
inttop = intdirection(1)
end if
on error resume next
objjpeg.drawimage intleft,inttop,objjpeg2,floatjpegopacity,intjpegcolor
if err then
message = "打图片水印出错！"
end if
else
message = "水印图片像素过大！"
end if
end with
else
message = "水印图片不存在！"
end if
else
message = "文件没有打开！"
end if
end sub
public sub drawcanvas(strfilename,strmanuname)
dim objimagebar,objimagelogo,textwidth
message = ""
if fileisopen then
set objimagebar = server.createobject("persits.jpeg")
set objimagelogo = server.createobject("persits.jpeg")
objimagelogo.open server.mappath(strfilename)
with objjpeg
objimagebar.new intimagewidth,20,&hffffff
objimagebar.canvas.pen.color = &hffffff
objimagebar.canvas.pen.width = 40
"objimagebar.canvas.brush.solid = false
objimagebar.canvas.drawbar 0,0,intimagewidth,intimageheight
.canvas.font.color = &hcccccc
.canvas.font.family = "宋体"
.canvas.font.bold = 0
.canvas.font.size = 12
textwidth = .canvas.gettextextent("图片署名："&strmanuname)
.drawimage 0,intimageheight-20,objimagebar,1,&h000000
.drawimage 0,intimageheight-20,objimagelogo,1,&h000000
.canvas.print intimagewidth-10-textwidth,intimageheight-3-12,"图片署名："&strmanuname
.quality = 90
end with
objimagelogo.close
set objimagelogo = nothing
set objimagebar = nothing
else
message = "文件没有打开！"
end if
end sub
" 从坐标 (x0,y0) 到 (x1,y1) 截剪图片
public sub crop(x0,y0,x1,y1)
message = ""
if fileisopen then
objjpeg.crop x0,y0,x1,y1
else
message = "文件没有打开！"
end if
end sub
private sub class_terminate
on error resume next
if not objjpeg is nothing then
if isobject(objjpeg) then objjpeg.close
set objjpeg = nothing
end if
set objfso = nothing
end sub
end class
%>