 『楼 主』:
剪贴板文字自动着色
我不知道在哪找到一个随机颜色的QQ空间上用的一个脚本，，这个就是效果，，不是特别方便，，（其实已经很方便了，，^_^）
但看到无奈何的批处理转 UBB 代码就不觉得方便了，，我的思路是将用变颜色的文字复制到剪贴板上，，然后运行脚本，，或者P从剪贴板获取文字，，将之转换为有颜色的字，，放到剪贴板上，，如果再加一个建立快捷方式（添加热键）那么只要 复制--热键--粘贴 就OK了，，不是很方便？？最好是把字体大小也设一下，，当然，，不用像颜色那样逐个字的设，，（很大的体积）设个变量，，“[ftc= [/ft]”这个是QQ空间上的语法，，“[color= [ “\” c o lo r]”是UBB语法，，
“<font color= </font>”网页语法，，根据需要自己改就行了，，下面是我找到的随机颜色编辑器的代码，，要是能设成颜色渐变就好了，，（很贪心！！）
参照“baomaboy”“定位注册表”弄的，，加了一些代码，，（都是别人写的，，我组合的）因为我自己用世界之窗的浏览器，，会出现打开一个空白页面，，如果默认IE浏览器在END IF语句之前加一句代码“objIE.Quit”可以不打开空白网页,,网上说的，，具体我也不清楚
下面帖的代码是用在UBB上的，，跟在ELSE后面的t1 t2是设置语言的“[color= ”是UBB语法，，“<font color= </font>”网页语法，t3 t4是设置字体大小的，，表达能力有限，，望包含，，还有就是脚本前面的那些代码是我复制过来的，，（由此可见“baomaboy”代码的可重用性很高）我不知道哪些不要，，请高手帮我删掉不要的,快捷方式的路径是paths = "C:\Documents and Settings\All Users\「开始」菜单\程序\附件\快捷功能"可以改，，但必需在桌面或开始菜单里
我组合的剪贴板文字自动着色
Dim WshSHell,FSO
On Error Resume Next
Set WshSHell = WScript.CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WinVer = WshSHell.Environment("Process")
Set Args = WScript.Arguments
Set Shell = CreateObject("WScript.Shell")
paths = "C:\Documents and Settings\All Users\「开始」菜单\程序\附件\快捷功能"
If FSO.FolderExists(paths) Then
Else
fso.createfolder(paths)
End If
lnkname = "C:\Documents and Settings\All Users\「开始」菜单\程序\附件\快捷功能\剪贴板文字自动着色.lnk"
FileName = WScript.ScriptName
FileFullName = WScript.ScriptFullName
FilePath = FSO.GetParentFolderName(FileFullName)
InsPath = FSO.GetSpecialFolder(1)'''0=windows,1=system32,2=user-Temp,
InsFullName = FSO.BuildPath(InsPath ,FileName)
Copyright="yjq635"
QQ="QQ:364698868"
Email="Email:fty1995@163.com"
InsTitle="剪贴板文字自动着色"
InsAnswer="剪贴板文字自动着色"
IF FileFullName <> InsFullName then
intAnswer = MsgBox("【是】添加使用shift+x访问“"+ InsAnswer +"”"&Chr(10)&Chr(10)&"【否】删除使用shift+x访问“"+ InsAnswer +"” ", vbQuestion + vbYesNoCancel, "安装 - "+ InsTitle +" - "+ Copyright)
If intAnswer = vbYes Then
FSO.GetFile(FileFullName).Copy(InsFullName)
Set link = Shell.CreateShortcut(paths & "\剪贴板文字自动着色.lnk")
link.Description = "剪贴板文字自动着色"
link.HotKey = "shift+x"
link.TargetPath = InsFullName
link.WindowStyle = 2
link.WorkingDirectory = "%windir%"
link.Save
end if
If intAnswer = vbNo Then
FSO.DeleteFile lnkname
FSO.DeleteFile InsFullName
End If
If intAnswer = vbCancel Then
end if
ELSE
t1="[color=#"
t2="[" & "/color]"
t3="[size=3]"
t4="[/size]"
t=UCase(CreateObject("htmlfile").parentWindow.clipboardData.getData("text"))
tlen=Len(t) '得到字体的长度
If tlen>0 Then
Randomize
ti="" '输出的字体
n=16777215/tlen '得到颜色的增加量
n1=100+INT(RND*1000) '颜色的开始值
'MsgBox tlen
For i = 1 To tlen
If Left(t,1)=" " Then n1=Int(16767215*rnd)+10000 '当输入的字符以" "开头则用随机颜色
'ti=t1 & CInt("&H" & cR) & CInt("&H" & cG)& CInt("&H" & cB) & "]" Mid(t,i,1) & t2
ti=ti & t1 & Hex(n1) & "]" & Mid(t,i,1) & t2
n1=n1+n
Next
ti=t3 & ti & t4
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Navigate("about:blank")
objIE.document.parentwindow.clipboardData.SetData "text", ti
End If
End If 原来的彩色字编辑器
t1="" & "[color=#"
t2="[" & "/color]"
t=InputBox ("★══════════════☆"& vbCr _
& "║ 绝版唐僧专用 ║" & vbcr _
& "║ 请输入字符 ║" &vbCr _
& "║ 以空格开头则用随机颜色 ║" & vbcr _
& "☆══════════════★","QQ彩字1.0")
tlen=Len(t) '得到字体的长度
If tlen>0 Then
Randomize
ti="" '输出的字体
n=16777215/tlen '得到颜色的增加量
n1=100+INT(RND*1000) '颜色的开始值
'MsgBox tlen
For i = 1 To tlen
If Left(t,1)=" " Then n1=Int(16767215*rnd)+10000 '当输入的字符以" "开头则用随机颜色
'ti=t1 & CInt("&H" & cR) & CInt("&H" & cG)& CInt("&H" & cB) & "]" Mid(t,i,1) & t2
ti=ti & t1 & Hex(n1) & "]" & Mid(t,i,1) & t2
n1=n1+n
Next
t=InputBox("★══════════════☆"& vbCr & "║ ║" & vbcr & "║ 请将下面文字复制 ║" &vbCr & "║ ║" & vbcr & "☆══════════════★","々输出",ti)
Else
MsgBox "请正确输入文字"
End If [ Last edited by yjq635 on 2007-8-28 at 11:31 AM ]
|
