WaBis

walter.bislins.ch

Datei: imgscale.inc

Klon-Datei nicht gefunden! Dies ist die letzte Version.
Inhalt der Datei: ./asp/imgscale/imgscale/imgscale.inc
<%
'-------------------------------------------------------------------------------
' Read image width and height from most image files.
'
' Supported files: jpg, jpeg, gif, bmp, wmf, png
'
' Source:
'   http://www.asphelper.de/tip/tip83_hoehe_und_breite_von_einem_bild_ermitteln.asp
'
' Encapsulated into a class by Walter Bislin:
'   http://walter.bislins.ch/doku/imgscale
'
' Exports:
'   sub GetImageScale( aPath, ByRef aWidth, ByRef aHeight )
'

sub GetImageScale( aPath, ByRef aWidth, ByRef aHeight )
  dim imgDim
  set imgDim = new CImageScale
  imgDim.ReadDimension aPath
  aWidth = imgDim.Width
  aHeight = imgDim.Height
end sub

class CImageScale
  public Width
  public Height

  sub ReadDimension( ByVal aPath )
    dim imageType, fso, file, s, ns, n
    imageType = lcase(Right(aPath, Len(aPath) - InStrRev(aPath, ".", -1)))
    set fso = CreateObject("Scripting.FileSystemObject")
    set file = fso.OpenTextFile(aPath,1)
    Width  = 0
    Height = 0

    select case imageType
      case "jpg", "jpeg"
        file.Skip(2)
        ns = file.Read(2)
        do while not (ns = "ÿÀ" or ns = "ÿÂ")
          ns = file.Read(2)
          n = HexToDec(HexAt(ns,1) & HexAt(ns,2))
          n = n - 2
          file.Skip(n)
          ns = file.Read(2)
        loop
        file.Skip(3)
        s = file.Read(4)
        Width  = HexToDec(HexAt(s,3) & HexAt(s,4))
        Height = HexToDec(HexAt(s,1) & HexAt(s,2))
      case "gif"
        s = Right(file.Read(10),4)
        Width  = HexToDec(HexAt(s,2) & HexAt(s,1))
        Height = HexToDec(HexAt(s,4) & HexAt(s,3))
      case "bmp"
        s = Right(file.Read(24), 8)
        Width  = HexToDec(HexAt(s,4) & HexAt(s,3))
        Height = HexToDec(HexAt(s,8) & HexAt(s,7))
      case "wmf"
        s = Right(file.Read(14), 4)
        Width  = HexToDec(HexAt(s,1) & HexAt(s,1))
        Height = HexToDec(HexAt(s,4) & HexAt(s,3))
      case "png"
        s = Right(file.Read(24), 8)
        Width  = HexToDec(HexAt(s,3) & HexAt(s,4))
        Height = HexToDec(HexAt(s,7) & HexAt(s,8))
    end select
    file.Close
    set file = Nothing
  end sub

  private function HexAt(s, n)
    HexAt = Hex(Asc(Mid(s, n, 1)))
    if Len(HexAt) = 1 then
      HexAt = "0" & HexAt
    end if
  end function

  private function HexToDec(cadhex)
    Dim n, i, ch, decimal
    decimal = 0
    n = Len(cadhex)
    For i=1 To n
      decimal = decimal * 16
      ch = Mid(cadhex, i, 1)
      decimal = decimal + inStr("0123456789ABCDEFabcdef", ch) -1
    Next
    HexToDec = decimal
  end function

end class

%>

More Page Infos / Sitemap
Created Montag, 25. Juli 2011
Scroll to Top of Page
Changed Montag, 25. Juli 2011