Board logo

标题: 论坛彩色渐变代码生成器 VBS 版（增加IE界面输入版） [打印本页]
作者: zh159     时间: 2007-3-20 13:12    标题: 论坛彩色渐变代码生成器 VBS 版（增加IE界面输入版）

花了两天学了些 VBS 脚本，做了个 VBS 版的论坛彩色渐变代码生成器，支持一般的特殊字符；可以显示最终结果并在显示界面上一键复制代码（需要IE支持） 点击下载“论坛彩色渐变代码生成器 VBS 版” =============================================== 增加 论坛彩色渐变代码生成器 IE 界面 VBS 版（默认浏览器必须是IE，否则实效，这是VBS本身的问题） 点击下载“论坛彩色渐变代码生成器 IE 界面 VBS 版”
set WsShell = Wscript.CreateObject("Wscript.Shell")
strPath = WsShell.CurrentDirectory
colorlist = "ff0000ff1100ff2200ff3300ff4400ff5500ff6600ff7700ff8800ff9900ffaa00ffbb00ffcc00ffdd00ffee00ffff00eeff00ddff00ccff00bbff00aaff0099ff0088ff0077ff0066ff0055ff0044ff0033ff0022ff0011ff0000ff0000ff1100ff2200ff3300ff4400ff5500ff6600ff7700ff8800ff9900ffaa00ffbb00ffcc00ffdd00ffee00ffff00eeff00ddff00ccff00bbff00aaff0099ff0088ff0077ff0066ff0055ff0044ff0033ff0022ff0011ff0000ff1100ff2200ff3300ff4400ff5500ff6600ff7700ff8800ff9900ffaa00ffbb00ffcc00ffdd00ffee00ffff00ffff00eeff00ddff00ccff00bbff00aaff0099ff0088ff0077ff0066ff0055ff0044ff0033ff0022ff0011"
InputText = InputBox("论坛彩色渐变代码生成器 VBS 版" + vbCrLf + "zh159@bbs.cn-dos.net" + vbCrLf + "              2007-3-19" + vbCrLf + vbCrLf + vbCrLf + "请输入文字：", "输入文字  zh159@bbs.cn-dos.net", "请输入文字")
if InputText = "" then 
Wscript.quit
end if
start = InputBox("已输入的文字：" + vbCrLf + "======================================" + vbCrLf + "    " + InputText + vbCrLf + "======================================" + vbCrLf + vbCrLf + "请选择开始的颜色编号：" + vbCrLf + " 1   2   3   4   5     6   7" + vbCrLf + " 红  橙  黄  绿  亮蓝  蓝  紫", "选择开始颜色编号", "1")
if start = "" then Wscript.quit
if start = 2 then start = 49
if start = 3 then start = 91
if start = 4 then start = 181
if start = 5 then start = 271
if start = 6 then start = 361
if start = 7 then start = 451

do While True
NumMax = NumMax+1
Input = Mid(InputText, NumMax, 1)
If Input = "" Then Exit Do
loop
NumMax = NumMax-1

step = 6
if NumMax < 70 then step = 12
if NumMax < 40 then step = 18
if NumMax < 20 then step = 30
if NumMax < 10 then step = 42

for Num = 1 to NumMax
if start > 540 then start = start-540
color = Mid(colorlist, start, 6)
Input = Mid(InputText, Num, 1)
start = start+step
str = str+"[color="+color+"]"+Input+"[/color]"
var = var+"<font color=#"+color+">"+Input+"</font>"
next

height = 510+(NumMax/34*16) 

set ie=wscript.createobject("internetexplorer.application","event_") 
ie.menubar=0
ie.addressbar=0
ie.toolbar=0
ie.statusbar=0
ie.resizable=0
ie.width=600
ie.height=height
ie.navigate "about:blank"
ie.left=fix((ie.document.parentwindow.screen.availwidth-ie.width)/2)
ie.top=fix((ie.document.parentwindow.screen.availheight-ie.height)/2)
ie.visible=1

with ie.document
.write "<html><title>论坛彩色渐变代码生成器-zh159</title><body background='" & strPath & "/bg.gif' bgcolor=#e3e5da scroll=yes style='font-family:宋体;font-size:15px;'>"
.write "<SCRIPT language=JavaScript>function copy(ob){var obj=findObj(ob); if (obj) { obj.select();js=obj.createTextRange();js.execCommand('Copy');}}function findObj(n, d) {var p,I,x;  if(!d) d=document; if((p=n.indexOf('?'))>0&&parent.frames.length) {d=parent.frames[n.substring(p+1)].document; n=n.substring(0,p);}  if(!(x=d[n])&&d.all) x=d.all[n]; for (i=0;!x&&i<d.forms.length;i++) x=d.forms[i][n]; for(i=0;!x&&d.layers&&i<d.layers.length;i++) x=findObj(n,d.layers[i].document); if(!x && document.getElementById) x=document.getElementById(n); return x;}</SCRIPT>"
.write "<table align=center style='width:95%;font-family:宋体;font-size:15px;'><tr><td>效果显示：<br>"&var&"<br><br>代码：<br></tr></td>"
.write "<tr align=center><td><form name='fom1' method='post' action=''><textarea name='txtOutput' style='width:100%; height:300;font-family:宋体;font-size:13px;'>"&str&"</textarea></form>"
.write "<input type='button' name='Button' value='复制到剪贴板' onClick=copy('txtOutput')>　<input type='button' name='Button' id='continue' value='继续'></tr></td>"
.write "</table></body></html>"
end with

dim wmi
set wnd=ie.document.parentwindow
set id=ie.document.all
id.continue.onclick=getref("continue")

do while true
wscript.sleep 500
WsShell.AppActivate ("论坛彩色渐变代码生成器-zh159 - Microsoft Internet Explorer")
loop

sub event_onquit
wscript.quit
end sub

sub continue
ie.visible=0
WsShell.Run Wscript.ScriptFullName
wscript.quit
end sub
[ Last edited by zh159 on 2007-3-20 at 06:08 PM ]
作者: lxmxn     时间: 2007-3-20 13:18
　　精彩，现在BAT版和VBS版的都有啦，顶一个。
作者: zh159     时间: 2007-3-20 13:20
想写一个hta脚本的，无奈发现hta脚本和VBS脚本有所不同，基本不能直接照搬（特别是：for Num = 1 to NumMax ...... next）-_-||| 找了好久也没找到hta脚本的用法、教程 PS：论坛上每个人最大总数只能上传20个附件？？？ [ Last edited by zh159 on 2007-3-20 at 12:34 AM ]
作者: lxmxn     时间: 2007-3-20 13:52
　　这个不清楚，要问问站长才知道。
作者: vkill     时间: 2007-3-21 01:58
N x
作者: vkill     时间: 2007-3-21 02:01
不过兄这样弄按原理上支持的最大数为48个字符吧？超过了这个它就重复的开始了红色
作者: zh159     时间: 2007-3-21 02:06
Originally posted by vkill at 2007-3-20 13:01: 不过兄这样弄按原理上支持的最大数为48个字符吧？超过了这个它就重复的开始了红色
分为 > 70 < 70 < 40 < 20 < 10 字符段循环 > 70 个字符，每 90 个字符循环（循环色为90种） PS：正在搞IE界面输入选色的，可以分段，不过分段后的颜色也是按顺序的（包含换行符号，虽看不见，但也占用了）不是从头开始 [ Last edited by zh159 on 2007-3-20 at 01:19 PM ]
作者: vkill     时间: 2007-3-21 02:38
呵呵
作者: 35799     时间: 2007-10-28 23:54
[color=]请[color=]输[color=]入[color=]文[color=]字
作者: xinshou123     时间: 2008-1-4 11:54
[color=]请[color=]输[color=]入[color=]文[color=]字
作者: xinshou123     时间: 2008-1-4 11:54
[color=1]请[color=2]输[color=3]入[color=4]文[color=5]字
作者: flying008     时间: 2008-1-4 17:11
谢谢楼主啊……学习中……
作者: matlan     时间: 2008-11-26 03:18
顶一下