Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Получить через VBA размер картинки и отличить горизонтальную картинку от вертикальной / 3 сообщений из 3, страница 1 из 1
14.02.2012, 14:09
    #37661022
DMK67
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Получить через VBA размер картинки и отличить горизонтальную картинку от вертикальной
При организации просмотра картинок на UserForm встала проблема: хотелось бы программно делать прокрутку на Frame для вертикально ориентированных фотографий и отменять эту операцию для горизонтально-ориентированных.
Сама процедура организации прокрутки никаких проблем не представляет. Но нужно выяснить размеры картинки, чтобы задать переменную ФФФ

Код: vbnet
1.
2.
3.
4.
'растягиваем me.frame_INSTR 
With Me.Frame_INSTR
.ScrollHeight = .Height * ФФФ
End With
...
Рейтинг: 0 / 0
14.02.2012, 15:05
    #37661171
DMK67
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Получить через VBA размер картинки и отличить горизонтальную картинку от вертикальной
Сам нашел в сборнике кодов
www.vbnet.ru/faq/showtopic.asp?id=332
чутка подкорректировал вывод информации

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
Private Type ThePicInfo
Type As String
Width As Long
Height As Long
End Type

Private Function CheckPicSpecs(TheFile) As ThePicInfo
Dim TheContent, TheImageInfo As ThePicInfo, TheVar, TheFreeFile
TheFreeFile = FreeFile
Open TheFile For Binary As TheFreeFile
TheContent = Input(10, TheFreeFile)
Close TheFreeFile
If Mid(TheContent, 7, 4) = "JFIF" Then
TheImageInfo.Type = "JPG"
Open TheFile For Binary As TheFreeFile
TheContent = Input(167, TheFreeFile)
Close TheFreeFile
TheImageInfo.Height = Asc(Mid(TheContent, 165, 1)) + 256 * Asc(Mid(TheContent, 164, 1))
TheImageInfo.Width = Asc(Mid(TheContent, 167, 1)) + 256 * Asc(Mid(TheContent, 166, 1))
End If
If Mid(TheContent, 1, 3) = "GIF" Then
TheImageInfo.Type = "GIF"
TheImageInfo.Width = Asc(Mid(TheContent, 7, 1)) + 256 * Asc(Mid(TheContent, 8, 1))
TheImageInfo.Height = Asc(Mid(TheContent, 9, 1)) + 256 * Asc(Mid(TheContent, 10, 1))
End If
CheckPicSpecs = TheImageInfo
End Function

Sub Размеры_картинки()
Dim a As ThePicInfo
'в качестве параметра функции CheckPicSpecs установите путь к вашей картинке
a = CheckPicSpecs("C:\1.gif")
MsgBox "ТИП ФАЙЛА" & a.Type & " ШИРИНА: " & a.Width & " ВЫСОТА: " & a.Height

End Sub
...
Рейтинг: 0 / 0
15.02.2012, 01:23
    #37662140
DMK67
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Получить через VBA размер картинки и отличить горизонтальную картинку от вертикальной
А способ то некорректный... на разных файлах - то срабатывает, то нет...

А ведь винда видит размер вне зависимости от того как файл сформирован...
...
Рейтинг: 0 / 0
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Получить через VBA размер картинки и отличить горизонтальную картинку от вертикальной / 3 сообщений из 3, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]