ASP Wsimage Component Add watermark Practical Code _ Application Tips

Source: Internet
Author: User
Tags abs add watermark to picture chr save file
ASP to add watermark to the image is the need for components ... Commonly used with AspJpeg software and the Chinese developed their own wsimage software, you can search the Internet to download these two software, recommended the use of our own development of the Chinese wsimage, after all, is the Chinese version, easy to operate.

ways to register a component:
At the command prompt, enter "regsvr32 [DLL path]".
Image add watermark is simply to get the picture size, and then write the watermark up. The ASP code is just a control component. Use code to explain everything.

One: Get picture size(This is represented by a pixel value.) A friend who learns Photoshop should understand.
Copy Code code as follows:

<%
Set Obj=server. CreateObject ("Wsimage.resize") ' Invoke component
Obj. Loadsoucepic Server.MapPath ("25.jpg") ' Open the picture, the picture name is 25.jpg
Obj. Getsourceinfo Iwidth,iheight
Response.Write "Picture width:" & iwidth & "<br>" "Get Picture width
Response.Write "Picture height:" & iheight & "<br>" ' Get picture height
Strerror=obj.errorinfo
If strerror<> "" Then
Response.Write Obj.errorinfo
End If
Obj.free
Set obj=nothing
%>

''----------------------------------------------------------------''
Two: Add text watermark
Copy Code code as follows:

<%
Set Obj=server. CreateObject ("Wsimage.resize")
Obj. Loadsoucepic Server.MapPath ("25.jpg") ' Load picture
Obj. Quality=75
Obj. Txtmarkfont = "Chinese Cloud" ' Set watermark text font
Obj. Txtmarkbond = False ' sets the thickness of the watermark text
Obj. markrotate = 0 ' The rotation angle of the watermark text
Obj. Txtmarkheight = 25 ' height of watermark text
Obj. Addtxtmark Server.MapPath ("txtmark.jpg"), "take you out of the departure", &h00ff00& 10, 70
Strerror=obj.errorinfo ' produces the picture name, the text color is the watermark in the picture position
If strerror<> "" Then
Response.Write Obj.errorinfo
End If
Obj.free
Set obj=nothing
%>

''----------------------------------------------------------------''
Three: Add a picture watermark
Copy Code code as follows:

<%
Set Obj=server. CreateObject ("Wsimage.resize")
Obj. Loadsoucepic Server.MapPath ("25.jpg") ' Load picture
Obj. Loadimgmarkpic Server.MapPath ("blend.bmp") ' Load watermark picture
Obj. Quality=75
Obj. Addimgmark Server.MapPath ("imgmark.jpg"), 315, 220,&HFFFFFF, 70
Strerror=obj.errorinfo ' produces the picture name, the text color is the watermark in the picture position
If strerror<> "" Then
Response.Write Obj.errorinfo
End If
Obj.free
Set obj=nothing
%>

''----------------------------------------------------------------''
In fact, add a watermark to the picture is so simple. And then I'm going to say another two main usages of the WsImage.dll component. Includes:
Trim the picture and generate a thumbnail of the picture.
Or in my habit, use code to add notes:
To trim a picture:
Copy Code code as follows:

<%
Set Obj=server. CreateObject ("Wsimage.resize")
Obj. Loadsoucepic Server.MapPath ("25.jpg")
Obj. Quality=75
Obj.cropimage Server.MapPath ("25_crop.jpg"), 100,10,200,200 ' define cut size and generate picture name
Strerror=obj.errorinfo
If strerror<> "" Then
Response.Write Obj.errorinfo
End If
Obj.free
Set obj=nothing
%>

Detailed note: Cut the picture to use the Wsimage Cropimage method. When the definition generates the picture, 100,10 is the cut point in the upper left corner, which is 100 pixels to the left of the picture, and the top 10 pixels. The latter two 200 represent the cut of the broadband and high and height.
''----------------------------------------------------------------''
generate thumbnail images of pictures:
Copy Code code as follows:

<%
Set Obj=server. CreateObject ("Wsimage.resize")
Obj. Loadsoucepic Server.MapPath ("25.jpg") ' Load picture
Obj. Quality=75
Obj. Outputspic Server.MapPath ("25_s.jpg"), 0.5,0.5,3 ' defines the name of the thumbnail as the size
Strerror=obj.errorinfo
If strerror<> "" Then
Response.Write Obj.errorinfo
End If
Obj.free
Set obj=nothing
%>

Detailed Description:
There are four ways to produce thumbnails
(1) obj. Outputspic Server.MapPath ("25_s.jpg"), 200,150,0
200 for the output width, 150 for the output is high, this type of output is forced output width high, may cause picture distortion.
(2) obj. Outputspic Server.MapPath ("25_s.jpg"), 200,0,1
With 200 as the output width, the output height will scale with the column.
(3) obj. Outputspic Server.MapPath ("25_s.jpg"), 0,200,2
Output is high with 200, and the output width will scale with the column.
(4) obj. Outputspic Server.MapPath ("25_s.jpg"), 0.5,0.5,3
The first 0.5 indicates that the resulting thumbnail is half the width of the original image, which means a narrowing ratio.
The second 0.5 means that the resulting thumbnail is half the height of the original image, which means a high narrowing ratio.
A wide-height narrowing of the proportions means that the original image will be scaled down. If the zoom ratio is greater than 1, the original image is magnified.
2---------------------------------------------------------------------------------------
Copy Code code as follows:

<%
Dim Stream1,stream2,istart,iend,filename
Istart=1
VBENTER=CHR (&AMP;CHR) (10)
function GetValue (fstr,foro,paths) ' Fstr for received name, Foro boolean false for file upload, true to normal field, path for upload file
If Foro Then
Getvalue= ""
Istart=instring (ISTART,FSTR)
Istart=istart+len (FSTR) +5
Iend=instring (istart,vbenter+ "-----------------------------")
If Istart>5+len (FSTR) Then
Getvalue=substring (Istart,iend-istart)
Else
Getvalue= ""
End If
Else
Istart=instring (ISTART,FSTR)
Istart=istart+len (FSTR) +13
Iend=instring (Istart,vbenter)-1
Filename=substring (Istart,iend-istart)
Filename9=right (GetFileName (filename), 4) ' Take the original file suffix
Filename8=year (now ()) &month (now ()) &day (today ()) &hour (now ()) &minute (now ()) &second (now ()) & Int (9*10^3*rnd) +10^3 ' take random filename,
' If you want to add a long file name, please change the value of 100 in (100*RND)
Filename=replace (filename), getfilename (filename), filename8) ' replaces the original file name with the Replace function
Filename=filename&filename9 ' plus file suffix, rules for generated random file names plus the original file suffix
Istart=instring (Iend,vbenter+vbenter) +3
Iend=instring (istart,vbenter+ "-----------------------------")
Filestart=istart
Filesize=iend-istart-1
Objstream.position=filestart
Set SF = Server.CreateObject ("ADODB.") Stream ")
sf. Mode=3
sf. Type=1
sf. Open
Objstream.copyto sf,filesize
If filename<> "" Then
Set RF = Server.CreateObject ("Scripting.FileSystemObject")
I=0
Fn=filename
While RF. FileExists (Server.MapPath (PATHS+FN))
Fn=cstr (i) +filename
I=i+1
Wend
Filename=fn
sf. SaveToFile Server.MapPath (paths+filename), 2
'''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Jpeg
Set Jpeg = Server.CreateObject ("Persits.jpeg")
If-2147221005=err Then
Response.Write "No this component, please install!" ' Check to see if the AspJpeg component is installed
Response.End ()
End If
Jpeg.open (Server.MapPath (paths+filename)) ' Open picture
If Err.Number Then
Response.Write "Open picture failed, please check the path!" "
Response.End ()
End If
Dim AA
Aa=jpeg.binary ' assigns raw data to AA
' ========= plus text watermark =================
Jpeg.Canvas.Font.Color = &hff0000 ' watermark text color
Jpeg.Canvas.Font.Family = Arial ' font
Jpeg.Canvas.Font.Bold = True ' whether bold
Jpeg.Canvas.Font.Size = 30 ' font size
Jpeg.Canvas.Font.ShadowColor = &h000000 ' shadow color
Jpeg.Canvas.Font.ShadowYOffset = 1
Jpeg.Canvas.Font.ShadowXOffset = 1
Jpeg.Canvas.Brush.Solid = True
Jpeg.Canvas.Font.Quality = 4 ' Output quality
Jpeg.Canvas.PrintText jpeg.originalwidth/2-100,jpeg.originalheight/2+20, "www.my9933.com" ' watermark position and text
Bb=jpeg.binary ' The text watermark processing value assigned to BB, at this time, text watermark no opacity
' ============ Adjust text transparency ================
Set myjpeg = Server.CreateObject ("Persits.jpeg")
Myjpeg.openbinary AA
Set Logo = Server.CreateObject ("Persits.jpeg")
Logo.openbinary BB
Myjpeg.drawimage 0,0, Logo, 0.2 ' 0.3 is transparency
Cc=myjpeg.binary ' assigns the final result to CC, and you can also generate the target picture.
Response. BinaryWrite cc ' converts binary output to browser
Myjpeg.save (Server.MapPath (paths+filename))
Set aa=nothing
Set bb=nothing
Set cc=nothing
Jpeg.close
Myjpeg.close
Logo.close
'''''''''''''''''''''''''''''''''''''''''''''''''''''
End If
Getvalue=filename
End If
End Function
Function subString (Thestart,thelen)
Dim i,c,stemp
Objstream.position=thestart-1
Stemp= ""
For I=1 to TheLen
If Objstream.eos then Exit for
C=ASCB (Objstream.read (1))
If C > 127 Then
If Objstream.eos then Exit for
STEMP=STEMP&AMP;CHR (AscW (ChrB (AscB (Objstream.read (1)) &AMP;CHRB (c)))
I=i+1
Else
STEMP=STEMP&AMP;CHR (c)
End If
Next
Substring=stemp
End Function
Function instring (THESTART,VARSTR)
Dim i,j,bt,thelen,str
Instring=0
Str=tobyte (VARSTR)
Thelen=lenb (STR)
For I=thestart to Objstream.size-thelen
If I>objstream.size then Exit Function
Objstream. Position=i-1
If AscB (objstream. Read (1)) =ASCB (MidB (str,1)) Then
Instring=i
For j=2 to TheLen
If objstream. EOS Then
Instring=0
Exit for
End If
If AscB (objstream. Read (1)) &LT;&GT;ASCB (MidB (str,j,1)) Then
Instring=0
Exit for
End If
Next
If Instring<>0 then Exit Function
End If
Next
End Function
Private function GetFileName (fullpath)
If fullpath <> "" Then
GetFileName = Mid (Fullpath,instrrev (FullPath, "\") +1)
Else
GetFileName = ""
End If
End Function
function ToByte (STR)
Dim I,icode,c,ilow,ihigh
Tobyte= ""
For I=1 to Len (STR)
C=mid (str,i,1)
Icode =ASC (c)
If icode<0 Then icode = Icode + 65535
If icode>255 Then
Ilow = Left (Hex (ASC (c)), 2)
Ihigh =right (Hex (ASC (c)), 2)
ToByte = ToByte & ChrB ("&h" &ilow) & ChrB ("&h" &ihigh)
Else
ToByte = ToByte & ChrB (AscB (c))
End If
Next
End Function
%>

3---------------------------------------------------------------------------------------
use ASP component Persits.jpeg to add watermark to picture, generate thumbnail
Copy Code code as follows:

<%
Filename= "1.jpg"
Set Jpeg = Server.CreateObject ("Persits.jpeg")
' Get Source picture path
Path = Server.MapPath (FileName)
' Open the source picture
' Response.Write (Path)
Jpeg.open Path
' Create thumbnail details There are a number of ways to set this up. The following method is to determine the aspect ratio and then scale
If jpeg.originalwidth/jpeg.originalheight > 1 Then
Jpeg.width = 98
jpeg.height = Int ((98/jpeg.originalwidth) *jpeg.originalheight)
ElseIf Jpeg.originalwidth/jpeg.originalheight < 1 Then
Jpeg.width = 98
jpeg.height= Int ((98/jpeg.originalwidth) *jpeg.height)
End If
' Set sharpening effect
Jpeg.sharpen 1, 130
' Generate thumbnails to the specified path
Response.Write Server.MapPath (".")
Jpeg.save Server.MapPath (".") & "\small\" &filename
' Response.Write filename1
' Response.Write Server.MapPath ("Uploadpic/small") & "\" &filename1
' Note that these two sessions
' Session ("PPP0") =gp_curpath&filename
' Session ("PPP1") =gp_curpath& "small" &filename
Set Jpeg = Nothing
' Automatically produces a thumbnail end
' Big picture water print start
' Establish an instance
Set Jpeg = Server.CreateObject ("Persits.jpeg")
' Open the target picture
Path = Server.MapPath (FileName)
' Open the source picture
Jpeg.open Path
' Add text watermark
Jpeg.Canvas.Font.Color = &hff0000 ' Red
Jpeg.Canvas.Font.Family = "Song Body"
Jpeg.Canvas.Font.Bold = True
Jpeg.Canvas.Print 10, 10, "Acer Blue Technology"
' Save file
Jpeg.save Server.MapPath (".") & "\small\w_" &filename
' Logout Object
Set Jpeg = Nothing
' Big picture, water seal, end.
%>

4---------------------------------------------------------------------------------------
implementing code by using AspJpeg to build and watermark ASP
Copy Code code as follows:

<%
Class qswhimg
Dim aso
Private Sub Class_Initialize
Set Aso=createobject ("ADODB.stream")
Aso. Mode=3
Aso. Type=1
Aso. Open
End Sub
Private Sub Class_Terminate
Set aso=nothing
End Sub
Private Function bin2str (Bin)
Dim I, Str
For I=1 to LenB (Bin)
CLOW=MIDB (bin,i,1)
If ASCB (Clow) <128 Then
str = str & CHR (ASCB (Clow))
Else
I=i+1
If I <= LenB (Bin) then str = str & CHR (ASCW (MidB (bin,i,1) &clow))
End If
Next
Bin2str = Str
End Function
Private Function num2str (num,base,lens)
' Qiushuiwuhen (2002-8-12)
Dim ret
ret = ""
while (Num>=base)
ret = (num mod base) & RET
num = (num-num mod base)/base
Wend
Num2str = Right (string (lens, "0") & Num & Ret,lens)
End Function
Private Function Str2Num (str,base)
' Qiushuiwuhen (2002-8-12)
Dim ret
RET = 0
For I=1 to Len (str)
RET = ret *base + CInt (Mid (str,i,1))
Next
Str2num=ret
End Function
Private Function Binval (BIN)
' Qiushuiwuhen (2002-8-12)
Dim ret
RET = 0
For i = LenB (bin) to 1 step-1
RET = ret *256 + ASCB (MidB (bin,i,1))
Next
Binval=ret
End Function
Private Function BinVal2 (BIN)
' Qiushuiwuhen (2002-8-12)
Dim ret
RET = 0
For i = 1 to LenB (BIN)
RET = ret *256 + ASCB (MidB (bin,i,1))
Next
Binval2=ret
End Function
Function getimagesize (filespec)
' Qiushuiwuhen (2002-9-3)
Dim ret (3)
Aso. LoadFromFile (filespec)
Bflag=aso.read (3)
Select Case Hex (binval (Bflag))
Case "4E5089":
Aso.read (15)
RET (0) = "PNG"
RET (1) =binval2 (Aso.read (2))
Aso.read (2)
RET (2) =binval2 (Aso.read (2))
Case "464947":
Aso.read (3)
RET (0) = "GIF"
RET (1) =binval (Aso.read (2))
RET (2) =binval (Aso.read (2))
Case "535746":
Aso.read (5)
Bindata=aso. Read (1)
Sconv=num2str (ASCB (Bindata), 2, 8)
Nbits=str2num (Left (sconv,5), 2)
Sconv=mid (sconv,6)
while (Len (sconv) <nbits*4)
Bindata=aso. Read (1)
Sconv=sconv&num2str (ASCB (Bindata), 2, 8)
Wend
RET (0) = "SWF"
RET (1) =int (ABS (Str2Num (mid sconv,1*nbits+1,nbits), 2)-str2num (Mid (Sconv,0*nbits+1,nbits), 2))/20)
RET (2) =int (ABS (Str2Num (mid sconv,3*nbits+1,nbits), 2)-str2num (Mid (Sconv,2*nbits+1,nbits), 2))/20)
Case "FFD8FF":
Todo
Do:p1=binval (ASO. Read (1)): Loop while p1=255 and not ASO. Eos
If p1>191 and p1<196 then exit do else Aso.read Binval2 (ASO. Read (2))-2
Do:p1=binval (ASO. Read (1)): Loop while p1<255 and not ASO. Eos
Loop while True
Aso. Read (3)
RET (0) = "JPG"
RET (2) =binval2 (ASO). Read (2))
RET (1) =binval2 (ASO). Read (2))
Case Else:
If left (Bin2str (Bflag), 2) = "BM" Then
Aso. Read (15)
RET (0) = "BMP"
RET (1) =binval (ASO). Read (4))
RET (2) =binval (ASO). Read (4))
Else
RET (0) = ""
End If
End Select
RET (3) = "Width=" "" & RET (1) & "" "Height=" "" & Ret (2) & "" "
Getimagesize=ret
End Function
End Class
Savefullpath= "326151745wldn.jpg" ' Picture path assignment or picture path variable assignment
' Get the width of the picture
Set QSWH = new qswhimg
arr = Qswh.getimagesize (Server.MapPath (Savefullpath))
Set QSWH = Nothing
Str_imgwidth=arr (1)
Str_imgheight=arr (2)
If Int (str_imgwidth) > Then
Str_imgwidth = 600
Else
Str_imgwidth = Str_imgwidth
End If
' Add watermark
If int (str_imgwidth) > + int (str_imgheight) > Then
Localfile=server.mappath (Savefullpath)
Targetfile=server.mappath (Savefullpath)
Dim Jpeg
Set Jpeg = Server.CreateObject ("Persits.jpeg")
If-2147221005=err Then
Response.Write (' <script language= ' JavaScript ' >alert (' No this component, please install! '); History.back ();</script> ")" Check to see if the AspJpeg component is installed
Response.End ()
End If
Jpeg.open (LocalFile) ' Open picture
If Err.Number Then
Response.Write (' <script language= ' JavaScript ' >alert (' Open picture failed, please check the path! '); History.back ();</script> ")
Response.End ()
End If
Dim AA
Aa=jpeg.binary ' assigns raw data to AA
' ========= plus text watermark =================
Jpeg.Canvas.Font.Color = &hfffffff ' watermark text color
Jpeg.Canvas.Font.Family = Arial ' font
Jpeg.Canvas.Font.Bold = True ' whether bold
Jpeg.Canvas.Font.Size = 20 ' font size
Jpeg.Canvas.Font.ShadowColor = &h000000 ' shadow color
Jpeg.Canvas.Font.ShadowYOffset = 1
Jpeg.Canvas.Font.ShadowXOffset = 1
Jpeg.Canvas.Brush.Solid = True
Jpeg.Canvas.Font.Quality = 10 ' Output quality
Jpeg.Canvas.PrintText jpeg.originalwidth/2-40,jpeg.originalheight/2-10, "website construction" ' Watermark location and text
Bb=jpeg.binary ' The text watermark processing value assigned to BB, at this time, text watermark no opacity
' ============ Adjust text transparency ================
Set myjpeg = Server.CreateObject ("Persits.jpeg")
Myjpeg.openbinary AA
Set Logo = Server.CreateObject ("Persits.jpeg")
Logo.openbinary BB
Myjpeg.drawimage 0,0, Logo, 0.5 ' 0.3 is transparency
Cc=myjpeg.binary ' assigns the final result to CC, and you can also generate the target picture.
Response.BinaryWrite cc ' converts binary output to browser
Myjpeg.save (TargetFile)
Set aa = Nothing
Set bb = Nothing
Set cc = Nothing
Jpeg.close
Myjpeg.close
Logo.close
End If
' Add watermark
%>
Related Article

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.