aspjpeg组件图片加文字图片水印 在线图片剪切 比例放大缩小图片

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
  
  intimage
  intimage
  strmessage = ""
  flagopen = false
  intjpegcolor = &hffffff
  strjpegfamily = "arial"
  flagjpegbold = true
  intjpegsize = 20
  floatjpegopacity = 1
  
  intjpeg
  intjpeg
  
  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 m       destheight = 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 intwidth     if 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 intjpegor intjpegthen
      intwidth = .originalwidth
      intheight = .originalheight
     else
      intwidth = intjpegwidth
      intheight = intjpegheight
     end if

     if intwidth       if 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.
    '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
    text图片署名："&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

%>