标题: 剪贴板文字自动着色 [打印本页]
作者: yjq635 时间: 2007-8-28 09:24 标题: 剪贴板文字自动着色
我不知道在哪找到一个随机颜色的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
作者: slore 时间: 2007-8-28 12:49
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 = ""
t4 = ""
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
操作剪切板要IE对象，内存好浪费＝。＝(当然这个是VBS的缺陷没有封装剪切板对象)
这个代码我想我是不喜欢用的……随机的颜色太难看了……