[Resolvido] Função para resize em imagem

tem uma função que postei no lab. de script, dá uma procurada lá

pode te ajudar

Eu dei uma olhada sim! Tu utiliza aspJPEG porém, o meu meu problema é utilizar uma imagem com tamanhos diferentes.

Exemplo, tenho a original que é 600x200, certo? Em uma determinada área eu vou utilizar a mesma imagem com 200x200 e em outro lugar 300x150.

entendeu?

olha este exemplo

envia uma imagem grande, reduz pra uma dimensão razoável padrão que usará no site e após gera uma miniatura e grava numa pasta separado... veja se te serve e pode modificar a seu critério.

<%
id = request("id")

On Error Resume Next
Set Upload = Server.CreateObject("Persits.Upload")
Upload.OverwriteFiles = True ' sobrepõe o arquivo ?
Upload.SetMaxSize 1000000 ' tamanho máximo permitido para envio em KB
Path = "C:/inetpub/vhosts/site.com.br/httpdocs/fotos/" ' caminho relativo ao site no servidor
Count = Upload.Save(Path)

For Each File in Upload.Files
foto = File.FileName ' pega o nome do arquivo da imagem em uma variável
Next

' REDUZIR TAMANHO DA IMAGEM EM KB
Set File = Upload.Files(1)
Set Jpeg = Server.CreateObject("Persits.Jpeg")
Jpeg.Open( File.Path )
Jpeg.Quality = 70 ' qualidade do JPEG
Jpeg.Width = 640 ' tamanho da largura da foto a ser redimensionada
Jpeg.Height = Jpeg.OriginalHeight * Jpeg.Width / Jpeg.OriginalWidth ' pega largura e diminui altura proporcional
Jpeg.Sharpen 1, 120
' Grava a imagem na pasta definida acima no Path
SavePath = Path & File.ExtractFileName

If UCase(Right(SavePath, 3)) <> "JPG" Then
SavePath = SavePath & ".jpg"
End If
jpeg.Save SavePath

' ETAPA PARA GERAÇÃO DA MINIATURA
Set File = Upload.Files(1)
Set Jpeg = Server.CreateObject("Persits.Jpeg")
Jpeg.Open( File.Path ) ' pega o caminho relativo definido no Path
Jpeg.Quality = 80 ' define a qualidade do JPEG
Jpeg.Width = 120 ' tamanho da largura a ser criado a miniatura
Jpeg.Height = Jpeg.OriginalHeight * Jpeg.Width / Jpeg.OriginalWidth ' pega largura e diminui altura proporcional
Jpeg.Sharpen 1, 120
' Grava miniatura da imagem na pasta mini dentro do caminho definido no Path
SavePath = Path & "\mini\" & File.ExtractFileName

If UCase(Right(SavePath, 3)) <> "JPG" Then
SavePath = SavePath & ".jpg"
End If
jpeg.Save SavePath

Set Jpeg = Nothing

' se houver erro mostra mensagem e volta
If Err <> 0 Then

 Response.Write "Desculpe, houve um erro ao enviar imagens! <br />"
 Response.Write "<a href=""javascript:history.back();"">Voltar</a>"

 strSql = strSql & " Update tabela SET "
 strSql = strSql & " foto = '"& File.FileName &"' "
 strSql = strSql & " Where id = "& id &" "
 cn.execute(strSql)

 ' se houver erro relativo ao gravar no BD mostra mensagem
 if err.number <> 0 then
 Response.Write "Desculpe, houve um erro ao gravar no Banco de Dados! <br />"
 Response.Write "<a href=""javascript:history.back();"">Voltar</a>"
 else
 ' se não houver erro, mostra mensagem de sucesso e encaminha para index ou pagina
 %>
 <script>
 alert("Dados alterados com sucesso!");
 window.location='index.asp';
 </script>
 <%
 end if

eu uso isso numa função depois é só chamar a imagem e os tamanhos e os locais onde quer guardar

sub uploadimg(nome,nomefinal,caminhoactual,caminhofinal,largura,altura)
Set Jpeg = Server.CreateObject("Persits.Jpeg")
Jpeg.Open server.MapPath(caminhoactual&nome)
numHgt = Jpeg.OriginalHeight
numWdt = Jpeg.OriginalWidth
MaxLarg = cint(largura)
MaxAlt = cint(altura)
If MaxLarg > numWdt and MaxAlt > numHgt then

Else
maxAlt = ((MaxLargMaxAlt)/(MaxLargnumHgt))
maxLrg = ((MaxLargMaxAlt)/(MaxAltnumWdt))
If maxAlt < maxLrg then
width = numWdt*maxAlt
height = numHgt*maxAlt
Else
width = numWdt*maxLrg
height = numHgt*maxLrg
End If
Jpeg.Width = width
Jpeg.Height = height
End If
Jpeg.Quality = 100
Jpeg.Save server.MapPath(caminhofinal&nomefinal)
set Jpeg = nothing
end sub

call uploadimg(nome,nomefinal,caminhoactual,caminhofinal,largura,altura)

nome: é o nome da imagem que você vai dar
nomefinal: é se quiser dar outro nome à imagem, para por exemplo guardar na mesma directoria a mesma imagem mas com 2 nomes diferentes
caminhoactual: é o caminho onde se encontra a imagem
caminhofinal: é o caminho onde vai guardar a imagem
largura: não precisa explicar
altura: também não

exemplo de redimensão tendo já feito o upload da imagem

nome_imagem = "teste.jpg"
caminho_imagem = "upload/"
caminho_imagem_2 = "upload/200x200/"

call uploadimg(nome_imagem ,nome_imagem ,caminho_imagem ,caminho_imagem ,600,200)' aqui redimensiona a original
call uploadimg( nome_imagem , nome_imagem , caminho_imagem , caminho_imagem_2 ,200,200)
...

Eu vou fazer alguns testes.

No caso eu consigo pegar mais de uma imagem que está sendo upada e redimensionar?

Eu estou atrás de algum algorítimo ou função que faça isso:

<img src="imagem.jpg?500x200"

eu já vi isso no .net, mas nunca no asp.....

você at´pe pode pegar esses paramentros passado pela url e usar outra função para redimensionar conforme a url

o problema é como fazer isso...

eu tentei com aspJPEG.... não gerou erro e nem salvou a thumb... podes me ajudar?

este é meu código hoje

on error resume next
arquivos = "E:\Domains\site.com\wwwroot\homologacao\scharbel\v2\static\upload\liturgia\"
Set objUpload = Server.CreateObject("Dundas.Upload.2")
objUpload.UseVirtualDir = false
objUpload.UseUniqueNames = false
objUpload.MaxFileSize = 6000000
objUpload.Save arquivos

DataHora = "{" & RIGHT("0" & Day(Now),2) & "-" & RIGHT("0" & Month(Now),2) & "-" & Year(Now) & "-" & RIGHT("0" & Hour(Now),2) & "-" & RIGHT("0" & Minute(Now),2) & "-" & RIGHT("0" & Second(Now),2) & "}"
For Each arquivos in objUpload.Files
Path = arquivos.Path
NomeArquivo = objUpload.GetFileName(Path)
thumb = objUpload.Files(1)

Set fso = CreateObject("Scripting.FileSystemObject")
Set fileObject = fso.GetFile("E:\Domains\site.com\wwwroot\homologacao\scharbel\v2\static\upload\liturgia\" & NomeArquivo)
fileObject.Name = DataHora&"_"&NomeArquivo
Set fileObject = Nothing
Set fso = Nothing
Next

quando implemento o aspJPEG não acontece nada

Ai galera consegui!

O erro era bem besta... o caminho estava errado...

Obrigado pela ajuda!

olá amigo, que bom que resolveu, porém , sempre solicito para os users que solucionar seus problemas, que postem o código final, para ser uma refrenecia para outros com a mesma dificuldades.

Saudações

Pessoal, sobre essa questão de alterar o tamanho da imagem, me esclareçam uma dúvida:

Existe algum código em asp que eu consiga diminuir ou aumentar a imagem proporcionalmente, sem que ela fique distorcida.

Sei que tem vários sistemas de notícias com upload de fotos. Sabemos que as fotos nunca vêm do mesmo tamanho.

Geralmente a gente, ao disponibilizar um local para a imagem ser exibida, já devido qual tamanho deverá ser o Width e o Height.

Atualmente eu pego imagem por imagem, jogo no fireworks e vou mexendo nela até fique do tamanho que eu quero, sem distorcer.

Mas esse procedimento é muito árduo... Será que existe uma código que possa me ajudar?

Abraços

Jardel Paes

você consegue fazer isso atraves de componentes

e olha esta função onde 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, e pode alterá-las também

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 />")

Function RSBinaryToString(xBinary)
'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

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

'::::::::::::::::::::::::::::::::::::::::::::::::: ::::::::::::::::::
'::: :::
'::: 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 :::

'::::::::::::::::::::::::::::::::::::::::::::::::: ::::::::::::::::::
'::: :::
'::: 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

<html>
<head>
<title>Get Image Dimensions</title>
</head>
<body>

<form>
 Enter url address: <input name="image" value="<%=Request("image")%>" /><br />
 <button type="submit">Calculate</button>
</form>
</body>
</html>

Valeu xanburzum, vou fazer os testes.

Depois eu posto aqui o resultado

Abraços

Jardel Paes

Olá xanburzum,

Acabei de implementar o código acima e obitve o seguinte resultado:

image file size: 41952 (bytes)

image width: 349 (pixels)

image height: -15448 (pixels)

color depth: 256

image type: GIF

Agora, desculpe minha ignorância, mas em que estes dados será útil para mim?

Como devo aproveitá-los

Como implemento em meu código de upload?

Como ficaria essa imagem acima, se o lugar que ela será exibida no meu site está configurado para 300x250?

Desculpe, rsrsssr

Abraços

Jardel