Private Function getHWgif(file As String, X As Long, Y As Long) As Boolean
Dim w As Integer, h As Integer, s As String * 3
w = CInt(X)
h = CInt(Y)
On Error GoTo sos1
getHWgif = False
Open file For Binary As #1
Get #1, , s
If s <> "GIF" Then
MsgBox file & " - не файл формата GIF"
Close #1
Exit Function
End If
Get #1, , s 'версия
Get #1, , w
Get #1, , h
Close #1
X = CLng(w)
Y = CLng(h)
If X = 0 Or Y = 0 Then MsgBox file & " - Invalid image (H=0 OR W=0)" Else getHWgif = True
Exit Function
sos1:
MsgBox Err.Description
End Function
Private Function getHWjpg(file As String, X As Long, Y As Long) As Boolean
Dim s As String, s1 As String, j As Long, i As Integer, n As Integer, k As Integer
Dim h As Long, b As Byte
On Error GoTo sos
getHWjpg = False
Open file For Binary As #1
Get #1, , i
If Not Hex(i) = "D8FF" Then
MsgBox file & " - не файл формата JPEG"
Close #1
Exit Function
End If
While Not EOF(1)
Get #1, , i
If Hex(i) <> "C0FF" Then
GoSub nextSegment
Else
Get #1, , i 'длина сегмента
Get #1, , b 'точность
For k = 0 To 1
Get #1, , i
GoSub calc
If k = 0 Then
Y = j 'высота pixels
Else
X = j 'ширина pixels
End If
Next
Close #1
If X = 0 Or Y = 0 Then MsgBox file & " - Invalid image (H=0 OR W=0)" Else getHWjpg = True
Exit Function
End If
Wend
MsgBox "Не найдено начало кадра"
Close #1
Exit Function
nextSegment:
Get #1, , i
GoSub calc 'j - длина сегмента
h = Seek(1)
Seek #1, h + j - 2
Return
calc:
s = Hex(i)
s = String(4 - Len(s), "0") & s
s = Right$(s, 2) & Left$(s, 2)
j = 0
For i = 0 To 3
s1 = Mid$(s, 4 - i, 1)
If s1 < "A" Then n = Val(s1) Else n = Asc(s1) - 55
j = j + n * 16 ^ i
Next
Return
sos:
MsgBox Err.Description
End Function
Доступ к графическим файлам на Vba
Как на VBA получить доступ к характеристикам (в частности, к размеру) графических файлов (напр., tiff)?
Цитата:
Originally posted by Alexxxander
Как на VBA получить доступ к характеристикам (в частности, к размеру) графических файлов (напр., tiff)?
Как на VBA получить доступ к характеристикам (в частности, к размеру) графических файлов (напр., tiff)?
Изучи структуру файла и прочитай соответствующие параметры в заголовке файла.
Цитата:
Originally posted by Alexxxander
Как на VBA получить доступ к характеристикам (в частности, к размеру) графических файлов (напр., tiff)?
Как на VBA получить доступ к характеристикам (в частности, к размеру) графических файлов (напр., tiff)?
Для файлов gif и jpg я в свое время это проделал.
Код: