USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  Fórum

  Visual Basic
Voltar
Autor Assunto:  Pegar medidas de uma Imagem
defende
não registrado
Postada em 03/09/2004 15:17 hs   
Tem como eu pegar as medidas de um jpg - altura e largura dela - mas sem carregar ela, diretamente no arquivo, ler direto no diretorio.
Sei que tinha um jeito usando FSO mas nao lembro como se faz...
     
Los Zeus®
Pontos: 2843 Pontos: 2843
SÃO PAULO
SP - BRASIL
Postada em 03/09/2004 18:46 hs            
Se vc estiver usando o componente Image, na hora que a imagem é inserida ele se auto ajusta com o tamanho da imagem ai é so pegar o Height e o width que vc vai ter o tamanho da mesma.....se vc estiver com outro componente dá uma olhada nessa dica:
     
Geronimo
Pontos: 2843
JOINVILLE
SC - BRASIL
Postada em 04/09/2004 09:01 hs            
Segue :
 
Ou veja se ajuda :
Tamanho da imagem:
Em um form adicione os seguintes itens

1 DirListbox (Dir1)
1 DriveListbox (Drive1)
1 FilelistBox (File1)
3 botões (cmdStart), (cmdClear) e (cmdQuit)
1 textbox (txtOut)
1 Image (Image1) Image1.Height = 3375 Image1.Width = 4035

E coloque em um modulo

Option Explicit
Public Type ImageSize
Width As Long
Height As Long
End Type

Public Function GetImageSize(sFileName As String) As ImageSize
On Error Resume Next 'you'll want to change this
Dim iFN As Integer
Dim bTemp(3) As Byte
Dim lFlen As Long
Dim lPos As Long
Dim bHmsb As Byte
Dim bHlsb As Byte
Dim bWmsb As Byte
Dim bWlsb As Byte
Dim bBuf(7) As Byte
Dim bDone As Byte
Dim iCount As Integer

lFlen = FileLen(sFileName)
iFN = FreeFile
Open sFileName For Binary As iFN
Get #iFN, 1, bTemp()

'PNG file
If bTemp(0) = &H89 And bTemp(1) = &H50 And bTemp(2) = &H4E _
And bTemp(3) = &H47 Then
Get #iFN, 19, bWmsb
Get #iFN, 20, bWlsb
Get #iFN, 23, bHmsb
Get #iFN, 24, bHlsb
GetImageSize.Width = CombineBytes(bWlsb, bWmsb)
GetImageSize.Height = CombineBytes(bHlsb, bHmsb)
End If

'GIF file
If bTemp(0) = &H47 And bTemp(1) = &H49 And bTemp(2) = &H46 _
And bTemp(3) = &H38 Then
Get #iFN, 7, bWlsb
Get #iFN, 8, bWmsb
Get #iFN, 9, bHlsb
Get #iFN, 10, bHmsb
GetImageSize.Width = CombineBytes(bWlsb, bWmsb)
GetImageSize.Height = CombineBytes(bHlsb, bHmsb)
End If


'JPEG file
If bTemp(0) = &HFF And bTemp(1) = &HD8 And bTemp(2) = &HFF Then
Debug.Print "JPEG"
lPos = 3
Do
Do
Get #iFN, lPos, bBuf(1)
Get #iFN, lPos + 1, bBuf(2)
lPos = lPos + 1
Loop Until (bBuf(1) = &HFF And bBuf(2) <> &HFF) Or lPos > lFlen

For iCount = 0 To 7
Get #iFN, lPos + iCount, bBuf(iCount)
Next iCount
If bBuf(0) >= &HC0 And bBuf(0) <= &HC3 Then
bHmsb = bBuf(4)
bHlsb = bBuf(5)
bWmsb = bBuf(6)
bWlsb = bBuf(7)
bDone = 1
Else
lPos = lPos + (CombineBytes(bBuf(2), bBuf(1))) + 1
End If
Loop While lPos < lFlen And bDone = 0
GetImageSize.Width = CombineBytes(bWlsb, bWmsb)
GetImageSize.Height = CombineBytes(bHlsb, bHmsb)

End If
Close iFN

End Function
Private Function CombineBytes(lsb As Byte, msb As Byte) As Long
CombineBytes = CLng(lsb + (msb * 256))
End Function




E no form

Option Explicit
Private Sub cmdClear_Click()
txtOut.Text = ""
End Sub

Private Sub cmdQuit_Click()
Unload Me
End Sub

Private Sub cmdStart_Click()
cmdStart.Enabled = False
MousePointer = vbHourglass
ChDrive Drive1.Drive
ChDir Dir1.Path
Dim iDnCount As Integer
Dim intCount As Integer
Dim intTemp As Integer
Dim lStart As Long
Dim lLength As Long
Dim usize As ImageSize
Dim sFile As String
intCount = File1.ListCount
If intCount > 0 Then
For intTemp = 0 To intCount - 1
If File1.Selected(intTemp) = True Then
sFile = File1.List(intTemp)
usize = GetImageSize(sFile)
PrintToBox usize.Width & vbTab & usize.Height & vbTab & sFile
iDnCount = iDnCount + 1
End If
Next intTemp
End If
MousePointer = vbNormal
If iDnCount = 0 Then
MsgBox "You haven't selected any files", vbOKOnly, "Duh!"
End If
cmdStart.Enabled = True
End Sub


Private Sub Dir1_Change()
ChDir Dir1.Path
RefreshFiles
End Sub
Private Sub Drive1_Change()
ChDrive Drive1.Drive
RefreshFiles
End Sub
Sub RefreshFiles()
Drive1.Drive = CurDir
Dir1.Path = CurDir
File1.Path = CurDir
Drive1.Refresh
Dir1.Refresh
File1.Refresh
End Sub
Private Sub PrintToBox(sIn As String)
Dim NL As String
NL = vbCrLf
txtOut.Text = txtOut.Text & NL & sIn
End Sub

Private Sub File1_Click()
On Error Resume Next
Image1.Stretch = True
Image1.Picture = LoadPicture(File1.FileName)
Image1.Height = 3375
Image1.Width = 4035
End Sub


Você terá um visualizador que da as dimenções em um textbox apenas de jpg, gif e png.

Espero ter ajudado.

Outro exemplo:
Vc pode mudar a propriedade AutoSize para True e o picturebox ficará do tamanho da imagem ai é só usar Picture1.ScaleWidth & Picture1.ScaleHeight para obter as medidas da imagem.

Se vc quiser fazer isso sem alterar o tamanho do picturebox vc pode chamar a Sub abaixo:

Sub MedidasImagem(ByVal Obj As Control, ByRef W As Long, ByRef H As Long)

Dim FRM As Object

Set FRM = Obj

If Not TypeOf Obj Is PictureBox And Not TypeOf Obj Is Form Then
' Se não for form ou picturebox coisa, deve ter uma propriedade picture e
' será usado o seu container (form ou picturebox)
Do Until TypeOf FRM Is Form Or TypeOf FRM Is PictureBox
Set FRM = CallByName(FRM, "Parent", VbGet)
Loop
End If

' Retorna os valores via as variáveis passadas
W = CInt(FRM.ScaleX(Obj.Picture.Width, vbHimetric, vbPixels))
H = CInt(FRM.ScaleY(Obj.Picture.Height, vbHimetric, vbPixels))


End Sub

Em teoria esta rotina funciona com qualquer coisa que tenha uma propriedade Picture. 

Para Usar chame a rotina passando o objeto e 2 variáveis do tipo Long, quando a rotina retornar estas variáveis conterão as medidas da imagem na propriedade Picture do objeto.



 

"O pior inimigo que você poderá encontrar será sempre você mesmo."
     
defende
não registrado
Postada em 04/09/2004 12:51 hs   
Valeu pessoal, ajudou muito mesmo a dica.
Era isso que eu queria
 
[]'s
     
Página(s): 1/1    


Seu Nome:

Seu eMail:

ALTERAR PARA MODO HTML
Mensagem:

[:)] = 
[:P] = 
[:(] = 
[;)] = 

HTML DESLIGADO

     
 VOLTAR

  



CyberWEB Network Ltda.    © Copyright 2000-2025   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página