演示：

http://www.chinaonco.net/

首页调用：

<% call ShowPicArticle1(0,8,16,120,80,false,false) %>

inc/syscode_Article.asp加上：调用函数：

\'=================================================
\'过程名：ShowPicArticle1
\'作  用：滚动显示新闻图片文章
\'参  数：intClassID  ----栏目ID，0为所有栏目，若大于0，则显示指定栏目及其子栏目的图片文章
\'        ArticleNum  ----最多显示多少篇文章
\'        TitleLen   ----标题最多字符数，一个汉字=两个英文字符
\'        ImgWidth   ----图片宽度
\'        ImgHeight  ----图片高度
\'        Hot        ----是否是热门文章
\'        Elite      ----是否是推荐文章
\'=================================================
sub ShowPicArticle1(intClassID,ArticleNum,TitleLen,ImgWidth,ImgHeight,Hot,Elite)
dim sqlPic,i,tClass,trs,arrClassID,AD_title
if ArticleNum<0 or ArticleNum>=50 then
ArticleNum=5
end if
if ImgWidth<0 or ImgWidth>500 then
ImgWidth=160
end if
if ImgHeight<0 or ImgHeight>500 then
ImgHeight=120
end if
if Hot<>True and Hot<>False then
Hot=False
end if
if Elite<>True and Elite<>False then
Elite=False
end if
sqlPic="select top " & ArticleNum
sqlPic=sqlPic & " A.ArticleID,A.ClassID,L.LayoutID,L.LayoutFileName,A.Title,A.Key,A.Author,A.CopyFrom,A.UpdateTime,A.Editor,A.TitleFontColor,A.TitleFontType,"
sqlPic=sqlPic & " A.Hits,A.OnTop,A.Hot,A.Elite,A.Passed,A.IncludePic,A.Stars,A.PaginationType,A.ReadLevel,A.ReadPoint,A.DefaultPicUrl from Article A"
sqlPic=sqlPic & " inner join Layout L on A.LayoutID=L.LayoutID where A.Deleted=False and A.Passed=True and DefaultPicUrl<>\'\'"

if intClassID>0 then
set tClass=conn.execute("select ClassID,Child,ParentPath from ArticleClass where ClassID=" & intClassID)
if not(tClass.bof and tClass.eof) then
  if tClass(1)>0 then
   arrClassID=ClassID
   set trs=conn.execute("select ClassID from ArticleClass where ParentID=" & tClass(0) & " or ParentPath like \'%" & tClass(2) & "," & tClass(0) & ",%\' and Child=0 and LinkUrl=\'\'")
   do while not trs.eof
    arrClassID=arrClassID & "," & trs(0)
    trs.movenext
   loop
   set trs=nothing
   sqlPic=sqlPic & " and A.ClassID in (" & arrClassID & ")"
  else
   sqlPic=sqlPic & " and A.ClassID=" & tClass(0)
  end if
  set trs=nothing
else
  sqlPic=sqlPic & " and A.ClassID=" & tClass(0)
end if
set tClass=nothing
end if

if Hot=True then
sqlPic=sqlPic & " and A.Hits>=" & HitsOfHot
end if

if Elite=True then
sqlPic=sqlPic & " and A.Elite=True "
end if

sqlPic=sqlPic & " order by A.OnTop,A.ArticleID desc"
set rsPic=Server.CreateObject("ADODB.Recordset")
rsPic.open sqlPic,conn,1,1

if rsPic.bof and rsPic.eof then
response.Write "<img src=\'images/NoPic.jpg\' width=\'" & ImgWidth & "\' height=\'" & ImgHeight & "\' border=\'0\'><br>ûÓÐÈκÎͼƬÎÄÕÂ"
else
response.Write "<SCRIPT language=JavaScript>" & vbcrlf
response.Write "var bannerAD=new Array();" & vbcrlf
response.Write "var bannerADlink=new Array();" & vbcrlf
response.Write "var bannerADtitle=new Array();" & vbcrlf
response.Write "var adNum=0;" & vbcrlf

AD_title="<A onmouseover=""displayStatusMsg();return document.returnValue"" href=""javascript:jump2url()""><IMG style=""FILTER: revealTrans(duration=2,transition=20)"" width=\'" & ImgWidth & "\' height=\'" & ImgHeight & "\' border=0 src=""" & rsPic("DefaultPicUrl") & """ name=bannerADrotator></A>"
i=0
do while not rsPic.eof
  strPic=""
  call GetPicArticleTitle1(TitleLen,ImgWidth,ImgHeight,i)
  response.Write strPic & vbcrlf
  rsPic.movenext
  i=i+1
loop
response.Write "var preloadedimages=new Array();" & vbcrlf
response.Write "for (i=1;i<bannerAD.length;i++){" & vbcrlf
response.Write "preloadedimages[i]=new Image();" & vbcrlf
response.Write "preloadedimages[i].src=bannerAD[i];}" & vbcrlf
%>
function setTransition(){
   if (document.all){
      bannerADrotator.filters.revealTrans.Transition=Math.floor(Math.random()*23);
      bannerADrotator.filters.revealTrans.apply();
   }
}

function playTransition(){
   if (document.all)
      bannerADrotator.filters.revealTrans.play()
}

function nextAd(){
   if(adNum<bannerAD.length-1)adNum++ ;
      else adNum=0;
   setTransition();
   document.images.bannerADrotator.src=bannerAD[adNum];
   playTransition();
  title.innerHTML="A target=_blank href=" +bannerADlink[adNum] + ">" + bannerADtitle[adNum] +"/a>";
  theTimer=setTimeout("nextAd()", 5000);

}

function jump2url(){
   jumpUrl=bannerADlink[adNum];
   jumpTarget=\'_blank\';
   if (jumpUrl != \'\'){
      if (jumpTarget != \'\')window.open(jumpUrl,jumpTarget);
      else location.href=jumpUrl;
   }
}
function displayStatusMsg() {
   status=bannerADlink[adNum];
   document.returnValue = true;
}
</SCRIPT>
<%
response.Write "<TABLE cellSpacing=\'0\' cellPadding=\'0\' width=\'" & ImgWidth +20 & "\' border=\'0\'><TR height=\'10\'><TD width=\'10\' background=\'images/bg_0ltop.gif\'></TD><TD width=\'" & ImgWidth & "\' background=\'images/bg_01.gif\'></TD><TD width=\'10\' background=\'images/bg_0rtop.gif\'></TD></TR><TR height=\'" & ImgHeight & "\'><TD width=\'10\' background=\'images/bg_03.gif\'></TD><TD width=\'" & ImgWidth & "\' valign=\'top\'>" & vbcrlf
response.Write AD_title
response.Write "</TD><TD width=\'10\' background=\'images/bg_04.gif\'></TD></TR><TR height=\'10\'><TD width=\'10\' background=\'images/bg_0lbottom.gif\'></TD><TD width=\'" & ImgWidth & "\' background=\'images/bg_02.gif\'></TD><TD width=\'10\' background=\'images/bg_0rbottom.gif\'></TD></TR>" & vbcrlf
response.Write "<TR><TD id=\'title\' colspan=\'3\' align=\'center\'>"
response.Write "</TD></TR></TABLE>"
response.Write "<SCRIPT language=JavaScript>title.innerHTML=""<A target=_blank href="" +bannerADlink[0] + "">"" + bannerADtitle[0] +""</a>"";setTimeout(""nextAd()"", 3000);//nextAd()</SCRIPT>" & vbcrlf
end if
rsPic.close
end sub

sub GetPicArticleTitle1(intTitleLen,intImgWidth,intImgHeight,i)
dim FileType,TitleStr
FileType=right(lcase(rsPic("DefaultPicUrl")),3)
TitleStr=gotTopic(rsPic("Title"),intTitleLen)
strPic=strPic & "bannerADlink[" & cStr(i) & "]=""" & rsPic("LayoutFileName") & "?ArticleID=" & rsPic("ArticleID") & """;" & vbcrlf
if fileType="jpg" or fileType="bmp" or fileType="png" or fileType="gif" then
  strPic=strPic & "bannerAD[" & cStr(i) & "]=""" & rsPic("DefaultPicUrl") & """;" & vbcrlf
else
  strPic=strPic & "bannerAD[" & cStr(i) & "]=""images/NoPic2.jpg"";" & vbcrlf
end if
strPic=strPic & "bannerADtitle[" & cStr(i) & "]=""" & TitleStr & """;" & vbcrlf
end sub