Ir para conteúdo

POWERED BY:

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

Inside

[Resolvido] Pixels da Foto

Recommended Posts

Caros amigos,

 

 

existe alguma forma de em um página mostrar apenas as imagens que tamanho um tamanho definido?

 

Num sistema de notícias que tenho só posso usar fotos que tenham 500x375 pixels mas na pasta há fotos que estão fora deste padrão.

 

Existe alguma forma de mostrar somente as fotos com o padrão pré-estabelecido para que eu posso escolher qual vou usar na notícia?

 

 

O ASP faz isto ou preciso de um componente? Eu precisava que numa página mostrasse todas as fotos que estão na pasta arquivos/fotos/ mas somente as que possuem 500x375 pixels.

 

 

Já pesquisei na Net mas não achei nada relacionado a isto.

 

 

 

Obrigado pela atenção de todos.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Sim é possível, existe uma function que faz isso sem o uso de componentes, porém como se trata de várias imagens não é recomendado fazer esse esquema tudo de uma hora... pois o sistema ficaria estremamente lento.. o que você pode fazer é criar uma coluna no banco de dados aplicando o valor height e wight da imagem e posteriormente atravez de um query resgatar as imagens que você deseja.

 

Portanto é aconselhavel utilizar a função no momento do upload da foto, com isso resgatasse as dimensões desta imagem e coloca no bd, com isso você terá as dimensões no bd de todas as imagens.

 

Segue abaixo uma function.

 

<% Option Explicit %>
<% 
Dim address
address = Trim(Request("image"))

Sub CalcImageDimensions()
	Dim objXML, strBinarySource, strAsciiContents
	Dim width, height, colors
	Dim strType
	
	Set objXML = Server.CreateObject("Microsoft.XMLHTTP")
	strBinarySource = ""
	On Error Resume Next
		objXML.Open "GET", address, False
		objXML.Send
		If Err.Number<>0 Then
			Response.Write("<font color=""red""><h3>Error " & Err.Number & " : " & Err.Description & "</h3></font>")
		Else  
			strBinarySource = objXML.ResponseBody
		End If
	On Error Goto 0
	Set objXML=Nothing
	
	If LenB(strBinarySource)>0 Then
		strAsciiContents = RSBinaryToString(strBinarySource)
		If gfxSpex(strAsciiContents, width, height, colors, strType) = True then
			Response.Write("image file size: " & LenB(strBinarySource) & " (bytes)<br />")
			Response.Write("image width: " & width & " (pixels)<br />")
			Response.Write("image height: " & height & " (pixels)<br />")
			Response.Write("color depth: " & colors & "<br />")
			Response.Write("image type: " & strType)
		Else  
			Response.Write("<font color=""red""><h3>not valid image</h3></font>")
		End If
	End If
	
	Response.Write("<br /><br /><br />")
End Sub

Function RSBinaryToString(xBinary)
	'Antonin Foller, http://www.motobit.com
	'RSBinaryToString converts binary data (VT_UI1 | VT_ARRAY Or MultiByte string)
	'to a string (BSTR) using ADO recordset
	
	Dim Binary
	'MultiByte data must be converted To VT_UI1 | VT_ARRAY first.
	If vartype(xBinary)=8 Then Binary = MultiByteToBinary(xBinary) Else Binary = xBinary
	
	Dim RS, LBinary
	Const adLongVarChar = 201
	Set RS = CreateObject("ADODB.Recordset")
	LBinary = LenB(Binary)
	
	If LBinary>0 Then
		RS.Fields.Append "mBinary", adLongVarChar, LBinary
		RS.Open
		RS.AddNew
		RS("mBinary").AppendChunk Binary 
		RS.Update
		RSBinaryToString = RS("mBinary")
	Else  
		RSBinaryToString = ""
	End If
End Function

Function MultiByteToBinary(MultiByte)
	'© 2000 Antonin Foller, http://www.motobit.com
	' MultiByteToBinary converts multibyte string To real binary data (VT_UI1 | VT_ARRAY)
	' Using recordset
	Dim RS, LMultiByte, Binary
	Const adLongVarBinary = 205
	Set RS = CreateObject("ADODB.Recordset")
	LMultiByte = LenB(MultiByte)
	If LMultiByte>0 Then
		RS.Fields.Append "mBinary", adLongVarBinary, LMultiByte
		RS.Open
		RS.AddNew
		RS("mBinary").AppendChunk MultiByte & ChrB(0)
		RS.Update
		Binary = RS("mBinary").GetChunk(LMultiByte)
	End If
	MultiByteToBinary = Binary
End Function

':::::::::::::::::::::::::::::::::::::::::::::::::  ::::::::::::::::::
':::                                                             :::
':::  This routine will attempt to identify any filespec passed  :::
':::  as a graphic file (regardless of the extension). This will :::
':::  work with BMP, GIF, JPG and PNG files.                     :::
':::                                                             :::
':::::::::::::::::::::::::::::::::::::::::::::::::  ::::::::::::::::::
':::          Based on ideas presented by David Crowell          :::
':::                   (credit where due)                        :::
':::::::::::::::::::::::::::::::::::::::::::::::::  ::::::::::::::::::
':::::::::::::::::::::::::::::::::::::::::::::::::  ::::::::::::::::::
':::::::::::::::::::::::::::::::::::::::::::::::::  ::::::::::::::::::
'::: blah blah blah blah blah blah blah blah blah blah blah blah :::
'::: blah blah blah blah blah blah blah blah blah blah blah blah :::
'::: blah blah     Copyright *c* MM,  Mike Shaffer     blah blah :::
'::: bh blah      ALL RIGHTS RESERVED WORLDWIDE      blah blah :::
'::: blah blah  Permission is granted to use this code blah blah :::
'::: blah blah   in your projects, as long as this     blah blah :::
'::: blah blah      copyright notice is included       blah blah :::
'::: blah blah blah blah blah blah blah blah blah blah blah blah :::
'::: blah blah blah blah blah blah blah blah blah blah blah blah :::
':::::::::::::::::::::::::::::::::::::::::::::::::  ::::::::::::::::::

':::::::::::::::::::::::::::::::::::::::::::::::::  ::::::::::::::::::
':::                                                             :::
':::  This function gets a specified number of bytes from any    :::
':::  file, starting at the offset (base 1)                      :::
':::                                                             :::
':::  Passed:                                                    :::
':::       flnm        => Filespec of file to read               :::
':::       offset      => Offset at which to start reading       :::
':::       bytes       => How many bytes to read                 :::
':::                                                             :::
':::::::::::::::::::::::::::::::::::::::::::::::::  ::::::::::::::::::
Private Function GetBytes(flnm, offset, bytes)
	Dim startPos
	If offset=0 Then
		startPos = 1
	Else  
		startPos = offset
	End If
	if bytes = -1 then		' Get All!
		GetBytes = flnm
	else
		GetBytes = Mid(flnm, startPos, bytes)
	end if
'		Dim objFSO
'		Dim objFTemp
'		Dim objTextStream
'		Dim lngSize
'		
'		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

':::::::::::::::::::::::::::::::::::::::::::::::::  ::::::::::::::::::
':::                                                             :::
':::  Functions to convert two bytes to a numeric value (long)   :::
':::  (both little-endian and big-endian)                        :::
':::                                                             :::
':::::::::::::::::::::::::::::::::::::::::::::::::  ::::::::::::::::::
Private Function lngConvert(strTemp)
	lngConvert = clng(asc(left(strTemp, 1)) + ((asc(right(strTemp, 1)) * 256)))
end function

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

':::::::::::::::::::::::::::::::::::::::::::::::::  ::::::::::::::::::
':::                                                             :::
':::  This function does most of the real work. It will attempt  :::
':::  to read any file, regardless of the extension, and will    :::
':::  identify if it is a graphical image.                       :::
':::                                                             :::
':::  Passed:                                                    :::
':::       flnm        => Filespec of file to read               :::
':::       width       => width of image                         :::
':::       height      => height of image                        :::
':::       depth       => color depth (in number of colors)      :::
':::       strImageType=> type of image (e.g. GIF, BMP, etc.)    :::
':::                                                             :::
':::::::::::::::::::::::::::::::::::::::::::::::::  ::::::::::::::::::
function gfxSpex(flnm, width, height, depth, strImageType)
	dim strPNG 
	dim strGIF
	dim strBMP
	dim strType
	dim strBuff
	dim lngSize
	dim flgFound
	dim strTarget
	dim lngPos
	dim ExitLoop
	dim lngMarkerSize
	
	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				' is GIF
		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
	elseif left(strType, 2) = strBMP then		' is BMP
		strImageType = "BMP"
		Width = lngConvert(GetBytes(flnm, 19, 2))
		Height = lngConvert(GetBytes(flnm, 23, 2))
		Depth = 2 ^ (asc(GetBytes(flnm, 29, 1)))
		gfxSpex = True
	elseif strType = strPNG then			' Is PNG
		strImageType = "PNG"
		Width = lngConvert2(GetBytes(flnm, 19, 2))
		Height = lngConvert2(GetBytes(flnm, 23, 2))
		Depth = getBytes(flnm, 25, 2)
		select case asc(right(Depth,1))
			case 0
				Depth = 2 ^ (asc(left(Depth, 1)))
				gfxSpex = True
			case 2
				Depth = 2 ^ (asc(left(Depth, 1)) * 3)
				gfxSpex = True
			case 3
				Depth = 2 ^ (asc(left(Depth, 1)))  '8
				gfxSpex = True
			case 4
				Depth = 2 ^ (asc(left(Depth, 1)) * 2)
				gfxSpex = True
			case 6
				Depth = 2 ^ (asc(left(Depth, 1)) * 4)
				gfxSpex = True
			case else
				Depth = -1
		end select
	else
		strBuff = GetBytes(flnm, 0, -1)		' Get all bytes from file
		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 = "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)
			gfxSpex = True
		end if
	end if
End Function
%>
<html>
<head>
<title>Get Image Dimensions</title>
</head>
<body>
<%
If address<>"" Then
	Call CalcImageDimensions()
End If
%>
<form>
	Enter url address: <input name="image" value="<%=Request("image")%>" /><br />
	<button type="submit">Calculate</button>
</form>
</body>
</html>

Compartilhar este post


Link para o post
Compartilhar em outros sites

Caro Patrique

 

 

uma coisa admiro, você gosta de ajudar os mais fracos por assim dizer rsrsrs MAs é seréio você sempre ajuda.

 

 

Você deu uma ideía boa. Dei uns pulos aqui e fiz o sistema de upload gravar o tamanho da imagem no banco, agora vou conseguir puxar do banco e não vou precisar puxar da pasta. E como você disse vou fazer em pacotes, pois a imagens são renomeadas de acordo com o álbum e categoria.

 

 

Valeu pela grande ajuda.

Compartilhar este post


Link para o post
Compartilhar em outros sites

×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.