分页的解析处理（ASP）

<%@ Language = VBScript %>
<% Option Explicit %>
<script language="javascript">
function fPageClick(pageno){
var url = ''
url = 'page.asp' +
  '?crtpage=' + pageno
  document.location.replace(url);
}
</script>
<%
Const GSTR_DIS_FVLH_TTL_BACK  = "<<前へ"
Const GSTR_DIS_FVLH_TTL_FWRD  = "次へ>>"
'==========================================================
'機能 : 表示用ページ番号解析処理
'引数 : なし
'      total  IN 全ページ数
'      current  IN カレントのページ
'      dispnum  IN 中央表示ページ数 ※ 奇数
'      amari  IN 余りページ表示数指定数に大体近い数が採用される
'      aryPagesL OUT 左ページ番号の配列
'      aryPagesM OUT 中央ページ番号の配列
'      aryPagesR OUT 右ページ番号の配列
'      jmpL  OUT 左ジャンプ数
'      jmpR  OUT 右ジャンプ数
'返却値 : なし
'==========================================================
Function fblnGetArrayOfManyPages(ByVal total, ByVal current, ByVal dispnum, ByVal amari, ByRef aryPagesL, ByRef aryPagesM, ByRef aryPagesR, ByRef jmpL, ByRef jmpR)

Dim currentL, currentR 'カレント5件の左右のページ番号
Dim lenL, lenR   'カレント左右の残り件数
Dim sepL, sepR   '左右のジャンプ間隔
Dim viewL, viewR  '左右の実表示個数

fblnGetArrayOfManyPages = False

If current > total Or current < 1 Then Exit Function
If total <= 0      Then Exit Function
If dispnum <= 0      Then Exit Function
If dispnum / 2 = Int(dispnum / 2) Then Exit Function
If amari <= 0      Then Exit Function

currentL = current - Int(dispnum / 2)
If currentL <= 2 Then
  currentL = 1
  currentR = dispnum
Else
  currentR = current + Int(dispnum / 2)
  If currentR >= total - 3 Then
   currentL = total - dispnum
   currentR = total
  End If
End If

If total <= dispnum Then
currentL = 1
currentR = total
End If

lenL = currentL - 1
lenR = total - currentR

If lenL <= 0 Then
viewL = 1
Else
viewL = Round(amari * lenL / (lenL +lenR), 0)
End If

If lenR <= 0 Then
viewR = total
Else
viewR = Round(amari * lenR / (lenL +lenR), 0)
End If

sepL = 0
sepR = 0

If viewL > 0 Then
sepL = Round(LenL / viewL, 0)
If sepL < 1 Then sepL = 1
End If

If viewR > 0 Then
sepR = Round(LenR / viewR, 0)
If sepR < 1 Then sepR = 1
End If

'ページ配列の生成

Dim intPagesL, intPagesM, intPagesR
Dim i

intPagesL = 0
If sepL > 0 Then
  For i = 1 To currentL Step sepL
   If i >= currentL Then Exit For
   If Not IsArray(aryPagesL) Then aryPagesL = Array(-1)
   ReDim Preserve aryPagesL(intPagesL)
   aryPagesL(intPagesL) = i
   intPagesL = intPagesL + 1
  Next
Else
  If currentL > 1 Then
   If Not IsArray(aryPagesL) Then aryPagesL = Array(-1)
   ReDim Preserve aryPagesL(intPagesL)
   aryPagesL(intPagesL) = 1
  End If
End If

intPagesM = 0
For i = currentL To currentR
  If Not IsArray(aryPagesM) Then aryPagesM = Array(-1)
  ReDim Preserve aryPagesM(intPagesM)
  aryPagesM(intPagesM) = i
  intPagesM = intPagesM + 1
Next

If total > currentR Then
  intPagesR = 0
  If sepR > 0 Then
   For i = currentR + sepR To total Step sepR
    If i >= total Then
'     If intPagesR > 0 Then
'      intPagesR = intPagesR - 1
'     End If
     Exit For
    End If
    If Not IsArray(aryPagesR) Then aryPagesR = Array(-1)
    ReDim Preserve aryPagesR(intPagesR)
    aryPagesR(intPagesR) = i
    intPagesR = intPagesR + 1
   Next
  End If
  If Not IsArray(aryPagesR) Then aryPagesR = Array(-1)
  ReDim Preserve aryPagesR(intPagesR)
  aryPagesR(intPagesR) = total
End If

jmpL = sepL
jmpR = sepR

fblnGetArrayOfManyPages = True
End Function

Function fGetPageHTML(strHTML,totalPage,currentPage,dispnum,amari)

Dim aryPagesL, aryPagesM, aryPagesR, jmpL, jmpR, i, intTempPage

   'If fblnGetArrayOfManyPages(lngPageNumber, lngCurentPage, 5, 6, aryPagesL, aryPagesM, aryPagesR, jmpL, jmpR) Then
   If fblnGetArrayOfManyPages(totalPage, currentPage, dispnum, amari, aryPagesL, aryPagesM, aryPagesR, jmpL, jmpR) Then
    Dim strDisp, strDelmiL, strDelmiR

    If currentPage = 1 Then
     strHTML = strHTML & GSTR_DIS_FVLH_TTL_BACK & " "
    Else
     strHTML = strHTML & "<a href=javascript:fPageClick(" & currentPage-1 & ")>" & GSTR_DIS_FVLH_TTL_BACK & "</a> "
    End If

    '## 実ページ番号の表示部分
    strDelmiL = "…"
    strDelmiR = "…"

    If jmpL <= 1 Then
     strDelmiL = " "
    End If
    If jmpR <= 1 Then
     strDelmiR = " "
    End If

    If IsArray(aryPagesL) Then
     intTempPage = CInt(-100)
     For i = 0 To UBound(aryPagesL)
      If (intTempPage + 1) < CInt(aryPagesL(i)) Then
       strHTML = strHTML & "<a href=javascript:fPageClick(" & CStr(aryPagesL(i)) & ")>" & CStr(aryPagesL(i)) & "</a>" & strDelmiL
       intTempPage = CInt(aryPagesL(i))
      End If
     Next
    End If

    If IsArray(aryPagesM) Then
     For i = 0 To UBound(aryPagesM)
      If Int(aryPagesM(i)) = Int(currentPage) Then
       strHTML = strHTML & "<b>[" & CStr(aryPagesM(i)) & "]</b>"
      Else
       strHTML = strHTML & "<a href=javascript:fPageClick(" & CStr(aryPagesM(i)) & ")>" & CStr(aryPagesM(i)) & "</a>"
      End If
      If i <> UBound(aryPagesM) Then
       strHTML = strHTML & " "
      End If
     Next
    End If

    If IsArray(aryPagesR) Then
     Dim strHTMLWork : strHTMLWork = ""
     intTempPage = CInt(aryPagesR(UBound(aryPagesR))) + 100
     For i = UBound(aryPagesR) To 0 Step -1
      If (intTempPage - 1) > CInt(aryPagesR(i)) Then
       strHTMLWork = strDelmiR & "<a href=javascript:fPageClick(" & CStr(aryPagesR(i)) & ")>" & CStr(aryPagesR(i)) & "</a>" & strHTMLWork
       intTempPage = CInt(aryPagesR(i))
      End If
     Next
     strHTML = strHTML & strHTMLWork
    End If

    '## 「次へ>>」の表示部分
    If Int(currentPage) = Int(currentPage) Then
     strHTML = strHTML & " " & GSTR_DIS_FVLH_TTL_FWRD & "</td>"
    Else
     strHTML = strHTML & " <a href=javascript:fPageClick(" & currentPage+1 & ")>" & GSTR_DIS_FVLH_TTL_FWRD & "</a></td>"
    End If
   Else
    strHTML = strHTML & ""
   End If
End Function

Dim lngCurentPage
Dim strHTML
Dim blnRet

If Request.QueryString("crtpage")<>"" Then
lngCurentPage = CLng(Request.QueryString("crtpage"))
Else
lngCurentPage = 1
End If
blnRet = fGetPageHTML(strHTML,1000,lngCurentPage,5,6)
response.write(strHTML)
%>

分页的解析处理（ASP）

导航

公告