图片新闻幻灯片轮换(VBScript版，标题同时轮换)

sub revealTrans_news_pic()
  dim mm_id,mm_pic,mm_topic,mm_i,mm_id0,mm_topic0,mm_temp1,mm_temp2,mm_temp3
  mm_i=0
  mm_id0=0
'  mm_pic0=joekoe_cms.web_upload&"no_pic.gif"
  sql="select top 3 id,topic,pic from news where hidden=1 and ispic=1 order by id desc"
  set rs=joekoe_cms.exec(sql,1)
  do while not rs.eof
    mm_id=rs("id")
    mm_pic=rs("pic")
    mm_pic=joekoe_cms.code_html(mm_pic,1,0)
    mm_topic=rs("topic")
    mm_topic=joekoe_cms.code_html(mm_topic,1,15)
    if instr(mm_pic,"://")<1 then
      mm_pic=joekoe_cms.web_upload&mm_pic
    end if
    if mm_i=0 then
      mm_id0=rs("id")
      mm_topic0=rs("topic")
    end if
    mm_temp1= mm_temp1&mm_pic&","
    mm_temp2= mm_temp2&"news_view.asp?id="&mm_id&","
    mm_temp3= mm_temp3&"<a  href=news_view.asp?id="&mm_id&" target=_blank>"&mm_topic&"</a>,"
    mm_i=mm_i+1
    rs.movenext
  loop
  rs.close
  if instr(right(mm_temp1,1),",")>0 then
   mm_temp1=left(mm_temp1,len(mm_temp1)-1)
   mm_temp2=left(mm_temp2,len(mm_temp1)-1)
   mm_temp3=left(mm_temp3,len(mm_temp1)-1)
  end if
%>

<TABLE cellSpacing=0 cellPadding=0 width=245 border=0>
<TR>
<TD>
<SCRIPT language="VBScript">
Dim FileList,FileListArr,TxtList,TxtListArr,LinkList,LinkArr
FileList = "<%=mm_temp1%>"
LinkList = "<%=mm_temp2%>"
TxtList = "<%=mm_temp3%>"
FileListArr = Split(FileList,",")
LinkArr = Split(LinkList,",")
TxtListArr = Split(TxtList,",")
Dim CanPlay
CanPlay = CInt(Split(Split(navigator.appVersion,";")(1)," ")(2))>5
Dim FilterStr
  FilterStr = "RevealTrans(duration=2,transition=23)"
  FilterStr = FilterStr + ";BlendTrans(duration=2)"
  If CanPlay Then
   FilterStr = FilterStr + ";progid:DXImageTransform.Microsoft.Fade(duration=2,overlap=0)"
   FilterStr = FilterStr + ";progid:DXImageTransform.Microsoft.Wipe(duration=3,gradientsize=0.25,motion=reverse)"
  Else
   Msgbox "幻灯片播放具有多种动态图片切换效果，但此功能需要您的浏览器为IE5.5或以上版本，否则您将只能看到部分的切换效果。",64
  End If
Dim FilterArr
FilterArr = Split(FilterStr,";")
Dim PlayImg_M
PlayImg_M = 5 * 1000  '切换时间（毫秒）
Dim I
I = 1
Sub ChangeImg
  Do While FileListArr(I)=""
  I = I + 1
  If I>UBound(FileListArr) Then I = 0
  Loop
  Dim J
  If I>UBound(FileListArr) Then I = 0
  Randomize
  J = Int(Rnd * (UBound(FilterArr)+1))
  Img.style.filter = FilterArr(J)
  Img.filters(0).Apply
  Img.Src = FileListArr(I)
  Img.filters(0).play
  Link.Href = LinkArr(I)
  Txt.filters(0).Apply
  Txt.innerHTML = TxtListArr(I)
  Txt.filters(0).play
  I = I + 1
  If I>UBound(FileListArr) Then I = 0
  TempImg.Src = FileListArr(I)
  TempLink.Href = LinkArr(I)
  SetTimeout "ChangeImg", PlayImg_M,"VBScript"
End Sub
</SCRIPT>
<TABLE WIDTH="100%" BORDER="0" CELLSPACING="2" CELLPADDING="2">
  <TR ID="NoScript"><TD Align="Center" Style="Color:White">对不起，图片浏览功能需脚本支持，但您的浏览器已经设置了禁止脚本运行。请您在浏览器设置中调整有关安全选项。</TD></TR>
  <TR Style="Display:none" ID="CanRunScript"><TD Align="Center"><a id="Link" " target=_blank"><Img ID="Img"  Width="200" Height="150" Border="0" ></a></TD></TR>
  <TR Style="Display:none"><TD><a id=TempLink " target=_blank"><Img ID="TempImg" Border="0"></a></TD></TR>
  <TR><TD HEIGHT="100%" Align="Center" vAlign="Center"><div ID="Txt"style="PADDING-LEFT: 5px; Z-INDEX: 1; FILTER: progid:DXImageTransform.Microsoft.Fade(duration=1,overlap=0); POSITION:"><a  href=news_view.asp?id=<%=mm_id0%>  target=_blank><%=mm_topic0%></a></div></TD></TR>
</TABLE>
<Script Language="VBScript">
NoScript.Style.Display = "none"
CanRunScript.Style.Display = ""
Img.Src = FileListArr(0)
Link.Href = LinkArr(0)
SetTimeout "ChangeImg", PlayImg_M,"VBScript"
</Script>
</TD>
</TR>
</table>
<%
end sub