ASP wsmageコンポーネントにウォーターマークの実用コードを追加します。
10046 ワード
ASPは写真に透かしを入れるにはコンポーネントが必要です。よく使われているのはaspjpegソフトと中国人が自分で開発したwsImageソフトです。インターネットでこの二つのソフトをダウンロードできます。中国人が自分で開発したwsyImageを使うことを勧めます。結局は中国語版です。簡単に操作できます。コンポーネントを登録する方法：コマンドプロンプトの下で「regsvr 32[Dllパス]」を入力すればいいです。画像に透かしを追加するのは、画像のサイズを獲得するだけです。透かしを書いてください。ASPコードは制御部品としての役割を果たします。コードで説明してください。一：画像の大きさ（ここではピクセル値で表されています。Photoshopを勉強している友達は全部分かります。）
<%
set obj=server.CreateObject("wsImage.Resize") ''
obj.LoadSoucePic server.mappath("25.jpg") '' , 25.jpg
obj.GetSourceInfo iWidth,iHeight
response.write " :" & iWidth & "<br>" ''
response.write " :" & iHeight & "<br>" ''
strError=obj.errorinfo
if strError<>"" then
response.write obj.errorinfo
end if
obj.free
set obj=nothing
%>
<%
set obj=server.CreateObject("wsImage.Resize")
obj.LoadSoucePic server.mappath("25.jpg") ''
obj.Quality=75
obj.TxtMarkFont = " " ''
obj.TxtMarkBond = false ''
obj.MarkRotate = 0 ''
obj.TxtMarkHeight = 25 ''
obj.AddTxtMark server.mappath("txtMark.jpg"), " ", &H00FF00&, 10, 70
strError=obj.errorinfo '' ,
if strError<>"" then
response.write obj.errorinfo
end if
obj.free
set obj=nothing
%>
<%
set obj=server.CreateObject("wsImage.Resize")
obj.LoadSoucePic server.mappath("25.jpg") ''
obj.LoadImgMarkPic server.mappath("blend.bmp") ''
obj.Quality=75
obj.AddImgMark server.mappath("imgMark.jpg"), 315, 220,&hFFFFFF, 70
strError=obj.errorinfo '' ,
if strError<>"" then
response.write obj.errorinfo
end if
obj.free
set obj=nothing
%>
<%
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 ''
strError=obj.errorinfo
if strError<>"" then
response.write obj.errorinfo
end if
obj.free
set obj=nothing
%>
<%
set obj=server.CreateObject("wsImage.Resize")
obj.LoadSoucePic server.mappath("25.jpg") ''
obj.Quality=75
obj.OutputSpic server.mappath("25_s.jpg"),0.5,0.5,3 ''
strError=obj.errorinfo
if strError<>"" then
response.write obj.errorinfo
end if
obj.free
set obj=nothing
%>
<%
Dim stream1,stream2,istart,iend,filename
istart=1
vbEnter=Chr(13)&Chr(10)
function getvalue(fstr,foro,paths)'fstr ，foro false ,true ，path
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)'
filename8=year(now())&month(now())&day(now())&hour(now())&minute(now())&second(now())&int(9*10^3*rnd)+10^3' ,
' , (100*rnd) 100
filename=replace(getfilename(filename),getfilename(filename),filename8) ' , replace
filename=filename&filename9 ' ,
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 " ， !" ' AspJpeg
Response.End()
End If
Jpeg.Open (server.mappath(paths+filename)) '
If err.number then
Response.write" , ！"
Response.End()
End if
Dim aa
aa=Jpeg.Binary ' aa
'========= =================
Jpeg.Canvas.Font.Color = &Hff0000 '
Jpeg.Canvas.Font.Family = Arial'
Jpeg.Canvas.Font.Bold = True '
Jpeg.Canvas.Font.Size = 30'
Jpeg.Canvas.Font.ShadowColor = &H000000 '
Jpeg.Canvas.Font.ShadowYOffset = 1
Jpeg.Canvas.Font.ShadowXOffset = 1
Jpeg.Canvas.Brush.Solid = True
Jpeg.Canvas.Font.Quality = 4 '
Jpeg.Canvas.PrintText Jpeg.OriginalWidth/2-100,Jpeg.OriginalHeight/2+20,"www.my9933.com" '
bb=Jpeg.Binary ' bb， ，
'============ ================
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
cc=MyJpeg.Binary ' cc,
response.BinaryWrite cc '
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&Chr(AscW(ChrB(AscB(objStream.Read(1)))&ChrB(c)))
i=i+1
else
stemp=stemp&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))<>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
%>