网络编程
位置:首页>> 网络编程>> Asp编程>> asp如何获知页面上的图象的实际尺寸?

asp如何获知页面上的图象的实际尺寸?

 来源:asp之家 发布时间:2009-11-24 20:50:00 

标签:图片,尺寸,asp

asp如何获知页面上的图象的实际尺寸大小?

见下面的两个asp文件:

<!--#include virtual="/intels/chunfeng/graphicdetect.asp"-->
<html>
<head>
<TITLE>asp之家asp教程之获知图像尺寸</TITLE>
</head>
<body bgcolor="#FFFFFF">
<%
  graphic="images/intels.gif"
  HW = ReadImg(graphic)
  Response.Write graphic & " Dimensions: " & HW(0) & "x" & HW(1) 
& "<br>"
  response.write "<img src=""/" & graphic & """" 
  response.write height=""" & HW(0) & """
  response.write width=""" & HW(0) & "">"
%>
</body>
</html>

graphicdetect.asp

<%
Dim HW
Function AscAt(s, n)
      AscAt = Asc(Mid(s, n, 1))
End Function
Function HexAt(s, n)
      HexAt = Hex(AscAt(s, n))
End Function
Function isJPG(fichero)
      If inStr(uCase(fichero), ".JPG") <> 0 Then
      isJPG = true
      Else
      isJPG = false
      End If
End Function
Function isPNG(fichero)
      If inStr(uCase(fichero), ".PNG") <> 0 Then
      isPNG = true
      Else
      isPNG = false
      End If
End Function
Function isGIF(fichero)
      If inStr(uCase(fichero), ".GIF") <> 0 Then
      isGIF = true
      Else
      isGIF = false
      End If
End Function
Function isBMP(fichero)
      If inStr(uCase(fichero), ".BMP") <> 0 Then
      isBMP = true
      Else
      isBMP = false
      End If
End Function
Function isWMF(fichero)
      If inStr(uCase(fichero), ".WMF") <> 0 Then
      isWMF = true
      Else
      isWMF = false
      End If
End Function
Function isWebImg(f)
      If isGIF(f) Or isJPG(f) Or isPNG(f) Or isBMP(f) Or isWMF(f) 
Then
      isWebImg = true
      Else
      isWebImg = true
      End If
End Function
Function ReadImg(fichero)
      If isGIF(fichero) Then
      ReadImg = ReadGIF(fichero)
      Else
      If isJPG(fichero) Then
      ReadImg = ReadJPG(fichero)
      Else
      If isPNG(fichero) Then
      ReadImg = ReadPNG(fichero)
      Else
      If isBMP(fichero) Then
      ReadImg = ReadPNG(fichero)
      Else
      If isWMF(fichero) Then
      ReadImg = ReadWMF(fichero)
      Else
      ReadImg = Array(0,0)
      End If
      End If
      End If
      End If
      End If
End Function
Function ReadJPG(fichero)
    Dim fso, ts, s, HW, nbytes
      HW = Array("","")
      Set fso = CreateObject("Scripting.FileSystemObject")
      Set ts = fso.OpenTextFile(Server.MapPath("/" & fichero), 1)
      s = Right(ts.Read(167), 4)
      HW(0) = HexToDec(HexAt(s,3) & HexAt(s,4))
      HW(1) = HexToDec(HexAt(s,1) & HexAt(s,2))
      ts.Close
    ReadJPG = HW
End Function
Function ReadPNG(fichero)
    Dim fso, ts, s, HW, nbytes
      HW = Array("","")
      Set fso = CreateObject("Scripting.FileSystemObject")
      Set ts = fso.OpenTextFile(Server.MapPath("/" & fichero), 1)
      s = Right(ts.Read(24), 8)
      HW(0) = HexToDec(HexAt(s,3) & HexAt(s,4))
      HW(1) = HexToDec(HexAt(s,7) & HexAt(s,8))
      ts.Close
    ReadPNG = HW
End Function
Function ReadGIF(fichero)
    Dim fso, ts, s, HW, nbytes
      HW = Array("","")
      Set fso = CreateObject("Scripting.FileSystemObject")
      Set ts = fso.OpenTextFile(Server.MapPath("/" & fichero), 1)
      s = Right(ts.Read(10), 4)
      HW(0) = HexToDec(HexAt(s,2) & HexAt(s,1))
      HW(1) = HexToDec(HexAt(s,4) & HexAt(s,3))
      ts.Close
    ReadGIF = HW
End Function

Function ReadWMF(fichero)
    Dim fso, ts, s, HW, nbytes
      HW = Array("","")
      Set fso = CreateObject("Scripting.FileSystemObject")
      Set ts = fso.OpenTextFile(Server.MapPath("/" & fichero), 1)
      s = Right(ts.Read(14), 4)
      HW(0) = HexToDec(HexAt(s,2) & HexAt(s,1))
      HW(1) = HexToDec(HexAt(s,4) & HexAt(s,3))
      ts.Close
    ReadWMF = HW
End Function
Function ReadBMP(fichero)
    Dim fso, ts, s, HW, nbytes
      HW = Array("","")
      Set fso = CreateObject("Scripting.FileSystemObject")
      Set ts = fso.OpenTextFile(Server.MapPath("/" & fichero), 1)
      s = Right(ts.Read(24), 8)
      HW(0) = HexToDec(HexAt(s,4) & HexAt(s,3))
      HW(1) = HexToDec(HexAt(s,8) & HexAt(s,7))
      ts.Close
    ReadBMP = HW
End Function
Function isDigit(c)
      If inStr("0123456789", c) <> 0 Then
      isDigit = true
      Else
      isDigit = false
      End If
End Function
Function isHex(c)
      If inStr("0123456789ABCDEFabcdef", c) <> 0 Then
      isHex = true
      Else
      ishex = false
      End If
End Function
Function HexToDec(cadhex)
      Dim n, i, ch, decimal
      decimal = 0
      n = Len(cadhex)
      For i=1 To n
      ch = Mid(cadhex, i, 1)
      If isHex(ch) Then
      decimal = decimal * 16
      If isDigit(c) Then
      decimal = decimal + ch
      Else
      decimal = decimal + Asc(uCase(ch)) - Asc("A")
      End If
      Else
      HexToDec = -1
      End If
      Next
      HexToDec = decimal
End Function
%>

0
投稿

猜你喜欢

手机版 网络编程 asp之家 www.aspxhome.com