<!--#include file="../conn.asp"-->
<%call head()
Call saycardd("图片DIY")%>
<%call xlanlj("picdiy.asp?sid="&sid&"&amp;saytk="&saytk&"&amp;zc=1")
dim zc,sid
sid=request.querystring("sid")
if request.querystring("zc")<>"1" then%>
<onevent type="onenterforward">
      <refresh>
        <setvar name="guest" value=""/>
        <setvar name="pic" value="http://"/>
      </refresh>
    </onevent>

图片地址：<br/><input name="pic" value="http://"/>
<br/>图片高度：<br/><input name="h" maxlength="4" format="*N" value="128"/>
<br/>图片宽度：<br/><input name="w" maxlength="4" format="*N" value="128"/>
<br/>绘制文字：
<br/><input type="text" format="*m"  name="word" maxlength="10"/>
<br/>字体颜色：<br/><select name="color" value="1">
       <option value="1">红色</option>
       <option value="2">蓝色</option>
       <option value="3">黄色</option>
       <option value="4">绿色</option>
       <option value="5">黑色</option>
       <option value="6">白色</option>
       <option value="7">灰色</option>
       </select>
<br/>文字阴影：<br/><select name="ShadowColor" value="1">
       <option value="1">红色</option>
       <option value="2">蓝色</option>
       <option value="3">黄色</option>
       <option value="4">绿色</option>
       <option value="5">黑色</option>
       <option value="6">白色</option>
       <option value="7">灰色</option>
       </select>
<br/>阴影左右偏移<br/>负数左正数右：<br/><input type="text" format="*N"  name="ShadowXoffset" maxlength="2" value="1"/>
<br/>阴影上下偏移<br/>负数上正数下：<br/><input type="text" format="*N"  name="ShadowYoffset" maxlength="2" value="1"/>
<br/>字体样式：<br/><select name="blod" value="8">
       <option value="0">无</option>
       <option value="8">粗体</option>
       </select>
<br/>文字的字体:
<br/><select name="fonttype" value="宋体">
<option value="宋体">宋体</option>
<option value="隶书">隶书</option>
<option value="楷体">楷体</option>
<option value="黑体">黑体</option>
</select>
<br/>字体位置：<br/><select name="position" value="1">
       <option value="1">上边</option>
       <option value="2">中间</option>
       <option value="3">底部</option>
       </select>
<br/>字体大小：<br/><input type="text" format="*N"  name="size" maxlength="2" value="10"/>
<br/>
<%If saytk<>1 Then
response.write "<input type=""submit"" name=""Submit"" value=""下载图片""></form><br/>"

else%>
<anchor>下载图片<go href="picdiy.asp?sid=<%=sid%>&amp;saytk=<%=saytk%>&amp;zc=1" accept-charset="utf-8" method="post">
<postfield name="h" value="$(h)"/>
<postfield name="w" value="$(w)"/>
<postfield name="pic" value="$(pic)"/>
<postfield name="word" value="$(word)"/>
<postfield name="size" value="$(size)"/>
<postfield name="color" value="$(color)"/> 
<postfield name="ShadowColor" value="$(ShadowColor)"/> 
<postfield name="blod" value="$(blod)"/>  
<postfield name="ShadowXoffset" value="$(ShadowXoffset)"/>  
<postfield name="ShadowYoffset" value="$(ShadowYoffset)"/>  
<postfield name="Solid" value="$(Solid)"/>  
<postfield name="Pen" value="$(Pen)"/> 
<postfield name="PenColor" value="$(PenColor)"/> 
<postfield name="fonttype" value="$(fonttype)"/>  
<postfield name="position" value="$(position)"/>
</go></anchor>
<%End if
else
dim filepath
'当文件数达200个时自动清空文件夹
filepath=Server.MapPath("/picview/")'文件目录
Dim fs, f, f1, fc,cs,i,fsod,Filedel
i=0 
Set fs = CreateObject("Scripting.FileSystemObject") 
Set f = fs.GetFolder(filepath) 
Set fc = f.Files 
For Each f1 in fc 
i=i+1
Next
if i>200 then

Set fs = CreateObject("Scripting.FileSystemObject") 
Set f = fs.GetFolder(filepath) 
Set fc = f.Files 
For Each f1 in fc 

Filedel=filepath&"/"&f1.name
set fsod = createobject("scripting.filesystemobject")
if (fsod.fileexists(Filedel)) then 
fsod.deletefile(Filedel)
end if
set fsod = Nothing
i=i+1
Next
end if
response.write "<p>"
dim w,h,pic,url
url=trim(request.form("pic"))
        w=request.form("w")
	h=request.form("h")
Server.ScriptTimeOut=9999999
function getHTTPPage(url) 
on error resume next 
dim http 
set Http=server.createobject("MSXML2.XMLHTTP")
Http.open "GET",url,false 
Http.send() 
if Http.readystate<>4 then 
exit function 
end if 
getHTTPPage=Http.responseBody 
set http=nothing 
if err.number<>0 then err.Clear 
end function 

Function BytesToBstr(body,Cset) 
dim objstream 
set objstream = Server.CreateObject("adodb.stream") 
objstream.Type = 1 
objstream.Mode =3 
objstream.Open 
objstream.Write body 
objstream.Position = 0 
objstream.Type = 2 
objstream.Charset = Cset 
BytesToBstr = objstream.ReadText 
objstream.Close 
set objstream = nothing 
End Function 

function saveimage(from,tofile) 
dim geturl,objStream,imgs 
geturl=trim(from) 
imgs=gethttppage(geturl)'
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Type =1 
objStream.Open 
objstream.write imgs
objstream.SaveToFile server.mappath(tofile),2
objstream.Close()
set objstream=nothing 
end function 
dim picfile,pictype
pictype=Right(url,3)
if pictype<>"jpg" and pictype<>"gif" and pictype<>"bmp" and pictype<>"png" then
 Response.Write "图片格式限为gif,jpg,bmp,png<br/>"
 Response.Write "<a href=""diy.asp?sid="&sid&"&amp;saytk="&saytk&""">返回继续DIY</a><br/>"
Call headsay()
 response.end
 End if 
dim filename,ranNum
randomize
ranNum=int(90000*rnd)+10000
filename=year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&ranNum&"."&pictype
picfile="/picview/"&filename
saveimage url,picfile
response.write "远程地址:"
response.write url
response.write "<br/>"
response.write "本地地址:"
response.write ""&picfile&""
response.write "<br/>"
dim ggss,fso
IF InStrRev(picfile,".") > 0 THEN
ggss = mid(tofile,InStrRev(picfile,".")+1)
end if
response.write "文件格式:"
response.write ""&ggss&""
response.write "<br/>"
Set fso=CreateObject("Scripting.FileSystemObject") 
Set f=fso.GetFile(server.mappath(""&picfile&"")) 
filesize=f.size 
response.write "文件大小:"
response.write ""&int(filesize/1024)&"KB<br/>"
dim word,wize,color,ShadowColor,blod,fonttype,position,ShadowXoffset,ShadowYoffset,Solid,Pen,PenColor
        word=request("word")
        size=request("size")
        if size="" then size=15
        color=request("color")
        ShadowXoffset=request("ShadowXoffset")
        ShadowYoffset=request("ShadowYoffset")
        ShadowColor=request("ShadowColor")
        Solid=request("Solid")
        Pen=request("Pen")
        PenColor=request("PenColor")
        blod=request("blod")
        fonttype=request("fonttype")
        position=request("position")
	if w<>"" and h<>"" and isnumeric(w)=true and isnumeric(h)=true then
		set j=server.createobject("persits.jpeg")
		j.open server.mappath(""&picfile&"")
		j.width=w
		j.height=h
          if word<>"" then
   	  if color=1 then
      j.Canvas.Font.Color = &HFF0000' red 颜色 
      elseif color=2 then
      j.Canvas.Font.Color = &H0000FF' red 颜色 
      elseif color=3 then
  	  j.Canvas.Font.Color = &HFFFF00' red 颜色 
      elseif color=4 then
	    j.Canvas.Font.Color = &H00FF00' red 颜色 
      elseif color=5 then
	    j.Canvas.Font.Color = &H000000' red 颜色 
      elseif color=6 then
	    j.Canvas.Font.Color = &HFFFFFF' red 颜色 
      elseif color=7 then
	   j.Canvas.Font.Color = &HC0C0C0' red 颜色 
      end if
      
   	  if ShadowColor=1 then
      j.Canvas.Font.ShadowColor = &HFF0000' red 颜色 
      elseif ShadowColor=2 then
      j.Canvas.Font.ShadowColor = &H0000FF' red 颜色 
      elseif ShadowColor=3 then
  	  j.Canvas.Font.ShadowColor = &HFFFF00' red 颜色 
      elseif ShadowColor=4 then
	    j.Canvas.Font.ShadowColor = &H00FF00' red 颜色 
      elseif ShadowColor=5 then
	    j.Canvas.Font.ShadowColor = &H000000' red 颜色 
      elseif ShadowColor=6 then
	    j.Canvas.Font.ShadowColor = &HFFFFFF' red 颜色 
      elseif ShadowColor=7 then
	   j.Canvas.Font.ShadowColor = &HC0C0C0' red 颜色 
      end if
j.Canvas.Font.ShadowXoffset =ShadowXoffset
j.Canvas.Font.ShadowYoffset =ShadowYoffset
j.Canvas.Font.Family = fonttype
j.Canvas.Font.Size = size 
if blod=8 then
j.Canvas.Font.Bold = True '是否加粗 
end if
 
      if position=1 then'上边
      	pw=j.Width/4
      	ph=10
      elseif position=2 then'中间
      	pw=j.Width/4
      	ph=j.Height/2-10
      elseif position=3 then'下边
      	pw=j.Width/4
      	ph=j.Height-20
      end if
      j.Canvas.Print pw, ph, word 

end if
					j.Save Server.MapPath("/picview/"&w&"_"&h&".jpg")
					Set j = Nothing
	response.write("<img src=""/picview/"&w&"_"&h&".jpg"" alt="".""/><br/><a href=""/picview/"&w&"_"&h&".jpg"">下载该图</a><br/>")
	
	response.write("<a href=""picdiy.asp?sid="&sid&"&amp;saytk="&saytk&""">返回继续DIY</a>")
else
	response.write("请填写完整再进行DIY")
end if
end if
response.write "<br/><a href=""index.asp?sid="&sid&"&amp;saytk="&saytk&""">返回上级</a>"
response.write "<br/><a href=""/index.asp?sid="&sid&"&amp;saytk="&saytk&""">网站首页</a><br/>"
response.write"<img src='/foryou/clock.gif' alt='.'/>"&Month(Now)&"月"&Day(Now)&"日"&FormatDateTime(Now,vbshortTime)&""
Call headsay()
%>
