ASP generates picture thumbnail code

<%
'======================================================
' File name: inc/clsjpeg.asp
' File function: Watermark + thumbnail class
' Last Updated: 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 < Then photoquality = 90
If photoquality > 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
' Function: To add a watermark to a picture by invoking the image processing function from the selected external component
' parameter: imgfilename----picture Path
'=================================================
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 &L t;> "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)

Color of AspJpeg.Canvas.Font.COLOR = Watermark_text_fontcolor ' text
AspJpeg.Canvas.Font.Family = Watermark_text_fontname ' font for text
AspJpeg.Canvas.Font.size = watermark_text_fontsize ' text size
AspJpeg.Canvas.Font.Bold = Watermark_text_bold ' text is bold
AspJpeg.Canvas.Font.Quality = 4 ' antialiased
AspJpeg.Canvas.PrintText ILeft, Itop, watermark_text ' position coordinates of the added text
Color of AspJpeg.Canvas.Pen.COLOR = &h0 ' border
Thickness of AspJpeg.Canvas.Pen.Width = 1 ' border
AspJpeg.Canvas.Brush.Solid = False ' Whether the color is filled in the picture border
Aspjpeg.quality = photoquality
Aspjpeg.save Server.MapPath (imgfilename) ' Generate file

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) ' Open watermark picture

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 ' Add a watermark image to the original artwork
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

'=================================================
' Procedure name: Createthumb
' Function: Invoke image processing function (thumbnail, watermark) based on the selected external component
' Parameter: Imgfilename----Original picture path
' thumbfilename----Create a path to save thumbnails
' imagewidth----thumbnail width
' imageheight----thumbnail height
'=================================================
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 &L t;> "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 ' general algorithm: Width and height are greater than 0 o'clock, directly reduced to the specified size, one of which is 0 o'clock, scaled down
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 ' cropping method: both width and height are greater than 0 o'clock, and then cropped to a specified size by the best proportion, one of which is 0 o'clock, scaled down
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) ' by shrinking into a large proportion of people
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 ' supplement: Attach a picture with the best proportions on a background image of a specified size

' Create a background image of the specified size
Aspjpeg2.width = ImageWidth
Aspjpeg2.height = ImageHeight
AspJpeg2.Canvas.Brush.Solid = True ' The color is filled within the border of the picture
AspJpeg2.Canvas.Brush.COLOR = Thumb_backgroundcolor ' Set background color
Aspjpeg2.canvas.bar-1,-1, Aspjpeg2.width + 1, aspjpeg2.height + 1 ' padding

' Reduce the picture by the best ratio
If bl_w > Bl_h Then
If Bl_h < 1 Then
Aspjpeg.height = ImageHeight
Aspjpeg.width = Round (aspjpeg.originalwidth * bl_h) ' by shrinking into a small proportion of people
End If
Else
If Bl_w < 1 Then
Aspjpeg.width = ImageWidth
Aspjpeg.height = Round (Aspjpeg.originalheight * bl_w)
End If
End If

' Get the coordinates of the thumbnail
ILeft = (aspjpeg2.width-aspjpeg.width)/2
Itop = (aspjpeg2.height-aspjpeg.height)/2

Aspjpeg2.drawimage ILeft, Itop, AspJpeg ' append thumbnails to background
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
' Width and height are all 0 o'clock, do not do any processing
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 ' top left
getposition_x = Spaceval
Case 1 ' lower left
getposition_x = Spaceval
Case 2 ' centered
getposition_x = (ximage_w-xlogo_w)/2
Case 3 ' upper right
getposition_x = Ximage_w-xlogo_w-spaceval
Case 4 ' lower right
getposition_x = Ximage_w-xlogo_w-spaceval
Case Else ' does not show
getposition_x = 0
End Select

End Function

Private Function getposition_y (Yimage_h, Ylogo_h, Spaceval)
Select Case Watermark_position
Case 0 ' top left
getposition_y = Spaceval
Case 1 ' lower left
getposition_y = Yimage_h-ylogo_h-spaceval
Case 2 ' centered
getposition_y = (yimage_h-ylogo_h)/2
Case 3 ' upper right
getposition_y = Spaceval
Case 4 ' lower right
getposition_y = Yimage_h-ylogo_h-spaceval
Case Else ' does not show
getposition_y = 0
End Select

End Function

' Get the suffix name of the file
Private Function Getphotoext (FullPath)
Dim Strfileext

If fullpath <> "" Then
Strfileext = Clsmain.replacebadchar (Trim (LCase (Mid fullpath, InStrRev (FullPath, ".") + 1))

If Len (strfileext) > Then
Getphotoext = Left (Strfileext, 3)
Else
Getphotoext = Strfileext
End If

Else
Getphotoext = ""
End If

End Function

End Class
%>