Напишем пример простого просмоторщика файлов 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