|
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...
|
|
|
|
|
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:
|
|
|
|
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."
|
|
|
|
Postada em 04/09/2004 12:51 hs
Valeu pessoal, ajudou muito mesmo a dica. Era isso que eu queria []'s
|
|
|
|