webForumDet fria alternativet
Logga in / Bli medlem

Någon som kan få detta exempel att fungera

ASP

15 svar · 476 visningar · startad av Addeladde

AddeladdeMedlem sedan jan. 20013 406 inlägg
Frågan#1

http://www.learnasp.com/learn/graphicdetect.asp

AddeladdeMedlem sedan jan. 20013 406 inlägg
#2

Här kommer koden

<!--#include virtual="/learn/test/lib_graphicdetect.asp"-->
<html><head>
<TITLE>dbtable.asp</TITLE>
</head>
<body bgcolor="#FFFFFF">
<%
   graphic="images/learnaspiconmain.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>

The library that is included is:

<%
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
%>
solbulleMedlem sedan mars 20015 287 inlägg
#3

http://www.webforum.nu/showthread.php?s=&postid=457662#post457662

@nderss avatar@ndersMedlem sedan juni 200032 967 inlägg
#4

Vad är problemet?

AddeladdeMedlem sedan jan. 20013 406 inlägg
#5

Jag har försökt hela kvällen och natten nu med att få ihop ett script som listar bilder ur en katalog och sedan visar dem i en bestäm storlek enligt denna kod:

IF height > width THEN
   IF height > 100 THEN
     width = round(width * 100 / height)
	 height = 100
   END IF
ELSE
   IF width > 100 THEN
     height = round(height * 100 / width)
   END IF
END IF

Det svåra är att få ut bredden och höjden på bilden. När jag väl lyckades med det på det första kodexemplet här ovan så stämde det inte på alla bilder.

Sedan hittade jag ett annat kodexempel här på webforum: När jag väl fått den att fungera så kunde jag inte få in den i lopen för att lista filer. Här är kodexemplet och koden för att lista filer är:
http://www.webforum.nu/showthread.php?s=&threadid=52969&highlight=bilder+storlek

<%
function GetBytes(flnm, offset, bytes)
Dim objFSO
Dim objFTemp
Dim objTextStream
Dim lngSize

'on error resume next

Set objFSO = CreateObject("Scripting.FileSystemObject")

' First, we get the filesize
Set objFTemp = objFSO.GetFile(flnm)
lngSize = objFTemp.Size
set objFTemp = nothing

fsoForReading = 1
Set objTextStream = objFSO.OpenTextFile(flnm, fsoForReading)

IF offset > 0 then
strBuff = objTextStream.Read(offset - 1)
end IF

IF bytes = -1 then ' Get All!

GetBytes = objTextStream.Read(lngSize) 'ReadAll

else

GetBytes = objTextStream.Read(bytes)

end IF

objTextStream.Close
set objTextStream = nothing
set objFSO = nothing

end function

function lngConvert(strTemp)
lngConvert = clng(asc(left(strTemp, 1)) + ((asc(right(strTemp, 1)) * 256)))
end function

function lngConvert2(strTemp)
lngConvert2 = clng(asc(right(strTemp, 1)) + ((asc(left(strTemp, 1)) * 256)))
end function

function gfxSpex(flnm, width, height, depth, strImageType)

dim strPNG 
dim strGIF
dim strBMP
dim strType
strType = ""
strImageType = "(unknown)"

gfxSpex = False

strPNG = chr(137) & chr(80) & chr(78)
strGIF = "GIF"
strBMP = chr(66) & chr(77)

strType = GetBytes(flnm, 0, 3)

IF strType = strGIF then 

strImageType = "GIF"
Width = lngConvert(GetBytes(flnm, 7, 2))
Height = lngConvert(GetBytes(flnm, 9, 2))
Depth = 2 ^ ((asc(GetBytes(flnm, 11, 1)) and 7) + 1)
gfxSpex = True

else

strBuff = GetBytes(flnm, 0, -1) 
lngSize = len(strBuff)
flgFound = 0

strTarget = chr(255) & chr(216) & chr(255)
flgFound = instr(strBuff, strTarget)

IF flgFound = 0 then
exit function
end IF

strImageType = "GIF"
lngPos = flgFound + 2
ExitLoop = false

do while ExitLoop = False and lngPos < lngSize

do while asc(mid(strBuff, lngPos, 1)) = 255 and lngPos < lngSize
lngPos = lngPos + 1
loop

IF asc(mid(strBuff, lngPos, 1)) < 192 or asc(mid(strBuff, lngPos, 1)) > 195 then
lngMarkerSize = lngConvert2(mid(strBuff, lngPos + 1, 2))
lngPos = lngPos + lngMarkerSize + 1
else
ExitLoop = True
end IF

loop
'
IF ExitLoop = False then

Width = -1
Height = -1
Depth = -1

else

Height = lngConvert2(mid(strBuff, lngPos + 4, 2))
Width = lngConvert2(mid(strBuff, lngPos + 6, 2))
Depth = 2 ^ (asc(mid(strBuff, lngPos + 8, 1)) * 8)
gfxSpex = True

end IF

end IF

end function

'sub --------------------------------

function bildstorlek(flnm)

IF right(flnm, 3)="gIF" then
	Width = lngConvert(GetBytes(flnm, 7, 2))
	Height = lngConvert(GetBytes(flnm, 9, 2))
	Depth = 2 ^ ((asc(GetBytes(flnm, 11, 1)) and 7) + 1)

else

strBuff = GetBytes(flnm, 0, -1) 
lngSize = len(strBuff)
flgFound = 0

strTarget = chr(255) & chr(216) & chr(255)
flgFound = instr(strBuff, strTarget)

strImageType = "JPG"
lngPos = flgFound + 2
ExitLoop = false

do while ExitLoop = False and lngPos < lngSize

do while asc(mid(strBuff, lngPos, 1)) = 255 and lngPos < lngSize
lngPos = lngPos + 1
loop

IF asc(mid(strBuff, lngPos, 1)) < 192 or asc(mid(strBuff, lngPos, 1)) > 195 then
lngMarkerSize = lngConvert2(mid(strBuff, lngPos + 1, 2))
lngPos = lngPos + lngMarkerSize + 1
else
ExitLoop = True
end IF

loop

IF ExitLoop = "False" then
Width = -1
Height = -1
Depth = -1
else
Height = lngConvert2(mid(strBuff, lngPos + 4, 2))
Width = lngConvert2(mid(strBuff, lngPos + 6, 2))
Depth = 2 ^ (asc(mid(strBuff, lngPos + 8, 1)) * 8)
end IF

end if

normalHeight = height
normalWidth = width

IF height > width THEN
   IF height > 100 THEN
     width = round(width * 100 / height)
	 height = 100
   END IF
ELSE
   IF width > 100 THEN
     height = round(height * 100 / width)
   END IF
END IF
test = array(width,height,normalWidth,normalHeight)

end function
%>
solbulleMedlem sedan mars 20015 287 inlägg
#6

Om jag fattar dig rätt vill du kunna visa bilden med storleken max 100px om den är större än 100px, annars i orginalstorlek?
Känns som om det vore MYCKET enklare att lösa det med javascript, tex som på sidan du länkar till.
(Om du inte skriver ut en bredd så blir det ju även automatiskt rätt proportion på bilden.)

AddeladdeMedlem sedan jan. 20013 406 inlägg
#7

Tänk så här:

Om vi har en bild som är 340x780 då ska 780 minskas till 100.
Men 380 får inte heller vara större än 100. så det måste minskas till:
100/780 = 0.12
0.12*380 = 49

Bildstroleken ska alltså bli 49x100.
Jag vill ju inte att bilden får snedvridna propotioner

solbulleMedlem sedan mars 20015 287 inlägg
#8

Jo, men rätta mig om jag har fel,
om bilden är i orginal 340x780 och du sätter höjden till 100 och skriver såhär:

<img src="bild.gif" height="100" border="0" alt="">

Då visas ju bilden automatiskt med rätt proportioner: 49x100

Bara en tanke.

AddeladdeMedlem sedan jan. 20013 406 inlägg
#9

Om en bild är 780x380 alltså tvärt om då blir det fel?

solbulleMedlem sedan mars 20015 287 inlägg
#10

<img src="bild.gif" width="100" border="0" alt="">

Du gör som du vill, men kika i alla fall på att lösa det med javascript, tror att det är smidigare.

AddeladdeMedlem sedan jan. 20013 406 inlägg
#11

Nu har jag lyckats få till det! :-)
Jag använde ett kodexempel här från webbforum som tar reda på bildpropotionerna samt gjorde ett script som radar upp filerna snyggt i tre kolumner.

Problemet nu är att jag skulle vilja att 30 bilder visas per sida. Man ska alltså kunna bläddra mellan olikarecordset fast med fso. Hur gör man det!

Använd gärna min kod om ni vill!

<link href="admin/admin.css" rel="stylesheet" type="text/css"> <!--#include file="bildfunktioner.asp"-->
<%
Dim bild
'''
function GetBytes(flnm, offset, bytes)
Dim objFSO
Dim objFTemp
Dim objTextStream
Dim lngSize

on error resume next

Set objFSO = CreateObject("Scripting.FileSystemObject")

' First, we get the filesize
Set objFTemp = objFSO.GetFile(flnm)
lngSize = objFTemp.Size
set objFTemp = nothing

fsoForReading = 1
Set objTextStream = objFSO.OpenTextFile(flnm, fsoForReading)

if offset > 0 then
strBuff = objTextStream.Read(offset - 1)
end if

if bytes = -1 then ' Get All!

GetBytes = objTextStream.Read(lngSize) 'ReadAll

else

GetBytes = objTextStream.Read(bytes)

end if

objTextStream.Close
set objTextStream = nothing
set objFSO = nothing

end function

function lngConvert(strTemp)
lngConvert = clng(asc(left(strTemp, 1)) + ((asc(right(strTemp, 1)) * 256)))
end function

function lngConvert2(strTemp)
lngConvert2 = clng(asc(right(strTemp, 1)) + ((asc(left(strTemp, 1)) * 256)))
end function

function gfxSpex(flnm, width, height, depth, strImageType)

dim strPNG 
dim strGIF
dim strBMP
dim strType
strType = ""
strImageType = "(unknown)"

gfxSpex = False

strPNG = chr(137) & chr(80) & chr(78)
strGIF = "GIF"
strBMP = chr(66) & chr(77)

strType = GetBytes(flnm, 0, 3)

if strType = strGIF then 

strImageType = "GIF"
Width = lngConvert(GetBytes(flnm, 7, 2))
Height = lngConvert(GetBytes(flnm, 9, 2))
Depth = 2 ^ ((asc(GetBytes(flnm, 11, 1)) and 7) + 1)
gfxSpex = True

else

strBuff = GetBytes(flnm, 0, -1) 
lngSize = len(strBuff)
flgFound = 0

strTarget = chr(255) & chr(216) & chr(255)
flgFound = instr(strBuff, strTarget)

if flgFound = 0 then
exit function
end if

strImageType = "GIF"
lngPos = flgFound + 2
ExitLoop = false

do while ExitLoop = False and lngPos < lngSize

do while asc(mid(strBuff, lngPos, 1)) = 255 and lngPos < lngSize
lngPos = lngPos + 1
loop

if asc(mid(strBuff, lngPos, 1)) < 192 or asc(mid(strBuff, lngPos, 1)) > 195 then
lngMarkerSize = lngConvert2(mid(strBuff, lngPos + 1, 2))
lngPos = lngPos + lngMarkerSize + 1
else
ExitLoop = True
end if

loop
'
if ExitLoop = False then

Width = -1
Height = -1
Depth = -1

else

Height = lngConvert2(mid(strBuff, lngPos + 4, 2))
Width = lngConvert2(mid(strBuff, lngPos + 6, 2))
Depth = 2 ^ (asc(mid(strBuff, lngPos + 8, 1)) * 8)
gfxSpex = True

end if

end if

end function
''''''''

function bilstorlek(flnm)
	if right(flnm, 3)="gif" then
		Width = lngConvert(GetBytes(flnm, 7, 2))
		Height = lngConvert(GetBytes(flnm, 9, 2))
		Depth = 2 ^ ((asc(GetBytes(flnm, 11, 1)) and 7) + 1)	
	else
	
		strBuff = GetBytes(flnm, 0, -1) 
		lngSize = len(strBuff)
		flgFound = 0
		
		strTarget = chr(255) & chr(216) & chr(255)
		flgFound = instr(strBuff, strTarget)
		
		strImageType = "JPG"
		lngPos = flgFound + 2
		ExitLoop = false
		
		do while ExitLoop = False and lngPos < lngSize
			do while asc(mid(strBuff, lngPos, 1)) = 255 and lngPos < lngSize
				lngPos = lngPos + 1
			loop
			
			if asc(mid(strBuff, lngPos, 1)) < 192 or asc(mid(strBuff, lngPos, 1)) > 195 then
				lngMarkerSize = lngConvert2(mid(strBuff, lngPos + 1, 2))
				lngPos = lngPos + lngMarkerSize + 1
			else
				ExitLoop = True
			end if
		loop
		
		if ExitLoop = "False" then
			Width = -1
			Height = -1
			Depth = -1
		else
			Height = lngConvert2(mid(strBuff, lngPos + 4, 2))
			Width = lngConvert2(mid(strBuff, lngPos + 6, 2))
			Depth = 2 ^ (asc(mid(strBuff, lngPos + 8, 1)) * 8)
		end if
	
	
	
	end if
	
	normalHeight = height
	normalWidth = width
	
	
	test = array(width,height,normalWidth,normalHeight)

end function

Dim width,height,normalWidth,normalHeight,raknare

StartMapp = "d:\webbsidor\contentManagement\bilder"
StartMappUrl = "http://localhost/cm/bilder"

Set filsystemobjekt = CreateObject("Scripting.FileSystemObject")
Set folder = filsystemobjekt.GetFolder(StartMapp)
Set filer = folder.Files 
Set underkataloger = folder.SubFolders 

response.write " <table border=""0"" cellpadding=""2"" cellspacing=""2"">"
raknare = 1
For Each folder in filer
	IF folder.Attributes < 50 then
	
 	  filtyp = lcase(right(folder.name, 3))
	  IF filtyp = "gif" OR(filtyp = "jpg") OR(filtyp = "png") OR(filtyp = "bmp") THEN
	
	
			bild = folder.name
			call bilstorlek(server.mappath("bilder/" &bild& ""))
	
			IF height > width THEN
			   IF height > 100 THEN
				 width = round(width * 100 / height)
				 height = 100
			   END IF
			ELSE
			   IF width > 100 THEN
				 height = round(height * 100 / width)
				 width = 100
			   END IF
			END IF
			  IF raknare = 1 THEN
				  response.write "<tr>"
			  END IF
					Response.Write "<td valign=""bottom"" class=""ruta"">"
					response.write "<table width=""100"" height=""100"" bgcolor=""#D6D6D6"">"
					  response.write "<tr>"
					    response.write "<td valign=""middle"">"
					      response.write "<img height="""&(height)&""" width="""&(width)&""" src=" & StartMappUrl & "/" & folder.name &  ">"
					  response.write "</td>"
					 response.write "</tr>"
					 response.write "</table>"
					 response.write "<span class=""normal9""><b>Typ:</b> "&folder.type
					 response.write "<br><b>Propotioner:</b>"&(normalwidth)&"x"&normalHeight
					response.write "<br><b>Bildstorlek:</b> "&(round(folder.Size/ 1024))&" kb</td>"
				IF raknare = 4 THEN
				  response.write "</tr>"
				END IF
			  raknare = raknare + 1
			  IF raknare = 4 THEN
			    raknare = 1
  			  END IF
	END IF
	END IF
Next  

response.write "</table>"

Set filsystemobjekt = Nothing
Set folder = Nothing
Set filer = Nothing
Set underkataloger = Nothing

%>
solbulleMedlem sedan mars 20015 287 inlägg
#12

Detta script http://www.webforum.nu/showthread.php?s=&postid=446463#post446463 hämtar alla bilder i en mapp (du får lägga till fler filändelser än jpg) samt radar upp dom tre och tre till det totala antalet bilder du vill visa, samt kör en pagin till resten av bilderna.
I det scriptet bör du "lätt" kunna lägga till din bildstorlekssub/funktion.

AddeladdeMedlem sedan jan. 20013 406 inlägg
#13

Jag har redan tittat på det men tack ändå!

solbulleMedlem sedan mars 20015 287 inlägg
#14

Fungerar det inte med det scriptet då?

solbulleMedlem sedan mars 20015 287 inlägg
#15

Du kan ju alltid testa:

<html>
<head>
	<title>Bilder...</title>
</head>
<body>

<link href="admin/admin.css" rel="stylesheet" type="text/css"> <!--#include file="bildfunktioner.asp"-->
<%
StartMapp = "d:webbsidorcontentManagementbilder"
StartMappUrl = "http://localhost/cm/bilder"

'-----------------  Här får du klistra in hela ditt funktionsblock  -----------------

'Dim bild
'''
'function GetBytes osv....

'(får inte plats här...)

'....    test = array(width,height,normalWidth,normalHeight)

'end function

'-----------------  Slut Här får du klistra in hela ditt funktionsblock  -----------------

'## -- hämta alla poster --
Function getImages
	Dim objFSO, objFolder, File, objRSimg
	Dim strExtension
	Const adChar = 129

'## -- skapar recordsetet --
	Set objRSimg = Server.CreateObject("ADODB.Recordset")
'## -- skapar en kolumn i recordsetet --
	objRSimg.Fields.Append "ImageName", adChar, 255

'## -- öppnar vårat skapade recordsetet --
	objRSimg.Open

'## -- skapar ett filesystemobject för att kunna få mapp information --
	Set objFSO = Server.CreateObject("Scripting.FileSystemObject")

'## -- hämtar mappinformation --
	Set objFolder = objFSO.GetFolder("c:\Inetpub\wwwroot\websida\images\")

'## -- här börjar vi att loopa igenom alla filer som finns i mappen --
	For Each File IN objFolder.Files
'## -- vilken filändelse har filen --
		strExtension = objFSO.GetExtensionName(File)
		
		'## -- se till att ändast .jpg läggs till --
			Select Case UCase(strExtension)
				Case "JPG"
				'## -- ställ recordsetet i update läge --
				objRSimg.AddNew
				
				'## -- vilken information ska läggas till i kolummen
				objRSimg("ImageName") = Trim(File.Name)
				
				'## -- uppdatera recordsetet med en ny post --
				objRSimg.Update
			End Select
	Next
Set objFolder = Nothing
Set objFSO = Nothing

	If Not objRSimg.EOF Then
		objRSimg.MoveFirst
		getImages = objRSimg.GetRows()
	End If

objRSimg.Close
Set objRSimg = Nothing
End Function

'## -- vilken post ska pagingen börja på --
Function getStartID(ByVal PageSize, ByVal ViewPage) ' As Integer
	Dim m_intStart
	m_intStart = ((PageSize * ViewPage) - PageSize)
	getStartID = m_intStart
End Function

'## -- räkna ut hur många sidor som ska visas --
Function countPages(ByVal HowManyRecords, ByVal PageSize)
	Dim m_intTotalPages, m_intRest

	m_intTotalPages = HowManyRecords / PageSize

	If m_intTotalPages < 1 Then
		m_intTotalPages = 1
	Else
		m_intRest = m_intTotalPages - CLng(m_intTotalPages)
			If m_intRest > 0 AND m_intRest < 0.5 Then
					m_intTotalPages = CLng(m_intTotalPages) + 1
			Else
					m_intTotalPages = CLng(m_intTotalPages)
			End If
	End If

'## -- ger hur många sidor --
	countPages = m_intTotalPages
End Function

 '##***********************************************************************************
	Dim arrRecords
	Dim intPageSize
	Dim intPage
	Dim intStartID
	Dim I			
	Dim intTotalPages
	Dim intTotalRecords

'## -- vilken sida ska visas --
	intPage = Request.QueryString("page")
	If intPage = "" Then intPage = 1

'## -- hur många poster ska visas per sida --
	intPageSize = 30

 '##**************************************************************************************
'## -- hämta alla records, hämtas med metoden getrows och returneras som en array. --

'## -- här hämtar vi alla bilder till en 2 dimensionell array --
	arrRecords = getImages

'## -- vilken post är den första --
	intStartID = getStartID(intPageSize, intPage)

'## -- printa ut sidan som ska visas
'##    alla poster finns i arrayen arrRecords som
'##    kommer från funktionen getRecords --
	If IsArray(arrRecords) Then
	'Response.Write "E ju en array<BR>"
	'## -- hur många records finns det totalt --
		intTotalRecords = UBound(arrRecords,2) + 1

	'## -- hur många sidor finns det i recordsetet --
		intTotalPages = countPages(intTotalRecords, intPageSize)

'## -- startar tabellen utanför loopen --
	Response.Write "<table border=""1"" cellpadding=""4"" cellspacing=""0"" width=""650""><TR>" & vbcrlf

'## -- Loopen av bilderna börjar

	For I = intStartID To ((intStartID + intPageSize) -1)
	'intId = arrRecords(0,I)
		intCounter = intCounter + 1
		strImageName = arrRecords(0,I)

		'## -- skriv ut en bild -- 
		'response.write "<TD><A href=""images/" & Trim(strImageName) & """ target=""_blank""><IMG src=""images/" & Trim(strImageName) & """></A></TD>" & vbcrlf

'---------orginalkod----------
            call bilstorlek(server.mappath("bilder/" &Trim(strImageName)& ""))
    
            IF height > width THEN
               IF height > 100 THEN
                 width = round(width * 100 / height)
                 height = 100
               END IF
            ELSE
               IF width > 100 THEN
                 height = round(height * 100 / width)
                 width = 100
               END IF
            END IF
                    Response.Write "<td valign=""bottom"" class=""ruta"">"
                    response.write "<table width=""100"" height=""100"" bgcolor=""#D6D6D6"">"
                      response.write "<tr>"
                        response.write "<td valign=""middle"">"
                          response.write "<img height="""&(height)&""" width="""&(width)&""" src=" & StartMappUrl & "/" & Trim(strImageName) &  ">"
                      response.write "</td>"
                     response.write "</tr>"
                     response.write "</table>"
                     response.write "<span class=""normal9""><b>Typ:</b> "&folder.type
                     response.write "<br><b>Propotioner:</b>"&(normalwidth)&"x"&normalHeight
                    response.write "<br><b>Bildstorlek:</b> "&(round(folder.Size/ 1024))&" kb</td>"
'----------slut orginalkod----------

			If I = UBound(arrRecords, 2) Then Exit For
	'## -- Kollar om tre bilder har gått

	IF intCounter = 9 Then 
		response.write ""
	ELSEIF intCounter mod 3 = 0 then
		response.write "</TR><TR>" & vbcrlf
	End IF
	Next

'## -- stänger tabellen efter loopen --
	Response.Write("</TR></table>"<p>"")

'## -- skriv ut sidnavigerings menyn --
Call PrevPage(intPage)
	Response.Write("")

Call NextPage(intTotalPages,intPage)

'## -- skriver ut sidnavigeringen --
'## -- skriv ut föregående sida --
Sub PrevPage(ByVal WichPage)
	Dim strScriptName
	strScriptName = Request.ServerVariables("SCRIPT_NAME")

	Response.Write("<table border=""1"" cellpadding=""0"" cellspacing=""0"" width=""680"">")
'## -- skriv ut en länk till föregående sida --
	If CInt(WichPage) > 1 Then
		Response.Write("<tr><td align=""left"">" & _
		"<a href='" & strScriptName & "?" & "page=" & WichPage - 1 & "'>" & _
		"<img border=""0"" src=""../../bilder/pilar/left.gif""> Föregående</a></td>")
	Else
		Response.Write("<td align=""left""></td>")
	End If
End Sub
'## -- skriv ut nästa sida --
Sub NextPage(ByVal HowManyPages, ByVal WichPage)
	Dim strScriptName
	strScriptName = Request.ServerVariables("SCRIPT_NAME")
'## -- skriv ut en länk till nästa sida --
	If CInt(WichPage) < CInt(HowManyPages) Then
		Response.Write("<td align=""right"">" & _
		"<a href='" & strScriptName & "?" & "page=" & WichPage + 1 & "'>" & _
		"Nästa <img border=""0"" src=""../../bilder/pilar/right.gif""></a></td></tr></table>")
	Else
		Response.Write("<td align=""right""></td></tr></table>")
	End If
End Sub
	Else
	'## -- inga poster fanns i db --
		intPage = 0
		intTotalRecords = 0
		intTotalPages = 0
	'## -- skriv ut att inga poster hittades --
		Response.Write("<P>Inga bilder hittades</P>")
	End If
%>
</body>
</html>
AddeladdeMedlem sedan jan. 20013 406 inlägg
#16

Tack fungerar strålande

286 ms totalt · 4 externa anrop · v20260731065814-full.a51de22e
127 ms — deklarationer (db)
0 ms — hämta statistik (cache)
156 ms — hämta tråd, inlägg och bilagor (db)
118 ms — ändringar (db)