asp生成带参数的二维码并合成推广海报图片,asp合并合成推广海报图片asp代码

最近做的一个项目中,客户要求用asp生成二维码,然后合并到一张背景图片上,合并生成一张推广海报来,可把我愁坏了,经过一个晚上的努力,成功了,下面把这个:asp生成带参数的二维码并合成推广海报,asp合并合成推广海报asp代码,发下面来,给有需要的朋友用:

<div class="content content_bottom">
	<div class="btitle">
		<div class="box1 iconfont"><a href="javascript:history.go(-1);">&#xe6bc;</a></div>
		<div class="box2"><%=haibao_title%></div>
	</div>
<!--#include file="qrcode.asp"-->
<%
'=====图片名字生成
Function getRnd()
	Dim rndnum,filename
	Randomize Timer 
	rndnum = Int(899999 * Rnd + 100000)
	filename = year(now())&month(now())&day(now())&rndnum
	getRnd = filename
End Function

'b64=base64数据  tname=bmp/gif imgname="img/1.gif"
function base64toimage(b64,tname,imgname)
	if b64="" then base64toimage="" : exit function
	if imgname="" then base64toimage="" : exit function
	if tname="" then tname="gif"
	b64=replace(b64,"data:image/"&tname&";base64,","")
	b64=replace(b64," ","+")	
	Dim xml : Set xml=Server.CreateObject("MSXML2.DOMDocument") 
	Dim stm : Set stm=Server.CreateObject("ADODB.Stream") 
	xml.resolveExternals=False
	xml.loadXML("<?xml version=""1.0"" encoding=""gb2312""?><data><![CDATA["&b64&"]]></data>") 
	xml.documentElement.setAttribute "xmlns:dt","urn:schemas-microsoft-com:datatypes" 
	xml.documentElement.dataType = "bin.base64" 
	stm.Type=1
	stm.Open 
	stm.Write xml.documentElement.nodeTypedValue 
	stm.SaveToFile Server.MapPath(imgname),2
	stm.Close 
	Set xml=Nothing 
	Set stm=Nothing
	base64toimage=imgname
end function

'outqr(版本,纠错级别,图片格式,待生成的数据,放大倍数,边距,保存本地图片路径及名称格式)
'版本0-10  : 简易版本,编码字符不宜过多;版本越高,容纳的字符数越多
'纠错级别|[LMQH])
'图片格式: gif / bmp  : bmp的图片大一些
'待生成的数据  如:世界!你好
'放大倍数 纯数字 如:5 : 数字越大生成的二维码越大 不建议过大影响速度
'边距 纯数字 如:10
'保存本地图片路径及名称格式  如:qr/100.gif   :  如果为空将不保存本地图片,返回base64图片  重名将覆盖
function outqr(a,b,c,d,e,f,g)
		dim qr,b64img
		set qr = ASPQrcode(a,b)
		qr.useBestMaskPattern = false '如果为false,生成速度会快很多,二维码复杂点;
		qr.output =c
		b64img=qr.getBase64(d,e,f)
		set qr=nothing
		if g<>"" then  : outqr=base64toimage(b64img,c,g) : else : outqr="data:image/"&c&";base64,"&b64img : end if
end function

dim imgname,picname
picname = getRnd
ewmpic = "UploadFile/ewm/"&picname&".jpg"
website = ""&anco_site_http&"/share.asp?hyid="&newhyid&""
'看看二维码是不是入库了
if hy_wxewm<>"" then
else
Conn.ExeCute("update [member] set ewm='"&ewmpic&"' where id="&newhyid&"")
imgname=outqr(0,"M","jpg",""&website&"",13,5,"UploadFile/ewm/"&picname&".jpg")
end if
'end会员表
%>
<div class="main_95 pt10">
	<center><span class="mod"><a href="member_hb.asp">下载<%=haibao_title%></a></span></center>
	<div class="conte_text pt10">
	<%=haibao_gsl%>
	</div>
</div>

还有一个文件需要,这个是asp合并生成海报的

<%
On Error Resume Next
'先加载原始背景图片
Set yuan_jpeg = Server.CreateObject("Persits.Jpeg")
yuan_jpeg.RegKey="48958-77556-02411"
'yuan_jpeg.open server.MapPath("111.jpg")	'背景原始图片
yuan_jpeg.open server.MapPath(haibao_pic)	'背景原始图片

'加载二维码图片
set shuiying_jpeg = Server.CreateObject("Persits.Jpeg")
shuiying_jpeg.RegKey="48958-77556-02411"
'shuiying_jpeg.open server.MapPath("touixiang.jpg")	'此处找到你的二维码图片文件名
shuiying_jpeg.open server.MapPath(hy_wxewm)
shuiying_jpeg.Width = 282'二维码放到图片上后的尺寸
shuiying_jpeg.Height = 282
'在原图上加上头像图片
yuan_jpeg.DrawImage 175, 562, shuiying_jpeg'二维码放的位置,第一个数是从右往左多少像素,第二个数是从上往下多少像素
yuan_jpeg.Quality=80	'0 (default), 1 (draft), 2 (proof), 3 (non-antialiased), 4 (antialiased) 生成图片的品质
shuiying_jpeg.close
set shuiying_jpeg = nothing
'注销加头像的过程

'姓名
'yuan_jpeg.Canvas.Font.Color = &Hd11f03 'red 颜色
'yuan_jpeg.Canvas.Font.Family = "黑体" '字体
'yuan_jpeg.Canvas.Font.size = 56 '字体
'yuan_jpeg.Canvas.Font.Bold = true '是否加粗
'yuan_jpeg.Canvas.Print 530, 365, "我是水印"'打印坐标x 打印坐标y 需要打印的字符

'位置
yuan_jpeg.Canvas.Font.Color = &Hffffff 'red 颜色
yuan_jpeg.Canvas.Font.Family = "黑体" '字体
yuan_jpeg.Canvas.Font.size = 36 '字体
yuan_jpeg.Canvas.Font.Bold = true '是否加粗
'yuan_jpeg.Canvas.Print 90, 923, "中国"	'生成坐标x 生成坐标y 需要生成的字符
yuan_jpeg.Canvas.Print 60, 923, ""&newwxname&""	'生成坐标x 生成坐标y 需要生成的字符

newimg_src = ""&newhyid&".jpg"	'生成后的图片名	
yuan_jpeg.save server.MapPath("UploadFile/hb/"&newimg_src)	'保存到文件夹及文件名
yuan_jpeg.close
set yuan_jpeg=nothing

response.write "<img src='UploadFile/hb/"&newimg_src&"' width='100%' height=''>"
%>
<%end if%>

猜你喜欢

转载自blog.csdn.net/tocnc/article/details/89176540