当前位置：编程学习网 >>php教程 > php常用代码 > > [asp.net]asp 生成图片缩略图代码

[asp.net]asp 生成图片缩略图代码

【www.gdgbn.com--php常用代码】

<%
"======================================================
" 文件名称 : Inc/ClsJpeg.asp
" 文件作用 : 水印+缩略类
" 最后更新 : 2008.08.02
"======================================================

Dim PhotoObject,Thumb_DefaultWidth,Thumb_DefaultHeight,Thumb_Arithmetic,Thumb_BackgroundColor,PhotoQuanlity
Dim Watermark_Type,Watermark_Text,Watermark_Text_FontName,Watermark_Text_FontSize,Watermark_Text_FontColor
Dim Watermark_Text_Bold,Watermark_Images_FileName,Watermark_Images_Transparence,Watermark_Images_BackgroundColor
Dim Watermark_Position_X,Watermark_Position_Y,Watermark_Position

PhotoObject                      = Int(ClsCommon.FlowerSetting("PhotoObject"))
Thumb_DefaultWidth               = ClsCommon.FlowerSetting("Thumb_DefaultWidth")
Thumb_DefaultHeight              = ClsCommon.FlowerSetting("Thumb_DefaultHeight")
Thumb_Arithmetic                 = ClsCommon.FlowerSetting("Thumb_Arithmetic")
Thumb_BackgroundColor            = ClsCommon.FlowerSetting("Thumb_BackgroundColor")
PhotoQuanlity                    = ClsCommon.FlowerSetting("PhotoQuanlity")
Watermark_Type                   = Int(ClsCommon.FlowerSetting("Watermark_Type"))
Watermark_Text                   = ClsCommon.FlowerSetting("Watermark_Text")
Watermark_Text_FontName          = ClsCommon.FlowerSetting("Watermark_Text_FontName")
Watermark_Text_FontSize          = ClsCommon.FlowerSetting("Watermark_Text_FontSize")
Watermark_Text_FontColor         = ClsCommon.FlowerSetting("Watermark_Text_FontColor")
Watermark_Text_Bold              = ClsCommon.FlowerSetting("Watermark_Text_Bold")
Watermark_Images_FileName        = ClsCommon.FlowerSetting("Watermark_Images_FileName")
Watermark_Images_Transparence    = ClsCommon.FlowerSetting("Watermark_Images_Transparence")
Watermark_Images_BackgroundColor = ClsCommon.FlowerSetting("Watermark_Images_BackgroundColor")
Watermark_Position_X             = ClsCommon.FlowerSetting("Watermark_Position_X")
Watermark_Position_Y             = ClsCommon.FlowerSetting("Watermark_Position_Y")
Watermark_Position               = ClsCommon.FlowerSetting("Watermark_Position")

If Watermark_Position = "" Then Watermark_Position = "1"
If PhotoQuality < 50 Then PhotoQuality = 90
If PhotoQuality > 100 Then PhotoQuality = 90
If Thumb_BackgroundColor = "" Then Thumb_BackgroundColor = "#CCCCCC"
Watermark_Images_Transparence = Watermark_Images_Transparence / 100
Watermark_Text_FontColor = "&H" & Replace(Right(Watermark_Text_FontColor, 6), "#", "")
Watermark_Images_BackgroundColor = "&H" & Replace(Right(Watermark_Images_BackgroundColor, 6), "#", "")
Thumb_BackgroundColor = "&H" & Replace(Right(Thumb_BackgroundColor, 6), "#", "")

Class Cls_Thumb
"=================================================
"AddWatermark
"作用：根据选择的外部组件调用图像处理功能给图片加上水印
"参数：ImgFileName ---- 图片路径
"=================================================
Public Function AddWatermark(ImgFileName)

  Dim objFont, FileExt
  Dim iLeft, iTop
  Dim LogoWidth, LogoHeight

AddWatermark = False

If PhotoObject <= 0 Then Exit Function

  FileExt = GetPhotoExt(ImgFileName)
  If FileExt <> "jpg" And FileExt <> "jpeg" And FileExt <> "jpe" And FileExt <> "bmp" And FileExt <> "gif" Then Exit Function

  "On Error Resume Next

  Select Case PhotoObject
  Case 1       "AspJpegV1.5

If ClsMain.IsObjInstalled("Persits.Jpeg") = False Then Exit Function

   Dim AspJpeg
   Set AspJpeg = Server.CreateObject("Persits.Jpeg")
   AspJpeg.Open Trim(Server.MapPath(ImgFileName))
   If AspJpeg.OriginalWidth > Watermark_Position_X * 2 Then
    If Watermark_Type = 0 Then
     If Watermark_Text <> "" And Watermark_Text_FontColor <> "" Then
      LogoWidth = (Watermark_Text_FontSize + 1) * ClsMain.GetStrLen(Watermark_Text) / 2
      LogoHeight = Watermark_Text_FontSize + 1

iLeft = GetPosition_X(AspJpeg.OriginalWidth, LogoWidth, Watermark_Position_X)
iTop = GetPosition_Y(AspJpeg.OriginalHeight, LogoHeight, Watermark_Position_Y)

      AspJpeg.Canvas.Font.COLOR = Watermark_Text_FontColor         " 文字的颜色
      AspJpeg.Canvas.Font.Family = Watermark_Text_FontName         " 文字的字体
      AspJpeg.Canvas.Font.size = Watermark_Text_FontSize           " 文字的大小
      AspJpeg.Canvas.Font.Bold = Watermark_Text_Bold               " 文字是否粗体
      AspJpeg.Canvas.Font.Quality = 4                              " Antialiased
      AspJpeg.Canvas.PrintText iLeft, iTop, Watermark_Text         " 加入文字的位置坐标
      AspJpeg.Canvas.Pen.COLOR = &H0               " 边框的颜色
      AspJpeg.Canvas.Pen.Width = 1                 " 边框的粗细
      AspJpeg.Canvas.Brush.Solid = False           " 图片边框内是否填充颜色
      AspJpeg.Quality = PhotoQuality
      AspJpeg.save Server.MapPath(ImgFileName)     " 生成文件

End If
Else

Set fso = Server.CreateObject("Scripting.FileSystemObject")

     If Not fso.FileExists(Server.MapPath(".."&Watermark_Images_FileName)) Then
      Exit Function
     End If

     Dim AspJpeg2
     Set AspJpeg2 = Server.CreateObject("Persits.Jpeg")
     AspJpeg2.Open Server.MapPath(".."&Watermark_Images_FileName) "打开水印图片

     iLeft = GetPosition_X(AspJpeg.OriginalWidth, AspJpeg2.Width, Watermark_Position_X)
     iTop = GetPosition_Y(AspJpeg.OriginalHeight, AspJpeg2.Height, Watermark_Position_Y)
     AspJpeg.DrawImage iLeft, iTop, AspJpeg2, Watermark_Images_Transparence, Watermark_Images_BackgroundColor, 90 "在原图上添加水印图片
     AspJpeg.Quality = PhotoQuality
     AspJpeg.save Server.MapPath(ImgFileName)
     Set AspJpeg2 = Nothing
    End If
   End If
   Set AspJpeg = Nothing
  Case 2

Case 3

End Select

  AddWatermark = True
  "If Err Then
  " Err.Clear
  " CreateThumb = False
  "End if
End Function

"=================================================
"过程名：CreateThumb
"作用：根据选择的外部组件调用图像处理功能（缩略图，水印）
"参数：ImgFileName     ----原始图片路径
"        ThumbFileName ----创建缩略图保存的路径
"        ImageWidth ----缩略图宽度
"        ImageHeight ----缩略图高度
"=================================================
Public Function CreateThumb(ImgFileName, ThumbFileName, ImageWidth, ImageHeight)
  Dim FileExt, bl_w, bl_h
  Dim iLeft, iTop

CreateThumb = False

  If PhotoObject <= 0 Then Exit Function
  If ImageWidth = 0 And ImageHeight = 0 Then
   ImageWidth = Thumb_DefaultWidth
   ImageHeight = Thumb_DefaultHeight
  End If

FileExt = GetPhotoExt(ImgFileName)

  If FileExt <> "jpg" And FileExt <> "jpeg" And FileExt <> "jpe" And FileExt <> "bmp" And FileExt <> "gif" Then Exit Function

  "On Error Resume Next

  Select Case PhotoObject
  Case 1       "AspJpegV1.5

   If ClsMain.IsObjInstalled("Persits.Jpeg") = False Then Exit Function

   Dim AspJpeg, AspJpeg2

   Set AspJpeg = Server.CreateObject("Persits.Jpeg")
   Set AspJpeg2 = Server.CreateObject("Persits.Jpeg")
   AspJpeg.Open Trim(Server.MapPath(ImgFileName))
   AspJpeg2.Open Trim(Server.MapPath(ImgFileName))

   bl_w = ImageWidth / AspJpeg.OriginalWidth
   bl_h = ImageHeight / AspJpeg.OriginalHeight

   If ImageWidth > 0 Then
    If ImageHeight > 0 Then
     Select Case Thumb_Arithmetic
     Case 0   "常规算法：宽度和高度都大于0时，直接缩小成指定大小，其中一个为0时，按比例缩小
      If bl_w < 1 Or bl_h < 1 Then
       AspJpeg.Width = ImageWidth
       AspJpeg.Height = ImageHeight
       AspJpeg.Quality = PhotoQuality
       AspJpeg.save Server.MapPath(ThumbFileName)
       CreateThumb = True
      End If
     Case 1    "裁剪法：宽度和高度都大于0时，先按最佳比例缩小再裁剪成指定大小，其中一个为0时，按比例缩小
      If bl_w < 1 Or bl_h < 1 Then
       If bl_w < bl_h Then
        AspJpeg.Height = ImageHeight
        AspJpeg.Width = Round(AspJpeg.OriginalWidth * bl_h)   "按缩小成大比例者
       Else
        AspJpeg.Width = ImageWidth
        AspJpeg.Height = Round(AspJpeg.OriginalHeight * bl_w)
       End If
       AspJpeg.Crop 0, 0, ImageWidth, ImageHeight
       AspJpeg.Quality = PhotoQuality
       AspJpeg.save Server.MapPath(ThumbFileName)
       CreateThumb = True
      End If
     Case 2 "补充法：在指定大小的背景图上附加上按最佳比例缩小的图片

      "创建一个指定大小的背景图
      AspJpeg2.Width = ImageWidth
      AspJpeg2.Height = ImageHeight
      AspJpeg2.Canvas.Brush.Solid = True            " 图片边框内是否填充颜色
      AspJpeg2.Canvas.Brush.COLOR = Thumb_BackgroundColor "设定背景颜色
      AspJpeg2.Canvas.Bar -1, -1, AspJpeg2.Width + 1, AspJpeg2.Height + 1 "填充

      "按最佳比例缩小图片
      If bl_w > bl_h Then
       If bl_h < 1 Then
        AspJpeg.Height = ImageHeight
        AspJpeg.Width = Round(AspJpeg.OriginalWidth * bl_h)   "按缩小成小比例者
       End If
      Else
       If bl_w < 1 Then
        AspJpeg.Width = ImageWidth
        AspJpeg.Height = Round(AspJpeg.OriginalHeight * bl_w)
       End If
      End If

      "得到缩略图的坐标
      iLeft = (AspJpeg2.Width - AspJpeg.Width) / 2
      iTop = (AspJpeg2.Height - AspJpeg.Height) / 2

      AspJpeg2.DrawImage iLeft, iTop, AspJpeg   "将缩略图附加到背景上
      AspJpeg2.Quality = PhotoQuality
      AspJpeg2.save Server.MapPath(ThumbFileName)
      CreateThumb = True
     End Select

    Else
     If bl_w < 1 Then
      AspJpeg.Width = ImageWidth
      AspJpeg.Height = Round(AspJpeg.OriginalHeight * bl_w)
      AspJpeg.Quality = PhotoQuality
      AspJpeg.save Server.MapPath(ThumbFileName)
      CreateThumb = True
     End If
    End If

   Else
    If ImageHeight > 0 And bl_h < 1 Then
     AspJpeg.Height = ImageHeight
     AspJpeg.Width = Round(AspJpeg.OriginalWidth * bl_h)
     AspJpeg.Quality = PhotoQuality
     AspJpeg.save Server.MapPath(ThumbFileName)
     CreateThumb = True
    Else
     "宽度和高度都为0时，不做任何处理
    End If
   End If
   Set AspJpeg = Nothing
   Set AspJpeg2 = Nothing

Case "2"

Case "3"

End Select

  If Err Then
   Err.Clear
   CreateThumb = False
  End if
End Function

Private Function GetPosition_X(xImage_W, xLogo_W, SpaceVal)
  Select Case Watermark_Position
  Case 0 "左上
   GetPosition_X = SpaceVal
  Case 1 "左下
   GetPosition_X = SpaceVal
  Case 2 "居中
   GetPosition_X = (xImage_W - xLogo_W) / 2
  Case 3 "右上
   GetPosition_X = xImage_W - xLogo_W - SpaceVal
  Case 4 "右下
   GetPosition_X = xImage_W - xLogo_W - SpaceVal
  Case Else "不显示
   GetPosition_X = 0
End Select

End Function

Private Function GetPosition_Y(yImage_H, yLogo_H, SpaceVal)
  Select Case Watermark_Position
  Case 0 "左上
   GetPosition_Y = SpaceVal
  Case 1 "左下
   GetPosition_Y = yImage_H - yLogo_H - SpaceVal
  Case 2 "居中
   GetPosition_Y = (yImage_H - yLogo_H) / 2
  Case 3 "右上
   GetPosition_Y = SpaceVal
  Case 4 "右下
   GetPosition_Y = yImage_H - yLogo_H - SpaceVal
  Case Else "不显示
   GetPosition_Y = 0
  End Select

End Function

"取得文件的后缀名
Private Function GetPhotoExt(FullPath)
Dim strFileExt

If FullPath <> "" Then
strFileExt = ClsMain.ReplaceBadChar(Trim(LCase(Mid(FullPath, InStrRev(FullPath, ".") + 1))))

   If Len(strFileExt) > 10 Then
    GetPhotoExt = Left(strFileExt, 3)
   Else
    GetPhotoExt = strFileExt
   End If

  Else
   GetPhotoExt = ""
  End If

End Function

End Class
%>

本文来源：http://www.gdgbn.com/jiaocheng/22197/

上一篇： [css div 居中]css+div 3行3列图片自动排列代码

下一篇： javascript学习指南|JavaScript图片放大效果代码

[asp.net]asp 生成图片缩略图代码

相关推荐

网友关注

热门标签

最新php常用代码

php常用代码热门文章