风讯官方论坛

首页 » 产品服务区 » Bug反馈区 » 轮换幻灯标签超强修改(解决一页多个幻灯冲突问题)
newstar - 2008-3-11 12:04:00
解决了一个页面 调用两个轮换幻灯冲突的问题!

修改一:\Admin\Label\News_C_Label.asp

<%sub NorFilt()%><!--edit by newstar QQ:228770305-->
<table width="98%" border="0" align="center" cellpadding="5" cellspacing="1" class="table">
  <tr>
  <td class="hback">
    <div align="right">幻灯序号</div>
  </td>
  <td class="hback">
    <input  name="Num" type="text" id="Num" size="12">
    大于一个时,必须填上序号。 </td>
  </tr>
  <tr>
  <td width="22%" class="hback">
    <div align="right">选择栏目</div>
  </td>
  <td width="78%" class="hback">
    <input  name="ClassName" type="text" id="ClassName4" size="12" readonly>
    <input name="ClassID" type="hidden" id="ClassID4">
    <input name="button22" type="button"  value="选择栏目">
    <span class="tx"></span>
    <span class="tx"></span>
    <select name="containSubClass" id="containSubClass">
    <option value="0" selected="selected">否</option>
    <option value="1">是</option>
    </select>
    包含子类
    </td>
  </tr>
  <tr>
  <td class="hback">
    <div align="right">显示标题</div>
  </td>
  <td class="hback">
    <select name="ShowTitle" id="ShowTitle">
    <option value="1" selected>显示</option>
    <option value="0">不显示</option>
    </select>
  </td>
  </tr>
  <tr>
  <td class="hback">
    <div align="right">调用数量</div>
  </td>
  <td class="hback">
    <input  name="NewsNumber" type="text" id="NewsNumber" value="5" size="12" >
  </td>
  </tr>
  <tr>
  <td class="hback">
    <div align="right">标题字数</div>
  </td>
  <td class="hback">
    <input  name="TitleNumber" type="text" id="TitleNumber" value="30" size="12" >
  </td>
  </tr>
  <tr>
  <td class="hback">
    <div align="right">图片尺寸(高度,宽度)</div>
  </td>
  <td class="hback">
    <input  name="p_size" type="text" id="p_size" value="120,100" size="12">
    格式120,100。请正确使用格式</td>
  </tr>
  <tr>
  <td class="hback">
    <div align="right">文本高度</div>
  </td>
  <td class="hback">
    <input  name="TextSize" type="text" id="Picsize" value="20" size="12">
  </td>
  </tr>
 
  <tr>
  <td class="hback">
    <div align="right">标题CSS</div>
  </td>
  <td class="hback">
    <input  name="CSS" type="text" id="CSS" size="12">
  </td>
  </tr>
  <tr>
    <td class="hback"><div align="right">窗口打开方式</div></td>
    <td class="hback"><div align="left">
      <select name="OpenType" id="OpenType">
        <option value="0">原窗口</option>
        <option value="1">新窗口</option>
        </select>
      </div></td>
  </tr>
  <tr>
  <td class="hback">
    <div align="right"></div>
  </td>
  <td class="hback">
    <input name="button2" type="button"  value="确定创建此标签">
    <input name="button2" type="button"  value=" 取 消 ">
  </td>
  </tr>
</table>
<script language="JavaScript" type="text/JavaScript">
function ok(obj)
{
  var retV = '{FS:NS=NorFilt┆';
  retV+='栏目$' + obj.ClassID.value + '┆';
  retV+='数量$' + obj.NewsNumber.value + '┆';
  retV+='标题字数$' + obj.TitleNumber.value + '┆';
  retV+='图片尺寸$' + obj.p_size.value +  '┆';
  retV+='CSS样式$' + obj.CSS.value +  '┆';
  retV+='文本高度$' + obj.TextSize.value +  '┆';
  retV+='显示标题$' + obj.ShowTitle.value +  '┆';
  retV+='包含子类$' + obj.containSubClass.value +  '┆';
  retV+='窗口打开方式$' + obj.OpenType.value +  '';
  //edit by newstar QQ:228770305
  retV+='┆';
  retV+='幻灯序号$' + obj.Num.value +  ''; 
  retV+='}';
  window.parent.returnValue = retV;
  window.close();
}
</script>
<%end sub%>
newstar - 2008-3-11 12:06:00
修改二:\FS_InterFace\NS_Public.asp
case "norfilt"
      if ubound(f_array)<>9 and ubound(f_array)<>10 then:get_LableChar="标签错误,by Foosun.cn":else:get_LableChar=NorFilter(f_Lablechar,"NorFilt",f_Id):end if

修改三:同上页

'轮换幻灯______edit by newstar QQ:228770305
  Public Function NorFilter(f_Lablechar,f_type,f_id)
  dim FilterSql,RsFilterObj,FilterStr,ImagesStr,TxtStr,TxtFirst,ClassSaveFilePath,LinkStr,CssFileStr
  Dim PicWidthStr, PicHeightStr,ChildClassTF,AllClassIDStr,Str_target
  dim fltheightstr,fltwidthstr,Temp_Num,TitleNumberStr,NewsNumberStr,ClassId,InSQL_Search,str_filt,str_Opentype
  dim str_Num 'edit by newstar QQ:228770305
  TitleNumberStr= split(split(f_Lablechar,"┆")(3),"$")(1)
  NewsNumberStr= split(split(f_Lablechar,"┆")(2),"$")(1)
  ChildClassTF = split(split(f_Lablechar,"┆")(8),"$")(1)
  str_Opentype = split(split(f_Lablechar,"┆")(9),"$")(1)
  str_Num = split(split(f_Lablechar,"┆")(10),"$")(1)
  if trim(NewsNumberStr)<>"" and  isNumeric(NewsNumberStr) then
    NewsNumberStr = cint(NewsNumberStr)
  else
    NewsNumberStr = 6
  end if
  If ChildClassTF = "" Or Not IsNumeric(ChildClassTF) Then
    ChildClassTF = 0
  Else
    ChildClassTF = Cint(ChildClassTF)
  End If 
  ClassId=split(split(f_Lablechar,"┆")(1),"$")(1)
  if trim(ClassId)<>"" then
    If ChildClassTF = 1 Then
    AllClassIDStr = get_SubClass(ClassId)
    InSQL_Search = " and ClassId in('" & AllClassIDStr & "')"
    Else
    InSQL_Search = " and ClassId='"& ClassId &"'"
    End if 
  else
    if f_Id <> "" then
    InSQL_Search = " and ClassId='"& f_Id &"'"
    else
    InSQL_Search = ""
    end if
  end if
  str_filt=" and "& all_substring &"(NewsProperty,21,1)='1'"
  FilterSql="select top "& NewsNumberStr &" ID,NewsId,PopId,ClassID,SpecialEName,NewsTitle,CurtTitle,NewsNaviContent,isShowReview,TitleColor,titleBorder,TitleItalic,IsURL,URLAddress"
  FilterSql = FilterSql &",Content,isPicNews,NewsPicFile,NewsSmallPicFile,isPop,Source,Editor,Keywords,Author,Hits,SaveNewsPath,FileName,FileExtName,NewsProperty,isLock,addtime,TodayNewsPic "
  FilterSql = FilterSql &"From FS_NS_News where 1=1 and isPicNews=1 "&InSQL_Search & str_filt &" and  isRecyle=0 and isdraft=0 order by addtime desc,id desc"
  Set RsFilterObj = Conn.Execute(FilterSql)
  'response.Write(FilterSql)
  'response.end
  if not RsFilterObj.Eof then
    Temp_Num = 0
    Do While Not RsFilterObj.Eof
    Temp_Num = Temp_Num + 1
    RsFilterObj.MoveNext
    Loop
    RsFilterObj.MoveFirst
    If Temp_Num <=1 then
    Set RsFilterObj = Nothing
    FilterStr = "至少需要两条幻灯新闻才能正确显示幻灯效果"
    Set RsFilterObj = Nothing
    Exit Function
    End If
    fltheightstr = split(split(split(f_Lablechar,"┆")(4),"$")(1),",")(0)
    fltwidthstr = split(split(split(f_Lablechar,"┆")(4),"$")(1),",")(1)
    CssFileStr = split(split(f_Lablechar,"┆")(5),"$")(1)
    PicWidthStr = " width=""" & fltwidthstr & """"
    PicHeightStr = " height=""" & fltheightstr & """"
    if CssFileStr <> "" then CssFileStr = " Class='" & CssFileStr & "'"
    do while Not RsFilterObj.Eof
    if (Not IsNull(RsFilterObj("NewsSmallPicFile"))) And (RsFilterObj("NewsSmallPicFile") <> "") then
      if ImagesStr = "" then
      If Instr(1,LCase(RsFilterObj("NewsSmallPicFile")),"http://") <> 0 then
        ImagesStr =  RsFilterObj("NewsSmallPicFile")
      Else
        ImagesStr =  RsFilterObj("NewsSmallPicFile")
      End If
      If str_Opentype="1" Then
        TxtStr = "<a " & CssFileStr & " href='" & get_NewsLink(RsFilterObj("NewsID")) & "' target='_blank'>" & GotTopic(RsFilterObj("NewsTitle"),TitleNumberStr)&"</a>"
        TxtFirst = "<a " & CssFileStr & " href='" & get_NewsLink(RsFilterObj("NewsID")) & "' target='_blank'>" & GotTopic(RsFilterObj("NewsTitle"),TitleNumberStr)&"</a>"
      Else
        TxtStr = "<a " & CssFileStr & " href='" & get_NewsLink(RsFilterObj("NewsID")) & "'>" & GotTopic(RsFilterObj("NewsTitle"),TitleNumberStr)&"</a>"
        TxtFirst = "<a " & CssFileStr & " href='" & get_NewsLink(RsFilterObj("NewsID")) & "'>" & GotTopic(RsFilterObj("NewsTitle"),TitleNumberStr)&"</a>"       
      End If
      LinkStr =  get_NewsLink(RsFilterObj("NewsID"))
      else
      ImagesStr = ImagesStr &","&  RsFilterObj("NewsSmallPicFile")
      If str_Opentype="1" Then
        TxtStr = TxtStr &",<a " & CssFileStr & " href='" & get_NewsLink(RsFilterObj("NewsID")) & "'  target='_blank'>" & GotTopic(RsFilterObj("NewsTitle"),TitleNumberStr)&"</a>"
      Else
        TxtStr = TxtStr &",<a " & CssFileStr & " href='" & get_NewsLink(RsFilterObj("NewsID")) & "'>" & GotTopic(RsFilterObj("NewsTitle"),TitleNumberStr)&"</a>"       
      End If
      LinkStr = LinkStr & ","& get_NewsLink(RsFilterObj("NewsID"))
      end if
    end if
    RsFilterObj.MoveNext
    loop
    FilterStr="<script language=""vbscript"">"& Chr(13)
    FilterStr = FilterStr & "Dim FileList"&str_Num&",FileListArr"&str_Num&",TxtList"&str_Num&",TxtListArr"&str_Num&",LinkList"&str_Num&",LinkArr"&str_Num&""& Chr(13)
    FilterStr = FilterStr & "FileList"&str_Num&" = """ & ImagesStr & """"& Chr(13)
    FilterStr = FilterStr & "LinkList"&str_Num&" = """ & LinkStr & """"& Chr(13)
    FilterStr = FilterStr & "TxtList"&str_Num&" = """ & TxtStr & """"& Chr(13)
    FilterStr = FilterStr & "FileListArr"&str_Num&" = Split(FileList"&str_Num&","","")"& Chr(13)
    FilterStr = FilterStr & "LinkArr"&str_Num&" = Split(LinkList"&str_Num&","","")"& Chr(13)
    FilterStr = FilterStr & "TxtListArr"&str_Num&" = Split(TxtList"&str_Num&","","")"& Chr(13)
    FilterStr = FilterStr & "Dim CanPlay"&str_Num&""& Chr(13)
    FilterStr = FilterStr & "CanPlay"&str_Num&" = CInt(Split(Split(navigator.appVersion,"";"")(1),"" "")(2))>5"& Chr(13)
    FilterStr = FilterStr & "Dim FilterStr"&str_Num&""& Chr(13)
    FilterStr = FilterStr & "FilterStr"&str_Num&" = ""RevealTrans(duration=2,transition=23)"""& Chr(13)
    FilterStr = FilterStr & "FilterStr"&str_Num&" = FilterStr"&str_Num&" + "";BlendTrans(duration=2)"""& Chr(13)
    FilterStr = FilterStr & "If CanPlay"&str_Num&" Then"& Chr(13)
    FilterStr = FilterStr & "FilterStr"&str_Num&" = FilterStr"&str_Num&" + "";progid:DXImageTransform.Microsoft.Fade(duration=2,overlap=0)"""& Chr(13)
    FilterStr = FilterStr & "FilterStr"&str_Num&" = FilterStr"&str_Num&" + "";progid:DXImageTransform.Microsoft.Wipe(duration=3,gradientsize=0.25,motion=reverse)"""& Chr(13)
    FilterStr = FilterStr & "Else"& Chr(13)
    FilterStr = FilterStr & "Msgbox ""幻灯片播放具有多种动态图片切换效果,但此功能需要您的浏览器为IE5.5或以上版本,否则您将只能看到部分的切换效果。"",64"& Chr(13)
    FilterStr = FilterStr & "End If"& Chr(13)
    FilterStr = FilterStr & "Dim FilterArr"&str_Num&""& Chr(13)
    FilterStr = FilterStr & "FilterArr"&str_Num&" = Split(FilterStr"&str_Num&","";"")"& Chr(13)
    FilterStr = FilterStr & "Dim PlayImg_M"&str_Num&""& Chr(13)
    FilterStr = FilterStr & "PlayImg_M"&str_Num&" = 5 * 1000  "& Chr(13)
    FilterStr = FilterStr & "Dim I"&str_Num&""& Chr(13)
    FilterStr = FilterStr & "I"&str_Num&" = 1"& Chr(13)
    FilterStr = FilterStr & "Sub ChangeImg"&str_Num&""& Chr(13)
    FilterStr = FilterStr & "Do While FileListArr"&str_Num&"(I"&str_Num&")="""""& Chr(13)
    FilterStr = FilterStr & "I"&str_Num&" = I"&str_Num&" + 1"& Chr(13)
    FilterStr = FilterStr & "If I"&str_Num&">UBound(FileListArr"&str_Num&") Then I"&str_Num&" = 0"& Chr(13)
    FilterStr = FilterStr & "Loop"& Chr(13)
    FilterStr = FilterStr & "Dim J"&str_Num&""& Chr(13)
    FilterStr = FilterStr & "If I"&str_Num&">UBound(FileListArr"&str_Num&") Then I"&str_Num&" = 0"& Chr(13)
    FilterStr = FilterStr & "Randomize"& Chr(13)
    FilterStr = FilterStr & "J"&str_Num&" = Int(Rnd * (UBound(FilterArr"&str_Num&")+1))"& Chr(13)
    FilterStr = FilterStr & "Img"&str_Num&".style.filter = FilterArr"&str_Num&"(J"&str_Num&")"& Chr(13)
    FilterStr = FilterStr & "Img"&str_Num&".filters(0).Apply"& Chr(13)
    FilterStr = FilterStr & "Img"&str_Num&".Src = FileListArr"&str_Num&"(I"&str_Num&")"& Chr(13)
    FilterStr = FilterStr & "Img"&str_Num&".filters(0).play"& Chr(13)
    FilterStr = FilterStr & "Link"&str_Num&".Href = LinkArr"&str_Num&"(I"&str_Num&")"& Chr(13)
    If split(split(f_Lablechar,"┆")(7),"$")(1) = "1" Then
    FilterStr = FilterStr & "Txt"&str_Num&".filters(0).Apply"& Chr(13)
    FilterStr = FilterStr & "Txt"&str_Num&".innerHTML = TxtListArr"&str_Num&"(I"&str_Num&")"& Chr(13)
    FilterStr = FilterStr & "Txt"&str_Num&".filters(0).play"& Chr(13)
    End If
    FilterStr = FilterStr & "I"&str_Num&" = I"&str_Num&" + 1"& Chr(13)
    FilterStr = FilterStr & "If I"&str_Num&">UBound(FileListArr"&str_Num&") Then I"&str_Num&" = 0"& Chr(13)
    FilterStr = FilterStr & "TempImg"&str_Num&".Src = FileListArr"&str_Num&"(I"&str_Num&")"& Chr(13)
    FilterStr = FilterStr & "TempLink"&str_Num&".Href = LinkArr"&str_Num&"(I"&str_Num&")"& Chr(13)
    FilterStr = FilterStr & "SetTimeout ""ChangeImg"&str_Num&""", PlayImg_M"&str_Num&",""VBScript"""& Chr(13)
    FilterStr = FilterStr & "End Sub"& Chr(13)
    FilterStr = FilterStr & "</SCRIPT>"& Chr(13)
    FilterStr = FilterStr & "<TABLE WIDTH=""100%"" height=""100%"" BORDER=""0"" CELLSPACING="""" CELLPADDING=""0"">" &vbcrlf
    FilterStr = FilterStr & "<TR ID=""NoScript"&str_Num&""">"&vbcrlf
    FilterStr = FilterStr & "<TD Align=""Center"" Style=""Color:White"">对不起,图片浏览功能需脚本支持,但您的浏览器已经设置了禁止脚本运行。请您在浏览器设置中调整有关安全选项。</TD>"&vbcrlf
    FilterStr = FilterStr & "</TR>"&vbcrlf
    If str_Opentype="1" Then
    Str_target = " target='_blank'"
    Else
    Str_target = ""
    End If
    FilterStr = FilterStr & "<TR Style=""Display:none"" ID=""CanRunScript"&str_Num&"""><TD HEIGHT=""100%"" Align=""Center"" vAlign=""Center""><a id=""Link"&str_Num&""""&Str_target&"><Img ID=""Img"&str_Num&""""  & PicWidthStr & PicHeightStr & " Border=""0"" ></a>"&vbcrlf
    FilterStr = FilterStr & "</TD></TR><TR Style=""Display:none""><TD><a id=TempLink"&str_Num&" ><Img ID=""TempImg"&str_Num&""" Border=""0""></a></TD></TR>"&vbcrlf
    If split(split(f_Lablechar,"┆")(7),"$")(1) = "1" Then
    FilterStr = FilterStr & "<TR><TD HEIGHT=""100%"" Align=""Center"" vAlign=""Top"">"&vbcrlf
    FilterStr = FilterStr & "<div ID=""Txt"&str_Num&""" style=""PADDING-LEFT: 5px; Z-INDEX: 1; FILTER: progid:DXImageTransform.Microsoft.Fade(duration=1,overlap=0); POSITION:"">"&TxtFirst&"</div>"
    FilterStr = FilterStr & "</TD></TR>"&vbcrlf
    End If
    FilterStr = FilterStr & "</TABLE>"& Chr(13)
    FilterStr = FilterStr & "<Script Language=""VBScript"">"& Chr(13)
    FilterStr = FilterStr & "NoScript"&str_Num&".Style.Display = ""none"""& Chr(13)
    FilterStr = FilterStr & "CanRunScript"&str_Num&".Style.Display = """""& Chr(13)
    FilterStr = FilterStr & "Img"&str_Num&".Src = FileListArr"&str_Num&"(0)"& Chr(13)
    FilterStr = FilterStr & "Link"&str_Num&".Href = LinkArr"&str_Num&"(0)"& Chr(13)
    FilterStr = FilterStr & "SetTimeout ""ChangeImg"&str_Num&""", PlayImg_M"&str_Num&",""VBScript"""& Chr(13)
    FilterStr = FilterStr & "</Script>"& Chr(13)
  else
    FilterStr="没有幻灯图片"
  End if
  RsFilterObj.Close
  Set RsFilterObj = Nothing
  NorFilter = FilterStr
  End Function

红色为大体标注!^&^
cyxjq - 2008-3-11 20:07:00
顶一下!------------所有版本都适用吗!
newstar:我的修改是在FS4.0sp5版本的基础上进行的,不同sp中 函数是否相同 没做比较。
  对于不同版本,只要参照修改,就不会有问题!
  因此标签修改后多了一个参数,所以轮换幻灯标签 要重新做一下,不然会出现如下错误:
Microsoft VBScript 运行时错误 (0x800A0009)
下标越界: '[number: 10]'
四季逗 - 2008-4-7 07:30:00
:default6: 不错``
james2308 - 2008-4-9 02:54:00
兄弟不用这么修改的,生成的时间使用一个随机的数字,就可以了,程序不需要修改这么多,标签也不需要修改的

newstar:>>有简单的法,当然更好! ^&^ 把你的方法说详细些!
huxianfangyuan - 2008-4-22 22:17:00
sp6会更正这个功能吗?
newstar - 2008-4-24 17:12:00


引用:
原帖由 huxianfangyuan 于 2008-4-22 22:17:00 发表
sp6会更正这个功能吗?


应该会!
cyxjq - 2008-4-29 17:15:00
:default7:
1
查看完整版本: 轮换幻灯标签超强修改(解决一页多个幻灯冲突问题)