中国DOS联盟

我不知道在哪找到一个随机颜色的QQ空间上用的一个脚本，，这个就是效果，，不是特别方便，，（其实已经很方便了，，^_^）

但看到无奈何的批处理转 UBB 代码就不觉得方便了，，我的思路是将用变颜色的文字复制到剪贴板上，，然后运行脚本，，或者P从剪贴板获取文字，，将之转换为有颜色的字，，放到剪贴板上，，如果再加一个建立快捷方式（添加热键）那么只要 复制--热键--粘贴 就OK了，，不是很方便？？最好是把字体大小也设一下，，当然，，不用像颜色那样逐个字的设，，（很大的体积）设个变量，，“”这个是QQ空间上的语法，，“”是UBB语法，，
“<font color= </font>”网页语法，，根据需要自己改就行了，，下面是我找到的随机颜色编辑器的代码，，要是能设成颜色渐变就好了，，（很贪心！！）


参照“baomaboy”“定位注册表”弄的，，加了一些代码，，（都是别人写的，，我组合的）因为我自己用世界之窗的浏览器，，会出现打开一个空白页面，，如果默认IE浏览器在END IF语句之前加一句代码“objIE.Quit”可以不打开空白网页,,网上说的，，具体我也不清楚
下面帖的代码是用在UBB上的，，跟在ELSE后面的t1 t2是设置语言的“”是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="" 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



原来的彩色字编辑器
t1="" & "" 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 ]

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 = ""
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的缺陷没有封装剪切板对象)

这个代码我想我是不喜欢用的……随机的颜色太难看了……