Visual Basic, .NET, ASP, VBScript
 

   
   
     

Форум - Общий форум

Страница: 1 | 2 |

 

  Вопрос: Как узнать размер изображения? Добавлено: 20.05.07 18:24  

Автор вопроса:  Arvitaly | Web-сайт: okazani.ru | ICQ: 301746136 

Ответить

  Ответы Всего ответов: 20  

Номер ответа: 16
Автор ответа:
 ZagZag



ICQ: 295002202 

Вопросов: 87
Ответов: 1684
 Профиль | | #16 Добавлено: 23.05.07 12:22
ОК. Вечером вышлю. Часов в 18 (Moskow)

Ответить

Номер ответа: 17
Автор ответа:
 Леша



ICQ: 362231326 

Вопросов: 9
Ответов: 76
 Профиль | | #17 Добавлено: 24.05.07 12:49
а вот еще про gif
Создадим новый ехе-проект. Положим на него Text1 со свойством Multiline=True и кнопку Command1. К исходнику примера приложен файл GIF, который называется "untitled.gif" размером 14362 байта с графическим изображением 157 x 171 пиксель.Процедуру определения информации из GIF-файла пишем в командной кнопке.

Private Sub Command1_Click()
'Сначала объявим переменные
Dim FileName As String 'имя открываемого файла
Dim TypeOfFile As String 'тип файл (GIF)
Dim b As Byte
Dim RazmW As String 'ширина изображения
Dim RazmH As String 'высота изображения
Dim x As Long
'установим имя файла
FileName = App.Path & "\untitled.gif"
'и откроем его
Open FileName For Binary As #1
'Проверяем, GIF ли это,
' иначе считываемая информация будет неверна. Первые три байта должны
' содержать символы "GIF". Считываем эти 3 байта в переменную TypeOfFile.
TypeOfFile = String(3, " ";)
Get #1, , TypeOfFile
'Проверяем, эти cимволы GIF
If TypeOfFile = "GIF" Then
'если да, то выводим в Text1 соответствующий текст
Text1 = "GIF-файл" & vbCrLf
'к сожалению у меня нет информации, как считать размер файла, но это не важно
'можно прекрасно обойтись LOF
Text1 = Text1 & "Размер файла = " & LOF(1) & " bytes" & vbCrLf
'Далее считываем в переменную сначала 8-й, а затем 7-й байты. Десятичное содержимое
' каждого байта (переменной b) переводим в шестнадцатиричное, сохраняя первые нули
' 8 байт=0=00, 7 байт=157=9D, получаем "00" & "9D" ="009D" - это и есть ширина
For x = 8 To 7 Step -1
Get #1, x, b
RazmW = RazmW & String((Len(Hex(b)) - 2) * -1, 0) & Hex(b)
Next x
'выводим ширину в Text1, преобразуя в десятичное число с помощью функции ConvertDec,
' находящейся в модуле (подробно о ней читай в статье "...Перевод из шестнадцатеричной
' системы счисления в десятичную"
Text1 = Text1 & "Ширина изображения = " & ConvertDec(RazmW) & " pixels" & vbCrLf
'аналогично поступаем с высотой
For x = 10 To 9 Step -1
Get #1, x, b
RazmH = RazmH & String((Len(Hex(b)) - 2) * -1, 0) & Hex(b)
Next x
Text1 = Text1 & "Высота изображения = " & ConvertDec(RazmH) & " pixels" & vbCrLf
Else
' если файл начинается не с символов GIF выводим соответствующий текст
Text1 = "Это не GIF-файл"
End If
Close
End Sub

Ответить

Номер ответа: 18
Автор ответа:
 Леша



ICQ: 362231326 

Вопросов: 9
Ответов: 76
 Профиль | | #18 Добавлено: 24.05.07 12:51
и про jpeg
Напишем пример простого просмоторщика файлов JPG, который будет загружать картинки в Image1, изменяя размер последнего пропорционально размеру изображения, считанному из файла .jpg.
Установим свойство нашей формы ScaleMode=3 Pixels. Разместим на форме Image1 со свойством Stretch=True. Так же нам понадобятся элементы Drive1, Dir1 и File1 для файла JPG. Размер картинки будем выводить в Label1. Когда все это положим на форму, объявим переменные:

Option Explicit
Dim PathSearch As String 'для определения файла JPG
Dim DiskName As String
Dim b1 As Byte 'для считывания байта
Dim b2 As Byte 'для считывания байта
Dim FileName As String 'имя JPG-файла
Dim IdentFile As String 'вспомог переменная для считывания нескольких байтов
Dim NomerBaita As Long 'Байт, с которого начинаем сканирование
Dim FileW As Long 'ширина изображения
Dim FileH As Long 'высота изображения
Dim x As Long 'переменная для цикла
Dim Kvadrat As Long 'размер Image1 (квадрат)

Затем пишем процедуры Form_Load, Dir1_Change и Drive1_Change. О работе этих процедур подробно написано в части 1 главе 6 самоучителя.

Private Sub Form_Load()
PathSearch = App.Path
Drive1.Drive = PathSearch
Dir1.Path = PathSearch
File1.FileName = PathSearch
Kvadrat = 300
End Sub

Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub

Private Sub Drive1_Change()
DiskName = Drive1.Drive
Dir1.Path = DiskName & "\"
File1.Path = Dir1.Path
End Sub
А вот теперь в процедуре File1_Click (чтобы файл открывался при щелчке по файлу) начнем ваять собственно наш код для чтения JPG-файла:

Private Sub File1_Click()
Dim FlagAPP As Boolean 'флаг присутствия сначала маркера APP*, а потом SOF
Dim FlagSOF As Boolean 'флаг начала кадра
Dim StartByte As Long ' начальный байт работы
Dim DlinaAPP0 As Long 'длина APP*
Dim JFIF As Integer 'количества совпадающих признаков JFIF

If Right(File1.Path, 1) = "\" Then
FileName = File1.Path & File1.FileName
Else
FileName = File1.Path & "\" & File1.FileName
End If

'открываем файл
Open FileName For Binary As #1
'проверяем, нормальный ли это вообще файл
If LOF(1) < 2 Then
Label1 = "Файл испорчен"
Image1.Picture = LoadPicture()
Close
Exit Sub 'если длина файла меньше 2 байт выходим из процедуры
End If
'проверяем наличие EOI в конце файла
Get #1, LOF(1) - 1, b1
Get #1, LOF(1), b2
If b1 = &HFF And b2 = &HD9 Then JFIF = JFIF + 1 'если имеется, увеличиваем количество признаков на 1
'проверяем наличие SOI в начале файла
Get #1, 1, b1
Get #1, , b2
If b1 = &HFF And b2 = &HD8 Then JFIF = JFIF + 1
'проверяем наличие кого-нибудь APP?
Get #1, , b1
Get #1, , b2
For x = 0 To 14
If Hex(b1) & Hex(b2) = "FFE" & Hex(x) Then JFIF = JFIF + 1
Next x
'считываем 4 байта идентификатора в IdentFile и последний ноль в b1
IdentFile = String(4, " ";)
Get #1, 7, IdentFile
Get #1, , b1
'проверяем идентификатор на последние три символа IF0
If UCase(Right(IdentFile, 2)) & Right(Str(b1), 1) = "IF0" Then JFIF = JFIF + 1
'проверяем идентификатор на первые два символа JF и ноль в конце
If UCase(Left(IdentFile, 2)) & Right(Str(b1), 1) = "JF0" Then JFIF = JFIF + 1
'Проверяем, есть ли хотя бы три признака JFIF
If JFIF < 3 Then
Close
Label1 = "Не JPG-файл"
Image1.Picture = LoadPicture()
Exit Sub
End If

'Устанавливаем начальный байт нахождения первого APP?
StartByte = 3
'забабахиваем цикл поиска всех APP?
Do While Not EOF(1) '*********************************
'считываем байты
Seek #1, StartByte
Get #1, , b1
Get #1, , b2
'ищем маркер APP*
For x = 0 To 14
If Hex(b1) & Hex(b2) = "FFE" & Hex(x) Then
FlagAPP = True
Exit For 'выходим из цикла For...Next при первом совпадении
End If
Next x
If FlagAPP = False Then 'если не найден, выходим из цикла Do...Loop
Exit Do
End If

'Узнаем длину APP*
Get #1, StartByte + 2, b1
Get #1, StartByte + 3, b2
'используем функцию ConvertDec из модуля, чтобы получить данные о длине сегмента APP?
DlinaAPP0 = ConvertDec(String((Len(Hex(b1)) - 2) * -1, 0) & Hex(b1) & String((Len(Hex(b2)) - 2) * -1, 0) & Hex(b2))
FlagAPP = False
StartByte = DlinaAPP0 + Seek(1) - 2
Loop '*********************************************
'начинаем поиск SOF с байта номер StartByte
Seek #1, StartByte
'организаем цикл, который ищет SOF (FF C?) после последнего APP?
Do While Not FlagAPP
Get #1, , b1
If b1 = &HFF Then
Get #1, , b1
DoEvents 'на всякий случай даем возможность обрабатывать прерывания
'для перебора C3...CF используем их десятичное представление
If b1 >= 192 And b1 <= 207 Then
NomerBaita = Seek(1) + 3
FlagAPP = True
End If
End If
Loop
'Если нужный cегмент SOF найден, переходим к процедуре Reading:
If NomerBaita > 0 Then Reading Else Close #1
Close #1
End Sub

Процедура Reading считывает байты высоты и ширины, так же, как это делалось в статьях про файлы BMP и GIF, единственное отличие только в том, что порядок считывания байтов прямой, как они идут, так и читаем. После с помощью функции ConvertDec, которая должна быть у нас в модуле получаем размеры картинки в десятичной системе, меняем размер Image1 и загружаем картинку:

Private Sub Reading()
Dim RazmH As String
Dim RazmW As String
Get #1, NomerBaita, b1
Get #1, , b2
RazmH = String((Len(Hex(b1)) - 2) * -1, 0) & Hex(b1) & String((Len(Hex(b2)) - 2) * -1, 0) & Hex(b2)
Get #1, , b1
Get #1, , b2
RazmW = String((Len(Hex(b1)) - 2) * -1, 0) & Hex(b1) & String((Len(Hex(b2)) - 2) * -1, 0) & Hex(b2)
FileW = ConvertDec(RazmW)
FileH = ConvertDec(RazmH)
Label1 = "Файл JPG " & FileW & " x " & FileH & " пикселов"

Image1.Picture = LoadPicture()
If FileW >= FileH Then
Image1.Width = Kvadrat
Image1.Height = FileH / (FileW / Kvadrat)
ElseIf FileW < FileH Then
Image1.Width = FileW / (FileH / Kvadrat)
Image1.Height = Kvadrat
End If
Image1.Picture = LoadPicture(FileName)
End Sub

Ответить

Номер ответа: 19
Автор ответа:
 Леша



ICQ: 362231326 

Вопросов: 9
Ответов: 76
 Профиль | | #19 Добавлено: 24.05.07 12:52
а вообще посмотрите ссылки в ответе 2 - там все очень неплохо расписано про gif и jpeg

Ответить

Номер ответа: 20
Автор ответа:
 Леша



ICQ: 362231326 

Вопросов: 9
Ответов: 76
 Профиль | | #20 Добавлено: 24.05.07 13:14
Содержимое модуля может выглядеть приблизительно так:

Option Explicit
'Объявим функцию, где в heximal мы будем передавать наше шестнадцатеричное число
Function ConvertDec(heximal) As Long
'объявим две переменные
'одну для шестнадцатеричной цифры числа
Dim Simvol As String
'вторую для соответствующей ему десятичной цифры
Dim DesChislo As Long
'а так же переменную для цикла
Dim x As Long
'обнулим
ConvertDec = 0
'переберем все цифры шестнадцатеричного числа
'и каждой поставим в соотвествие десятичную
For x = 1 To Len(heximal)
Simvol = Mid(heximal, x, 1)
If UCase(Simvol) = "A" Then
DesChislo = 10
ElseIf UCase(Simvol) = "B" Then
DesChislo = 11
ElseIf UCase(Simvol) = "C" Then
DesChislo = 12
ElseIf UCase(Simvol) = ";D" Then
DesChislo = 13
ElseIf UCase(Simvol) = "E" Then
DesChislo = 14
ElseIf UCase(Simvol) = "F" Then
DesChislo = 15
Else
DesChislo = Val(Simvol)
End If
'накапливаем в нашей функции результат
ConvertDec = ConvertDec + DesChislo * 16 ^ (Len(heximal) - x)
Next x
'вот и все
End Function

Ответить

Страница: 1 | 2 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам