Конвертер TIFF(BMP...)->SFF самому написать реально? Вопрос скорее к Бенедикту. / Visual Basic

Мобильная версия Контакт Правила FAQ Помощь

Гость

Войти | Регистрация | Профиль | Очистить

Форумы | Пользователи | Статистика | Мод. лог | Поиск

Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр

Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Конвертер TIFF(BMP...)->SFF самому написать реально? Вопрос скорее к Бенедикту.

25 сообщений из 54, страница 1 из 3

все

Конвертер TIFF(BMP...)->SFF самому написать реально? Вопрос скорее к Бенедикту.

#37834742

Дмитрий77

Участник

Сообщения: 4 490

Рейтинг: 0 / 0

SFF (Structured Fax File) is a representation especially for Group 3 fax documents.
Формат описан в спецификации CAPI 2.0
http://www.capi.org/download/capi20-1.pdf

Задача: из многостраничного TIFF, да хоть бы из нескольких bitmap сделать SFF.
Как кодировать заголовок файла и заголовки страниц, думаю проблем не возникнет.
Некоторые наработки по данному формату есть, т.е. структуру немного представляю:
Как заполнить структуру по одному байту?

Вопрос как записать данные изображения.
CAPI 2.0 SFFB.2.3 Page Data
Page data is coded line by line: data describes each pixel row. Lines are coded as records
of variable length; each line is coded according to the element coding in the
page header. At present, only modified Huffman coding is supported. MH coding is
bit-oriented: the pixel bits are stored in the bits of code words, least significant first.
No EOL code words or fill bits are included. If the data includes EOL code words,
COMMON-ISDN-API ignores these.
Each record is identified by the first byte:
• 1...216: a pixel row with 1...216 MH-coded bytes follows immediately
• 0: escape code for a pixel row with more than 216 MH-coded bytes. In this case, the following
word in the range 217...32767 defines the number of MH-coded bytes which follow.
Annex B (Normative): SFF Format 155
• 217...253: white space, skip 1...37 empty lines
• 254: start of page header (see above)
• 255: if followed by a byte with value 0, illegal line coding. Applications may choose whether
to interpret this line as empty or as a copy of the previous line. If this byte is followed by a byte
with a value 1...255, then 1...255 bytes of additional user information follow (reserved for future
extensions).
Все что я понял, это то что используется "modified huffman".
Т.е. по логике взять картинку, представить ее через bitmap или нечто подобное через GDI(+/-) как обычно делали. Потом этот bitmap закодировать в "modified huffman" и записать в файл (где идут данные страницы). Ну понятно ручками по байту, винды и GDI таких фильтров не предоставляют.
Нужны примеры.

Готовых утилит практически нет. Только лишь Ghostscript (device "cfax")-это работает, но конвертирует только из pdf (с ps у меня не получилось). pdf из tiff сделать не проблема конечно (libtiff делает). Но это как лететь из Москвы в Питер через Нью-йорк.

Наработки по данному формату есть в проекте
http://sourceforge.net/projects/sfftools/
откуда собственно взял анализ структуры SFF (ссылка на CИ-шный форум выше),
но проект умеет sff -> tiff (bmp и т.д.) а не наоборот.
Мне надо в обе стороны. Ghostscript (device "cfax")-это кстати патч от автора sfftools но других вариантов не предлагается.

Или дохлая идея написать это самому? По сути вопрос: как закодировать изображение в "modified huffman"?

...

Рейтинг:

0 / 0

11.06.2012, 21:42

| Ответить | Цитировать | Написать

Конвертер TIFF(BMP...)->SFF самому написать реально? Вопрос скорее к Бенедикту.

#37834842

White Owl

Участник

Сообщения: 12 726

Рейтинг: 0 / 0

Дмитрий77Или дохлая идея написать это самому? По сути вопрос: как закодировать изображение в "modified huffman"?
Из приведенного отрывка не совсем понятно что они имеют в виду под "modified Huffman" Вернее не совсем понятно что именно они кодируют.
В стандартном Хаффмане делается подсчет количества букв в тексте, А - 10 раз, Б - 30 раз, В -2 раза и так далее. Потом на основе этих количеств строят дерево. (Загляни в Википедию там хорошее объяснение как это делается). И на основе дерева каждому символу задается код. В итоге частые буквы кодируются меньшим количеством бит чем стандартные восемь, редкие могут кодироваться и большим количеством бит.
А вот что в SFF используется в качестве "букв" я не понимаю.

...

Рейтинг:

0 / 0

12.06.2012, 00:14

| Ответить | Цитировать | Написать

Конвертер TIFF(BMP...)->SFF самому написать реально? Вопрос скорее к Бенедикту.

#37834910

Дмитрий77

Участник

Сообщения: 4 490

Рейтинг: 0 / 0

White Owl,

Ну, делать все самому с нуля, это вообще темный лес. Но кодов я тоже нигде не вижу.
GDI (+/-) позволяет делать следующие TIFF:

Код: vbnet

1.
2.
3.
4.
5.
6.
7.

Public Enum TifCompressionType
    TiffCompressionLZW = 2
    TiffCompressionCCITT3 = 3
    TiffCompressionCCITT4 = 4
    TiffCompressionRle = 5
    TiffCompressionNone = 6
End Enum

Если предположить (в чем я не уверен, но есть основания предполагать что это так), что
TiffCompressionRle = 5
это и есть modified Huffman, то по идее достаточно сохранить TIFF в этом формате виндами (что я умею),
а затем подменить заголовки TIFF на заголовки на заголовки SFF (осталось изучить структуру TIFF).
А данные страниц использовать те же.
Как идея?

Пока сделал

TIFF -> (libtiff) ->PDF -> (Ghostscript) -> SFF

Не знаю, на конвертацию нескольких страниц секунды 2 уходит.

SFF используется для передачи факса через CAPI 2.0 (файл тупо передается байт за байтом). Других форматов CAPI не кушает (по спецификации якобы кушает, но на деле только SFF - авторы CAPI драйверов этим не заморачиваются). Прога работает с TIFF , не городить же зоопарк (если не CAPI, то TIFF - родной формат).
Если мое предположение про TiffCompressionRle верно, то высшим пилотажем было бы перекодирование TIFF в SFF на лету , т.е. без конвертации в физический SFF, а просто подменой заголовков в процессе передачи данных (ну и при приеме при записи в файл).

...

Рейтинг:

0 / 0

12.06.2012, 03:21

| Ответить | Цитировать | Написать

Конвертер TIFF(BMP...)->SFF самому написать реально? Вопрос скорее к Бенедикту.

#37834912

White Owl

Участник

Сообщения: 12 726

Рейтинг: 0 / 0

Дмитрий77Как идея?Ужасно.
RLE - Run-Length Encoding.
Совершенно другой принцип.

Дмитрий77Пока сделал
TIFF -> (libtiff) ->PDF -> (Ghostscript) -> SFF
Не знаю, на конвертацию нескольких страниц секунды 2 уходит.В принципе жить можно, если тебя устраивает.

Дмитрий77 высшим пилотажем было бы перекодирование TIFF в SFF на лету , т.е. без конвертации в физический SFF, а просто подменой заголовков в процессе передачи данных (ну и при приеме при записи в файл).Это можно сделать. Затягиваешь весь TIFF в память, разворачиваешь его в битмап, сочиняешь новый заголовок, кодируешь битмап. И обратно в таком же порядке. От промежуточного битмапа не уйти, а будешь ты его держать целиком в памяти или скидывать во временный файл уже не так важно.

...

Рейтинг:

0 / 0

12.06.2012, 03:39

| Ответить | Цитировать | Написать

Конвертер TIFF(BMP...)->SFF самому написать реально? Вопрос скорее к Бенедикту.

#37834915

Дмитрий77

Участник

Сообщения: 4 490

Рейтинг: 0 / 0

White OwlRLE - Run-Length Encoding.
Совершенно другой принцип.
Понимание принципов виндами, libtiff, Ghostscript-ом, вентафаксом, Kodac Imaging (список можно продолжить)
сильно отличаются друг от друга. Все эти тифы более-менее уживаются друг с другом когда речь идет о тифе.

Что до SFF, в SFF-вьюерах как правило есть опция TIFF, но открывают они TIFF-ы только определенного формата, который они окрестили Modified Huffman.
Мне такой волшебный TIFF родить пока не удалось ни одним из известных мне способов. Например в Kodac Imagine создаешь тифф CCITT Group 3(1d) Modified Huffman (там так написано), SFF -viewer ругается.
Готовишь TIFF принтером от CAPI-fax, SFF -viewer радуется и показывает, открываешь его в Kodac Imagine, пишет CCITT Group 3(1d) Fax, пересохраняешь в том же формате (CCITT Group 3(1d) Fax) через Kodac Imagine, SFF -viewer ругается.

White OwlДмитрий77Пока сделал
TIFF -> (libtiff) ->PDF -> (Ghostscript) -> SFF
Не знаю, на конвертацию нескольких страниц секунды 2 уходит.В принципе жить можно, если тебя устраивает.
А у меня других вариантов нет пока.
(принтеры из коммерческих специфических софтов не рассматриваю, хотя любую быструю command prompt utility спер бы оттуда с удовольствием, а вот нет).

White OwlОт промежуточного битмапа не уйти, а будешь ты его держать целиком в памяти или скидывать во временный файл уже не так важно.
Ну, если TIFF в "волшебном" формате Modified Huffman, то можно и не держать целиком. Только этот Tiff сделать похоже также сложно как и SFF.

...

Рейтинг:

0 / 0

12.06.2012, 04:31

| Ответить | Цитировать | Написать

Конвертер TIFF(BMP...)->SFF самому написать реально? Вопрос скорее к Бенедикту.

#37834918

Edd.Dragon

Участник

Откуда: Украина

Сообщения: 6 433

Рейтинг: 0 / 0

авторКонвертер TIFF(BMP...)->SFF самому написать реально?
Нереального в этом ничего нет - его придумывали живые люди и реализовывали тоже живые и обычные. И в документе вам описали АЛГОРИТМ. Просто берите и реализовывайте его. Что не понятно - берете простенький рисунок и анализируете как он сохранился в этом формате.

...

Рейтинг:

0 / 0

12.06.2012, 05:44

| Ответить | Цитировать | Написать

Конвертер TIFF(BMP...)->SFF самому написать реально? Вопрос скорее к Бенедикту.

#37834919

Edd.Dragon

Участник

Откуда: Украина

Сообщения: 6 433

Рейтинг: 0 / 0

Я вам даже мог бы за деньги таких конвертеров, хоть на C++, хоть на PHP даже. Но только не на бейсике =)))

...

Рейтинг:

0 / 0

12.06.2012, 05:46

| Ответить | Цитировать | Написать

Конвертер TIFF(BMP...)->SFF самому написать реально? Вопрос скорее к Бенедикту.

#37834922

AndreTM

Участник

Откуда: Где-то в вологодских лесах...

Сообщения: 6 316

Рейтинг: 0 / 0

На Java, например: :)
http://thorntonzone.com/manuals/Compression/Fax,%20IBM%20MMR/MMSC/mmsc/index.html
http://thorntonzone.com/manuals/Compression/Fax,%20IBM%20MMR/MMSC/mmsc/uk/co/mmscomputing/imageio/tiff/index.html
http://thorntonzone.com/manuals/Compression/Fax,%20IBM%20MMR/MMSC/mmsc/uk/co/mmscomputing/imageio/sff/index.html

...

Рейтинг:

0 / 0

12.06.2012, 05:52

| Ответить | Цитировать | Написать

Конвертер TIFF(BMP...)->SFF самому написать реально? Вопрос скорее к Бенедикту.

#37834928

Дмитрий77

Участник

Сообщения: 4 490

Рейтинг: 0 / 0

AndreTM,

Ну, третья ссылка (нижняя) вроде по теме.

Дошел до этого файла:
http://thorntonzone.com/manuals/Compression/Fax,%20IBM%20MMR/MMSC/mmsc/uk/co/mmscomputing/io/ModHuffmanOutputStream.java

Но, честно, ява, немного пугает.
Было бы на C++ хотя б законченный проект, чтоб можно было скомпилировать и пощупать (типа SFF Tools), я б разобрался м.б.

Edd.DragonНо только не на бейсике =)))
Если "конвертация из tiff на ходу" (через структуры и байтики) , то C++. Если чисто конвертер, то VB для меня оптимален, хотя бы битмапы получать через GDI +/-.

И будут ли эти алгоритмы работать быстрее GS (pdf из tiff через libtiff мгновенно делается, GS работает значительно дольше), даже если убить кучу времени?

...

Рейтинг:

0 / 0

12.06.2012, 06:51

| Ответить | Цитировать | Написать

Конвертер TIFF(BMP...)->SFF самому написать реально? Вопрос скорее к Бенедикту.

#37834941

Edd.Dragon

Участник

Откуда: Украина

Сообщения: 6 433

Рейтинг: 0 / 0

авторpdf из tiff через libtiff мгновенно делаетс
А это потому, что там фактически ничего не делается. Берем тифы и как есть пихаем в контейнер формата pdf. Это как "архивирование" без сжатия ))

А на счет бейсика, я не к тому, что медленно или не удобно, так сложилось, что я его стороной обходил и обхожу по привычке - привык к сиподобному синтаксису.

...

Рейтинг:

0 / 0

12.06.2012, 08:08

| Ответить | Цитировать | Написать

Конвертер TIFF(BMP...)->SFF самому написать реально? Вопрос скорее к Бенедикту.

#37835223

Бенедикт

Участник

Сообщения: 2 108

Рейтинг: 0 / 0

Дмитрий77,

ничего оригинального не скажу. Если есть описание, всё можно сделать. Разница в синтаксисах языков здесь несущественна. В спецификации не указан алгоритм Modified Huffman Coding, веротно, по причине "это обычный алгоритм". Но тут авторы неправы - если они претендуют на "well-established standard", то должны быть ссылки на другие документы, стандарты в частности. По кодировке - вот нагуглилось по быстрому (вероятно, в табл. 10.4 ошибка - длина последовательности 62 указана дважды, скорее всего, последняя строка в правой половине относится к длине 63). Наверное, оно, наверное, можно найти гораздо больше и с примерами реализации.

...

Рейтинг:

0 / 0

12.06.2012, 13:46

| Ответить | Цитировать | Написать

Конвертер TIFF(BMP...)->SFF самому написать реально? Вопрос скорее к Бенедикту.

#37835283

Дмитрий77

Участник

Сообщения: 4 490

Рейтинг: 0 / 0

Бенедикт,

спасибо что откликнулись.
Ну с Modified Huffman понятно надо разбираться.
Но надо от чего-то отталкиваться.
Я всеми этими GDI занимался крайний раз м.б. год назад.
Т.е. как мне получить "незакодированное сырье", кот. я собираюсь кодировать?

Взял я CMultiFrameImage, загрузил туда документ TIFF, каждый фрейм -одна страница.

Характеристики того что должно быть на выходе:
resolution=203х196 либо resolution=203х98 (не знаю почему в SFF 203x а не 204x, на входе будет TIFF с 204x).
Ширина должна быть 1728, TIFF в 204х98 сплющен в двое по вертикали.

Так понимаю, надо сначала отформатировать frame1 (?)
Потом как-то его прочесть (?)
кодировать уже потом...

Т.е. вопрос как мне из frame1 получить "сырье" (тут подсказали уже что это bitmap - однозначно ч/б), и как мне его перевести в байты, кот. я потом буду перемешивать согласно Huffman. В понятиях могу тупить.

Т.е. я пока не врубился в задачу.
Заголовки для SFF я допустим напишу, зная характеристики "страничек", и т.п разрешение, высоту-ширину, число фреймов...

...

Рейтинг:

0 / 0

12.06.2012, 14:58

| Ответить | Цитировать | Написать

Конвертер TIFF(BMP...)->SFF самому написать реально? Вопрос скорее к Бенедикту.

#37835455

Бенедикт

Участник

Сообщения: 2 108

Рейтинг: 0 / 0

Дмитрий77,

здесь две подзадачи: 1) как получить адрес тела битмапа или его части (причём, в нужном формате); 2) как получить доступ в удобном виде к области памяти, адрес (начала) которой известен (в си-подобных языках это просто, да и в некоторых диалектах basic-а, но в VB удобный и быстрый способ - отдельная проблемка).

1) В GDI+:
для этого есть пара функций GdipBitmapLockBits()/GdipBitmapUnlockBits() .

В GDI:
имея HBITMAP, проще всего вызвать функцию GetObject() (которая системная, а не VBA-шная), передав ей структуру BITMAP (или DIBSECTION). Но в этом случае нет преобразования формата.

Применительно к CMultiFrameImage, можно взять для примера метод Frame1bpp(). Создаётся DIB-секция, адрес нулевой скан-линии монохромного битмапа возвращается в pBits, после Render имеем преобразованное к монохромному необходимое "сырьё". "Сырьё" лежит в виде несжатых скан-линий, для монохромного битмапа формат описан здесь .

2) Доступ к сырью удобно и быстро можно получить, если слегка обмануть VB и организовать safe array, который VB будет воспринимать как обычный двухмерный массив с элементами соответствующего типа (Byte, Integer, или Long; для монохромного битмапа актуальны скорее Integer или Byte). Пример для 32-битного цвета и, соответственно, пикселя, представленного как элемента двухмерного массива типа Long, можно посмотреть в 12429897 , класс CDrawingSurface, при #Const PRAGMA_SAFE = False, методы Init, Class_Terminate, свойства Pixel. Функцию VarPtrArray лучше описать как входящую в msvbvm60.dll (...VarPtrArray Lib "msvbvm60"...).

Осталось только правильно вычислять индексы элементов массива и выделять из них нужные биты ;) .

...

Рейтинг:

0 / 0

12.06.2012, 18:04

| Ответить | Цитировать | Написать

Конвертер TIFF(BMP...)->SFF самому написать реально? Вопрос скорее к Бенедикту.

#37835746

Дмитрий77

Участник

Сообщения: 4 490

Рейтинг: 0 / 0

Бенедикт,
Туплю, не могу уловить
Читал, читал часа 4

Ну, допустим,

Код: vbnet

1.
2.
3.
4.
5.
6.

Private Sub Command1_Click()
    Dim m_mfi As New CMultiFrameImage
    m_mfi.LoadFromFile "c:\111\test.tif"
    m_mfi.Frame1bpp
    Set Picture1.Picture = m_mfi.Zoom(, Picture1.ScaleWidth, 0)
End Sub

Код: vbnet

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.

Private Declare Function VarPtrArray Lib "msvbvm60" Alias "VarPtr" ( _
   Arr() As Any) As Long
Dim mas_byte(0 To 9) As Byte

Public Function Frame1bpp( _
...
 hbmDst = CreateDIBSection(0, bmiDst, DIB_RGB_COLORS, pBits, 0, 0)
 
 hdcDst = CreateCompatibleDC(0)
 hbmOldDst = SelectObject(hdcDst, hbmDst)
 
 Set picSrc = Frame(nFrame)
 picSrc.Render CLng(hdcDst), 0&, CLng(nSrcHeight * dHeightScale), _
               CLng(nSrcWidth), CLng(-nSrcHeight * dHeightScale), _
               0&, 0&, CLng(picSrc.Width), CLng(picSrc.Height), ByVal 0&
 MsgBox pBits
 CopyMemory ByVal VarPtrArray(mas_byte), pBits, 10
 Dim i As Integer
 For i = 0 To 9
    Debug.Print mas_byte(i)
 Next i
  
 Set picSrc = Nothing

picSrc.Render -ну вроде заполнил этот битмап с форматированием
pBits -выводит большое число, похожее на адрес с данными битмапа
читаю 10 байтов этих данных
выводит 10 нулей
Как быть, где данные, пытаюсь прочитать не 10 а 100 байтов (0 To 99) -уходит в crash, пытаюсь не задавать размерность массива - тоже уходит в crash.
Ничего не понимаю, что делать надо.

...

Рейтинг:

0 / 0

13.06.2012, 04:55

| Ответить | Цитировать | Написать

Конвертер TIFF(BMP...)->SFF самому написать реально? Вопрос скорее к Бенедикту.

#37836025

Бенедикт

Участник

Сообщения: 2 108

Рейтинг: 0 / 0

Дмитрий77,

для начала

Код: vbnet

CopyMemory mas_byte(0), ByVal pBits, 10

, если параметры CopyMemory описаны как As Any, As Any, ByVal As Long

...

Рейтинг:

0 / 0

13.06.2012, 11:21

| Ответить | Цитировать | Написать

Конвертер TIFF(BMP...)->SFF самому написать реально? Вопрос скорее к Бенедикту.

#37836171

Дмитрий77

Участник

Сообщения: 4 490

Рейтинг: 0 / 0

Бенедикт,

>, если параметры CopyMemory описаны как As Any, As Any, ByVal As Long
Так и есть

Код: vbnet

1.
2.
3.

Dim mas_byte(0 To 99) As Byte
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
   pvDest As Any, pvSource As Any, ByVal cBytes As Long)

Сделал так:

Код: vbnet

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.

 hbmDst = CreateDIBSection(0, bmiDst, DIB_RGB_COLORS, pBits, 0, 0)
 
 hdcDst = CreateCompatibleDC(0)
 hbmOldDst = SelectObject(hdcDst, hbmDst)
 
 Set picSrc = Frame(nFrame)
 picSrc.Render CLng(hdcDst), 0&, CLng(nSrcHeight * dHeightScale), _
               CLng(nSrcWidth), CLng(-nSrcHeight * dHeightScale), _
               0&, 0&, CLng(picSrc.Width), CLng(picSrc.Height), ByVal 0&
 MsgBox pBits
 CopyMemory mas_byte(0), pBits, 100
 Dim i As Integer
 Dim str As String
 str = ""
 For i = 0 To 99
    str = str & i & "=" & mas_byte(i) & " "
    If Len(str) > 100 Then
        Debug.Print str
        str = ""
    End If
 Next i
 Debug.Print str
 Set picSrc = Nothing

Чего-то появилось (надо думать данные битмапа):

Код: vbnet

1.
2.
3.
4.
5.
6.

0=0 1=0 2=193 3=3 4=40 5=0 6=0 7=0 8=192 9=6 10=0 11=0 12=35 13=9 14=0 15=0 16=1 17=0 18=1 19=0 20=0 
21=0 22=0 23=0 24=0 25=0 26=0 27=0 28=0 29=0 30=0 31=0 32=0 33=0 34=0 35=0 36=0 37=0 38=0 39=0 40=0 41=0 
42=0 43=0 44=0 45=0 46=0 47=0 48=255 49=255 50=255 51=0 52=35 53=9 54=0 55=0 56=192 57=6 58=0 59=0 60=0 
61=0 62=0 63=0 64=80 65=0 66=0 67=0 68=18 69=176 70=221 71=2 72=2 73=0 74=0 75=0 76=0 77=0 78=0 79=0 
80=0 81=0 82=0 83=0 84=28 85=0 86=0 87=0 88=221 89=246 90=255 91=255 92=255 93=255 94=255 95=255 96=0 
97=0 98=0 99=0

Дальше идей пока нет.
Так понимаю у меня по битмап есть еще bmiDst, кот. содержит BITMAPINFO, которое содержит bmiHeader
Как это увязать с BITMAP structure, ссылку на которую давали выше не понимаю.

Короче хочу получить "не знаю что" ("сырье" -видится мне как набор байтов) и преобразовать это "не зная как" (Modified Huffman) в "чего надо"-тоже видится мне как набор байтов.
А это "чего надо" запихать в файл по байтам (после местного SFF-заголовка страницы) и обозвать SFF-ом.

...

Рейтинг:

0 / 0

13.06.2012, 12:37

| Ответить | Цитировать | Написать

Конвертер TIFF(BMP...)->SFF самому написать реально? Вопрос скорее к Бенедикту.

#37836256

Бенедикт

Участник

Сообщения: 2 108

Рейтинг: 0 / 0

Дмитрий77,

да, это данные битмапа. Ссылку на структуру BITMAP я давал в первую очередь из-за секции Remarks в описании структуры, хотя и про саму BITMAP знать полезно. pBits указывает на начало 0-вой скан-линии (Scan 0). Скан-линии выравнены по границе 16-битного слова, имеют длину для монохромного битмапа (((ширина битмапа в пикселях) + 15) \ 16) байт (кстати, это значение будет в BITMAP.bmWidthBytes, если заполнить BITMAP вызовом GetObject()). Соответственно, полный размер данных монохромного битмапа в байтах равен (((ширина битмапа в пикселях) + 15) \ 16) * (высота битмапа в пикселях (=количество скан-линий)). Но это число имеет смысл если работать с данными битмапа как с одномерным массивом. Я предлагал не заниматься копированием и работать с данными битмапа как с двумерным массивом, но это, наверное, на текущий момент перебор.

Что дальше? +, -, *, \ для вычисления индекса элемента массива, в котором находится пиксель. And, степени двойки, операции сравнения для работы со значениями пикселей.

...

Рейтинг:

0 / 0

13.06.2012, 13:29

| Ответить | Цитировать | Написать

Конвертер TIFF(BMP...)->SFF самому написать реально? Вопрос скорее к Бенедикту.

#37837807

Дмитрий77

Участник

Сообщения: 4 490

Рейтинг: 0 / 0

Ну хорошо, например
(ширина битмапа в пикселях) x (высота битмапа в пикселях) = 1728x2339

>Соответственно, полный размер данных монохромного битмапа в байтах равен (((ширина битмапа в пикселях) + 15) \ 16) * (высота битмапа в пикселях (=количество скан-линий)).
Там целого числа не получается.
Откуда +15?
Правильно ли я понимаю, что незакодированное "сырье" это будет массив размером 1728x2339 (двумерный или одномерный),
состоящий из 0-лей (белый пиксель) и единиц (черный пиксель)?
Если да, то наверно должны быть примеры как это получить.
Видимо это то что вы описали ниже:
БенедиктЧто дальше? +, -, *, \ для вычисления индекса элемента массива, в котором находится пиксель. And, степени двойки, операции сравнения для работы со значениями пикселей.

...

Рейтинг:

0 / 0

14.06.2012, 13:38

| Ответить | Цитировать | Написать

Конвертер TIFF(BMP...)->SFF самому написать реально? Вопрос скорее к Бенедикту.

#37837906

Бенедикт

Участник

Сообщения: 2 108

Рейтинг: 0 / 0

Дмитрий77Там целого числа не получается."\" и "/" - разные операции.Дмитрий77Откуда +15?Выравнивание на границу 16 бит.Дмитрий77Правильно ли я понимаю, что незакодированное "сырье" это будет массив размером 1728x2339 (двумерный или одномерный), состоящий из 0-лей (белый пиксель) и единиц (черный пиксель)?Нет. И да, я неправильно написал, что размер скан-линии (и массива) в байтах. Правильно - в словах, т. е. в байтах в два раза больше. Итого: (1728 + 15) \ 16 = 108 слов = 216 байт = длина скан-линии. Размер массива 108 слов * 2339 = 252612 слов = 505224 байт.Дмитрий77Если да, то наверно должны быть примеры как это получить.Что получить? Ширину-высоту изображения мы знаем, формат пикселя (1 бит на пиксель, т. е. 8 пикселей в байте = 16 пикселей в слове) задаём сами.

...

Рейтинг:

0 / 0

14.06.2012, 14:16

| Ответить | Цитировать | Написать

Конвертер TIFF(BMP...)->SFF самому написать реально? Вопрос скорее к Бенедикту.

#37838181

Дмитрий77

Участник

Сообщения: 4 490

Рейтинг: 0 / 0

Бенедикт,
ладно я тупой но не настолько, видимо недавняя возня с C-шными кодами таки пошла на пользу.
Кажется что-то стало связываться.

Код: 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.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.

Dim mas_scanline_bytes() As Byte

Public Function Frame1bpp( _
...
 hbmDst = CreateDIBSection(0, bmiDst, DIB_RGB_COLORS, pBits, 0, 0)
 
 hdcDst = CreateCompatibleDC(0)
 hbmOldDst = SelectObject(hdcDst, hbmDst)
 
 Set picSrc = Frame(nFrame)
 picSrc.Render CLng(hdcDst), 0&, CLng(nSrcHeight * dHeightScale), _
               CLng(nSrcWidth), CLng(-nSrcHeight * dHeightScale), _
               0&, 0&, CLng(picSrc.Width), CLng(picSrc.Height), ByVal 0&
 Debug.Print "pBits=" & pBits
 Dim ScanLine_lenth As Long
 ScanLine_lenth = ((bmiDst.bmiHeader.biWidth + 15) \ 16) * 2
 Debug.Print "ScanLine_lenth=" & ScanLine_lenth
 ReDim mas_scanline_bytes(0 To ScanLine_lenth - 1)
 
 Dim h As Long
 Dim i As Long
 Dim j As Long
 Dim str As String
 
 For h = 0 To 1 'bmiDst.bmiHeader.biHeight - 1 'цикл по числу скан-линий
    Debug.Print "ScanLine # " & h & ":"
    CopyMemory mas_scanline_bytes(0), pBits + h * ScanLine_lenth, ScanLine_lenth
    str = ""
    For i = 0 To ScanLine_lenth - 1 Step 2
        For j = 0 To 15
            If ((i * 16 + j + 1) <= bmiDst.bmiHeader.biWidth) Then ' интересует первые 1728 бит
                str = str & CStr(GetBitXY(mas_scanline_bytes(i), mas_scanline_bytes(i + 1), j))
            End If
        Next j
        If Len(str) > 100 Then 'просто печатаем биты
            Debug.Print str
            str = ""
        End If
    Next i
    Debug.Print str 'last block of bits
 Next h
 
 Set picSrc = Nothing


Public Function GetBitXY(X As Byte, Y As Byte, Bit As Long) As Long
    'WORD - 2 байта x - первый байт (0-255) y - второй байт (0-255)
   Dim L As Long
   L = CLng(X) + CLng(Y) * 256
   GetBitXY = IIf(((L And 2 ^ Bit) > 0), 1, 0)
End Function

Ну например первые 2 сканлинии:

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.

1728x2339
pBits=60162048
ScanLine_lenth=216
ScanLine # 0:
0000000000000000011010011100000011110000000000001010000110000000100011100010100010000000000000000010010110101011
1101100000000000011000111010100010100000111101010000000000000000011010011100000000010100000000000000000000000000
0000001101100000000000000000000011000100100100000000000000000000100000000000000010000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001111111111111111
1111111100000000110001001001000000000000000000000000001101100000000000000000000000000000000000000000000000000000
0000101000000000000000000000000001010011111011111011101101000000010000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000111000000000000000000000000000
ScanLine # 1:
0001101100000000011010011100000011110000000000001010000110000000100011100010100010000000000000000010010110101011
1101100000000000011000111010100010100000111101010000000000000000011010011100000000010100000000000000000000000000
0000001101100000000000000000000011000100100100000000000000000000100000000000000010000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001111111111111111
1111111100000000110001001001000000000000000000000000001101100000000000000000000000000000000000000000000000000000
0000101000000000000000000000000001010011111011111011101101000000010000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000111000000000000000000000000000

М-м-м... Ну во-первых мне кажется, у меня где-то ошибка при заполнении/перезаполнении байтового массива сканлинии, уж больно одинаково они выглядят, я смотрел например 8-ю и 9-ю линии через paint по клеточкам, должны быть разные, у меня одинаковые. Вот что не так, может ReDim каждый раз делать надо? Или адрес откуда читаю в CopyMemory не так ставлю?

Далее думаю, мне надо вот это:
Each record is identified by the first byte:
=216!!!(мой случай) • 1...216: a pixel row with 1...216 MH-coded bytes follows immediately
(если биты в сканлинии сплошь нули) • 217...253: white space, skip 1...37 empty lines

Ну, не знаю, надо ли в коде рассматривать случаи
(1-215)• 1...216: a pixel row with 1...216 MH-coded bytes follows immediately
• 0: escape code for a pixel row with more than 216 MH-coded bytes. In this case, the following
word in the range 217...32767 defines the number of MH-coded bytes which follow.

Просто на входе всегда tiff отформатированный под ширину 1728 (=216 байт как уже понятно стало)

Т.е. каждую ScanLine надо мудифицировать по Modified Huffman, получить более короткий битовый массив, засунуть биты в байты, и эти байты бухать в файл (216)+чего получилось.
Либо (217...253) по числу белых сканлиний.

Смотрю в книгу:
http://www.iet.unipi.it/m.luise/HTML/SdT/10_4%20Modified%20Huffman%20Coding.htm
и пока вижу фигу.
Чего я должен там увидеть?

...

Рейтинг:

0 / 0

14.06.2012, 16:25

| Ответить | Цитировать | Написать

Конвертер TIFF(BMP...)->SFF самому написать реально? Вопрос скорее к Бенедикту.

#37838344

Бенедикт

Участник

Сообщения: 2 108

Рейтинг: 0 / 0

Дмитрий77,

до воскресенья активно помочь уже не смогу.

Что вижу сейчас - второй параметр CopyMemory не ByVal, количество выведенных 0/1 раза в два раза меньше чем 1728.

...

Рейтинг:

0 / 0

14.06.2012, 17:44

| Ответить | Цитировать | Написать

Конвертер TIFF(BMP...)->SFF самому написать реально? Вопрос скорее к Бенедикту.

#37838347

Бенедикт

Участник

Сообщения: 2 108

Рейтинг: 0 / 0

Дмитрий77,

увидеть - способ кодировки. Пример в конце страницы разобрали?

...

Рейтинг:

0 / 0

14.06.2012, 17:44

| Ответить | Цитировать | Написать

Конвертер TIFF(BMP...)->SFF самому написать реально? Вопрос скорее к Бенедикту.

#37838801

Дмитрий77

Участник

Сообщения: 4 490

Рейтинг: 0 / 0

Бенедиктколичество выведенных 0/1 раза в два раза меньше чем 1728.
Ну, это я формальную ошибку сделал, хоть и прыгаю через байт, но при этом каждое i дает таки 8 битов, а не 16:

Код: vbnet

1.
2.
3.
4.
5.
6.

    For i = 0 To ScanLine_lenth - 1 Step 2
        For j = 0 To 15
            If ((i * 8 + j + 1) <= bmiDst.bmiHeader.biWidth) Then ' интересует первые 1728 бит
                str = str & CStr(GetBitXY(mas_scanline_bytes(i), mas_scanline_bytes(i + 1), j))
            End If
        Next j

Бенедиктвторой параметр CopyMemory не ByVal,
если написать

Код: vbnet

    CopyMemory mas_scanline_bytes(0), ByVal (pBits + h * ScanLine_lenth), ScanLine_lenth

то выдаются одни единицы 111111111111111111111111111""
Если как я делаю

Код: vbnet

    CopyMemory mas_scanline_bytes(0), pBits + h * ScanLine_lenth, ScanLine_lenth

то выдаются "одинаковые" сканлинии.
(чуть чуть отличаются вначале)
с таким же успехом могу написать 0

Код: vbnet

    CopyMemory mas_scanline_bytes(0), 0, ScanLine_lenth

Вывод: что-то я не то получаю вместо данных битмапа .
Причем там слишком много единиц, а у меня на картинке около 7 верхних линий чисто белые - нули же должны быть тогда...?

...

Рейтинг:

0 / 0

15.06.2012, 03:50

| Ответить | Цитировать | Написать

Конвертер TIFF(BMP...)->SFF самому написать реально? Вопрос скорее к Бенедикту.

#37838882

Дмитрий77

Участник

Сообщения: 4 490

Рейтинг: 0 / 0

Короче, пока так:
Я нашел следующий код:
True Colour DIBSection

Там как раз описывается метод, предложенный Бенедиктом: VarPtrArray на двухмерный массив:
У меня "заработал" следующий (буквально) код:

Код: vbnet

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
   pvDest As Any, pvSource As Any, ByVal cBytes As Long)
   
Private Type SAFEARRAYBOUND
    cElements As Long
    lLbound As Long
End Type
Private Type SAFEARRAY2D
    cDims As Integer
    fFeatures As Integer
    cbElements As Long
    cLocks As Long
    pvData As Long
    Bounds(0 To 1) As SAFEARRAYBOUND
End Type
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Ptr() As Any) As Long
...

Public Function Frame1bpp( _
   Optional ByVal nFrame As Long = 0, _
   Optional ByVal nXPelsPerMeter As Long = 0, _
   Optional ByVal nYPelsPerMeter As Long = 0, _
   Optional ByVal dHeightScale As Double = 1) As IPictureDisp
 Dim nSrcWidth As Long
 Dim nSrcHeight As Long
 Dim bmiDst As BITMAPINFO2
 Dim pBits As Long
 Dim hbmDst As Long
 Dim picSrc As IPictureDisp
 Dim hdcDst As Long
 Dim hbmOldDst As Long
 
 nSrcWidth = FrameWidth(nFrame)
 nSrcHeight = FrameHeight(nFrame)
 With bmiDst.bmiHeader
    .biSize = LenB(bmiDst.bmiHeader)
    .biWidth = nSrcWidth
    .biHeight = nSrcHeight * dHeightScale
    .biPlanes = 1
    .biBitCount = 1
    .biCompression = BI_RGB
    .biXPelsPerMeter = nXPelsPerMeter
    .biYPelsPerMeter = nYPelsPerMeter
 End With
 Debug.Print bmiDst.bmiHeader.biWidth & "x" & bmiDst.bmiHeader.biHeight
 With bmiDst.bmiColors(1)
    .rgbBlue = 255
    .rgbGreen = 255
    .rgbRed = 255
 End With
 hbmDst = CreateDIBSection(0, bmiDst, DIB_RGB_COLORS, pBits, 0, 0)
 
 hdcDst = CreateCompatibleDC(0)
 hbmOldDst = SelectObject(hdcDst, hbmDst)
 
 Set picSrc = Frame(nFrame)
 picSrc.Render CLng(hdcDst), 0&, CLng(nSrcHeight * dHeightScale), _
               CLng(nSrcWidth), CLng(-nSrcHeight * dHeightScale), _
               0&, 0&, CLng(picSrc.Width), CLng(picSrc.Height), ByVal 0&
               
 Set picSrc = Nothing
 SelectObject hdcDst, hbmOldDst: hbmOldDst = 0
 DeleteDC hdcDst: hdcDst = 0
 Set Frame1bpp = CreateIPictureDispFromHBITMAP(hbmDst)
             
               
 Debug.Print "pBits=" & pBits
 Dim ScanLine_lenth As Long
 ScanLine_lenth = ((bmiDst.bmiHeader.biWidth + 15) \ 16) * 2
 Debug.Print "ScanLine_lenth=" & ScanLine_lenth
 
 Dim tSA As SAFEARRAY2D
 Dim bDib() As Byte
 Dim X As Long, Y As Long
 Dim j As Long
 Dim str As String
    ' Get the bits in the from DIB section:
    With tSA
        .cbElements = 1
        .cDims = 2
        .Bounds(0).lLbound = 0
        .Bounds(0).cElements = bmiDst.bmiHeader.biHeight
        .Bounds(1).lLbound = 0
        .Bounds(1).cElements = ScanLine_lenth ' BytesPerScanLine()
        .pvData = pBits
    End With
    CopyMemory ByVal VarPtrArray(bDib()), VarPtr(tSA), 4

    For Y = bmiDst.bmiHeader.biHeight - 1 To 0 Step -1
    'Debug.Print "ScanLine # " & (bmiDst.bmiHeader.biHeight - 1) - Y & ":"
    str = ""
        For X = 0 To ScanLine_lenth - 1
            For j = 0 To 7
                If ((X * 8 + j + 1) <= bmiDst.bmiHeader.biWidth) Then ' интересует первые 1728 бит
                    str = str & CStr(GetBitXY(bDib(X, Y), 0, 7 - j))
                End If
            Next j
        Next X
        Debug.Print str 'last block of bits
    Next Y
    ' Clear the temporary array descriptor
    ' (This does not appear to be necessary, but
    ' for safety do it anyway)
    CopyMemory ByVal VarPtrArray(bDib), 0&, 4

End Function


Public Function GetBitXY(X As Byte, Y As Byte, Bit As Long) As Long
    'WORD - 2 байта x - первый байт (0-255) y - второй байт (0-255)
   Dim L As Long
   L = CLng(X) + CLng(Y) * 256
   GetBitXY = IIf(((L And 2 ^ Bit) > 0), 0, 1)
End Function

Я добивался получения такой "картинки" (слово "Fax" написанное черным по белому нарисовано "единицами"). Не видно?-отодвиньтесь на метр от экрана.
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000011111111111111110000000000000000000000000000000000000000
0000000011111111111111110000000000000000000000000000000000000000
0000000000011100000000010000000000000000000000000000000000000000
0000000000011100000000010000000000000000000000000000000000000000
0000000000011100000000000000000000000000000000000000000000000000
0000000000011100000000000000000000000000000000000000000000000000
0000000000011100000000000000000000000000000000000000000000000000
0000000000011100000000000000000000000000000000000000000000000000
0000000000011100000010000000011111111000111111001111111000000000
0000000000011100000010000000011111111000111111001111111000000000
0000000000011111111110000000111000011100001111001110000000000000
0000000000011111111110000000111000011100001111000110000000000000
0000000000011100000110000000000011111100000011101000000000000000
0000000000011100000110000000000011111100000011101000000000000000
0000000000011100000000000000011100011100000001111100000000000000
0000000000011100000000000000011100011100000001111100000000000000
0000000000011100000000000001110000011100000011011110000000000000
0000000000011100000000000001110000011100000011011110000000000000
0000000000011100000000000001110000011100000011011110000000000000
0000000000011100000000000001110001111100001100000111100000000000
0000000000011100000000000001110011111100001110000111100000000000
0000000011111111100000000000111110011110111110001111111000000000
0000000011111111100000000000111110011110111110001111111000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000

В принципе я мог бы обойтись и одномерным массивом в одну Scanline. Ну да ладно.

Для того чтоб нарисовать эту картинку мне понадобилось методом тыка сделать сдедующее:
1) поменять "1" и "0" местами, потому как белое рисовалось единицами, а не нулями.
Я сделал это через Public Function GetBitXY
2) читать сканлинии не от 0 до bmiDst.bmiHeader.biHeight - 1 (сверху вниз)
а снизу вверх:

Код: vbnet

    For Y = bmiDst.bmiHeader.biHeight - 1 To 0 Step -1

3) читать не слово Word (2 байта), а читать по одному байту
при этом переворачивая биты от 7 до 0 (в обратном порядке), а не от 0 до 7 как я делал.

Код: vbnet

1.
2.
3.
4.
5.
6.
7.
8.

        For X = 0 To ScanLine_lenth - 1
            For j = 0 To 7
                If ((X * 8 + j + 1) <= bmiDst.bmiHeader.biWidth) Then ' интересует первые 1728 бит
                    str = str & CStr(GetBitXY(bDib(X, Y), 0, 7 - j))
                End If
            Next j
        Next X
        Debug.Print str 'last block of bits

Вопросы делятся на две группы:
I: Правильно ли я понимаю что
1) битмап в памяти перевернут (читать надо снизу вверх)
2) следует читать по одному байту (а не по два), при этом биты там перевернуты (обратный порядок)
3) нули надо заменять на единицы.

Ну, могу допустить, что функция Frame1bpp предложенная Бенедиктом что-то сама переворачивает. Но это все эстетика, а понять сейчас нужно следующее:

II: Чего будет "сырьем" для Modified Huffman?
Сгодится ли то что я получил в качестве сырья.
1) белое - это нуль? Или нет?
2) Кодируем начиная с последней скан линии? Или нет?
3) Биты в каждом байте переворачиваем? Или нет?

Не, конечно можно методом тыка. Ну например если будет получаться негатив, то поменять 0 на 1, 1 на 0.
Ну лучше чтоб грамотные люди объяснили.

...

Рейтинг:

0 / 0

15.06.2012, 08:55

| Ответить | Цитировать | Написать

Конвертер TIFF(BMP...)->SFF самому написать реально? Вопрос скорее к Бенедикту.

#37842087

Дмитрий77

Участник

Сообщения: 4 490

Рейтинг: 0 / 0

Мне этот кодер написать почти удалось, но не могу сказать что очень рад.
Проблемы такие:
1) Медленно он работает ; GS быстрее (хоть и тоже медленно). Если быстрее не заработает, то эта возня на неделю не стоит свеч (ибо с GS я уже сделал).
Что можно оптимизировать?
Вкратце:
К данным битмап имею доступ через двухмерный массив bDib(), как советовал Бенедикт.

Код: vbnet

    CopyMemory ByVal VarPtrArray(bDib()), VarPtr(tSA), 4

(здесь вряд ли тормозит)
Далее (не считая частного случая белых линий) сканирую по одной ScanLine, считаю нули и единицы и кодирую их по MH тупо функциями

Код: vbnet

1.
2.

Private Function DoWhite(runlen As Long) As String
Private Function DoBlack(runlen As Long) As String

которые используют

Код: vbnet

1.
2.
3.
4.

Public Function termWhite(runlen As Long) As String
Public Function termBlack(runlen As Long) As String
Public Function makeUpWhite(makeup As Long) As String
Public Function makeUpBlack(makeup As Long) As String

где MH и зашит (значения брал из libtiff, в том документе что приводился много ошибок).
Получаю строку битов (нули и единицы), добавляю EOL
Ее тупо бью по 8 символов и превращаю в байты тупой ф-цией

Код: vbnet

Public Function generateByte(byteAsStr As String) As Long

При этом крайние несколько символов дописываю "нулями" до границы байта ( и здесь не уверен что делаю правильно!!! ).
Код привожу ниже целиком.

2) У меня где-то ошибка. Где понять не могу. Декодер (вьюер) заламывает некоторые строчки картинки.
Подозреваю что проблема связана с неправильным выравниванием по границе байта.
В CAPI документе сказано:
=CAPIMH coding is bit-oriented: the pixel bits are stored in the bits of code words, least significant first.
No EOL code words or fill bits are included. If the data includes EOL code words,
COMMON-ISDN-API ignores these.
В другом документе сказано, что якобы нули надо добавлять перед EOL (000000000001) чтоб добить доцелых байтов, пробовал и до и после, есть ряд строк, которые получаются битые (почему не знаю), и вьюером не отображаются.
Как правильно выровнять по границе байта?
Код модуля привожу (основная ф-ция Public Sub CreateSFFFile())

Код: 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.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
215.
216.
217.
218.
219.
220.
221.
222.
223.
224.
225.
226.
227.
228.
229.
230.
231.
232.
233.
234.
235.
236.
237.
238.
239.
240.
241.
242.
243.
244.
245.
246.
247.
248.
249.
250.
251.
252.
253.
254.
255.
256.
257.
258.
259.
260.
261.
262.
263.
264.
265.
266.
267.
268.
269.
270.
271.
272.
273.
274.
275.
276.
277.
278.
279.
280.
281.
282.
283.
284.
285.
286.
287.
288.
289.
290.
291.
292.
293.
294.
295.
296.
297.
298.
299.
300.
301.
302.
303.
304.
305.
306.
307.
308.
309.
310.
311.
312.
313.
314.
315.
316.
317.
318.
319.
320.
321.
322.
323.
324.
325.
326.
327.
328.
329.
330.
331.
332.
333.
334.
335.
336.
337.
338.
339.
340.
341.
342.
343.
344.
345.
346.
347.
348.
349.
350.
351.
352.
353.
354.
355.
356.
357.
358.
359.
360.
361.
362.
363.
364.
365.
366.
367.
368.
369.
370.
371.
372.
373.
374.
375.
376.
377.
378.
379.
380.
381.
382.
383.
384.
385.
386.
387.
388.
389.
390.
391.
392.
393.
394.
395.
396.
397.
398.
399.
400.
401.
402.
403.
404.
405.
406.
407.
408.
409.
410.
411.
412.
413.
414.
415.
416.
417.
418.
419.
420.
421.
422.
423.
424.
425.
426.
427.
428.
429.
430.
431.
432.
433.
434.
435.
436.
437.
438.
439.
440.
441.
442.
443.
444.
445.
446.
447.
448.
449.
450.
451.
452.
453.
454.
455.
456.
457.
458.
459.
460.
461.
462.
463.
464.
465.
466.
467.
468.
469.
470.
471.
472.
473.
474.
475.
476.
477.
478.
479.
480.
481.
482.
483.
484.
485.
486.
487.
488.
489.
490.
491.
492.
493.
494.
495.
496.
497.
498.
499.
500.
501.
502.
503.
504.
505.
506.
507.
508.
509.
510.
511.
512.
513.
514.
515.
516.
517.
518.
519.
520.
521.
522.
523.
524.
525.
526.
527.
528.
529.
530.
531.
532.
533.
534.
535.
536.
537.
538.
539.
540.
541.
542.
543.
544.
545.
546.
547.
548.
549.
550.
551.
552.
553.
554.
555.
556.
557.
558.
559.
560.
561.
562.
563.
564.
565.
566.
567.
568.
569.
570.
571.
572.
573.
574.
575.
576.
577.
578.
579.
580.
581.
582.
583.
584.
585.
586.
587.
588.
589.
590.
591.
592.
593.
594.
595.
596.
597.
598.
599.
600.
601.
602.
603.
604.
605.
606.
607.
608.
609.
610.
611.
612.
613.
614.
615.
616.
617.
618.
619.
620.
621.
622.
623.
624.
625.
626.
627.
628.
629.
630.
631.
632.
633.
634.
635.
636.
637.
638.
639.
640.
641.
642.
643.
644.
645.
646.
647.
648.
649.
650.
651.
652.
653.
654.
655.
656.
657.
658.
659.
660.
661.
662.
663.
664.
665.
666.
667.
668.
669.
670.
671.
672.
673.
674.
675.
676.
677.
678.
679.
680.
681.
682.
683.
684.
685.
686.
687.
688.
689.
690.
691.
692.
693.
694.
695.
696.
697.
698.
699.
700.
701.
702.
703.
704.
705.
706.
707.
708.
709.
710.
711.
712.
713.
714.
715.
716.
717.
718.
719.
720.
721.
722.
723.

Option Explicit

Public bDib() As Byte

Private Enum BITSTATE
   STATE_WHITE = 0
   STATE_BLACK = 1
End Enum


Public Function termWhite(runlen As Long) As String
    'terminating codes / White bits
    Select Case runlen:
        Case 0
            termWhite = "00110101"
        Case 1
            termWhite = "000111"
        Case 2
            termWhite = "0111"
        Case 3
            termWhite = "1000"
        Case 4
            termWhite = "1011"
        Case 5
            termWhite = "1100"
        Case 6
            termWhite = "1110"
        Case 7
            termWhite = "1111"
        Case 8
            termWhite = "10011"
        Case 9
            termWhite = "10100"
        Case 10
            termWhite = "00111"
        Case 11
            termWhite = "01000"
        Case 12
            termWhite = "001000"
        Case 13
            termWhite = "000011"
        Case 14
            termWhite = "110100"
        Case 15
            termWhite = "110101"
        Case 16
            termWhite = "101010"
        Case 17
            termWhite = "101011"
        Case 18
            termWhite = "0100111"
        Case 19
            termWhite = "0001100"
        Case 20
            termWhite = "0001000"
        Case 21
            termWhite = "0010111"
        Case 22
            termWhite = "0000011"
        Case 23
            termWhite = "0000100"
        Case 24
            termWhite = "0101000"
        Case 25
            termWhite = "0101011"
        Case 26
            termWhite = "0010011"
        Case 27
            termWhite = "0100100"
        Case 28
            termWhite = "0011000"
        Case 29
            termWhite = "00000010"
        Case 30
            termWhite = "00000011"
        Case 31
            termWhite = "00011010"
        Case 32
            termWhite = "00011011"
        Case 33
            termWhite = "00010010"
        Case 34
            termWhite = "00010011"
        Case 35
            termWhite = "00010100"
        Case 36
            termWhite = "00010101"
        Case 37
            termWhite = "00010110" '?
        Case 38
            termWhite = "00010111"
        Case 39
            termWhite = "00101000"
        Case 40
            termWhite = "00101001"
        Case 41
            termWhite = "00101010"
        Case 42
            termWhite = "00101011"
        Case 43
            termWhite = "00101100"
        Case 44
            termWhite = "00101101"
        Case 45
            termWhite = "00000100"
        Case 46
            termWhite = "00000101"
        Case 47
            termWhite = "00001010"
        Case 48
            termWhite = "00001011"
        Case 49
            termWhite = "01010010"
        Case 50
            termWhite = "01010011"
        Case 51
            termWhite = "01010100"
        Case 52
            termWhite = "01010101"
        Case 53
            termWhite = "00100100"
        Case 54
            termWhite = "00100101"
        Case 55
            termWhite = "01011000"
        Case 56
            termWhite = "01011001"
        Case 57
            termWhite = "01011010"
        Case 58
            termWhite = "01011011"
        Case 59
            termWhite = "01001010"
        Case 60
            termWhite = "01001011"
        Case 61
            termWhite = "00110010"
        Case 62
            termWhite = "00110011" '?
        Case 63
            termWhite = "00110100"
        Case Else
            termWhite = ""
    End Select
End Function

Public Function termBlack(runlen As Long) As String
    'terminating codes / Black bits
    Select Case runlen:
        Case 0
            termBlack = "0000110111"
        Case 1
            termBlack = "010"
        Case 2
            termBlack = "11"
        Case 3
            termBlack = "10"
        Case 4
            termBlack = "011"
        Case 5
            termBlack = "0011"
        Case 6
            termBlack = "0010"
        Case 7
            termBlack = "00011"
        Case 8
            termBlack = "000101"
        Case 9
            termBlack = "000100"
        Case 10
            termBlack = "0000100"
        Case 11
            termBlack = "0000101"
        Case 12
            termBlack = "0000111"
        Case 13
            termBlack = "00000100"
        Case 14
            termBlack = "00000111"
        Case 15
            termBlack = "000011000"
        Case 16
            termBlack = "0000010111"
        Case 17
            termBlack = "0000011000"
        Case 18
            termBlack = "0000001000"
        Case 19
            termBlack = "00001100111"
        Case 20
            termBlack = "00001101000"
        Case 21
            termBlack = "00001101100"
        Case 22
            termBlack = "00000110111"
        Case 23
            termBlack = "00000101000"
        Case 24
            termBlack = "00000010111"
        Case 25
            termBlack = "00000011000"
        Case 26
            termBlack = "000011001010"
        Case 27
            termBlack = "000011001011"
        Case 28
            termBlack = "000011001100"
        Case 29
            termBlack = "000011001101"
        Case 30
            termBlack = "000001101000"
        Case 31
            termBlack = "000001101001"
        Case 32
            termBlack = "000001101010"
        Case 33
            termBlack = "000001101011"
        Case 34
            termBlack = "000011010010"
        Case 35
            termBlack = "000011010011"
        Case 36
            termBlack = "000011010100"
        Case 37
            termBlack = "000011010101"
        Case 38
            termBlack = "000011010110"
        Case 39
            termBlack = "000011010111"
        Case 40
            termBlack = "000001101100"
        Case 41
            termBlack = "000001101101"
        Case 42
            termBlack = "000011011010"
        Case 43
            termBlack = "000011011011"
        Case 44
            termBlack = "000001010100"
        Case 45
            termBlack = "000001010101"
        Case 46
            termBlack = "000001010110"
        Case 47
            termBlack = "000001010111"
        Case 48
            termBlack = "000001100100"
        Case 49
            termBlack = "000001100101"
        Case 50
            termBlack = "000001010010"
        Case 51
            termBlack = "000001010011"
        Case 52
            termBlack = "000000100100"
        Case 53
            termBlack = "000000110111"
        Case 54
            termBlack = "000000111000"
        Case 55
            termBlack = "000000100111"
        Case 56
            termBlack = "000000101000"
        Case 57
            termBlack = "000001011000"
        Case 58
            termBlack = "000001011001"
        Case 59
            termBlack = "000000101011"
        Case 60
            termBlack = "000000101100"
        Case 61
            termBlack = "000001011010"
        Case 62
            termBlack = "000001100110"
        Case 63
            termBlack = "000001100111"
        Case Else
            termBlack = ""
    End Select
End Function

Public Function makeUpWhite(makeup As Long) As String
    'Makeup code words / White bits
    Select Case makeup:
        Case 64
            makeUpWhite = "11011"
        Case 128
            makeUpWhite = "10010"
        Case 192
            makeUpWhite = "010111"
        Case 256
            makeUpWhite = "0110111"
        Case 320
            makeUpWhite = "00110110"
        Case 384
            makeUpWhite = "00110111"
        Case 448
            makeUpWhite = "01100100"
        Case 512
            makeUpWhite = "01100101"
        Case 576
            makeUpWhite = "01101000"
        Case 640
            makeUpWhite = "01100111"
        Case 704
            makeUpWhite = "011001100"
        Case 768
            makeUpWhite = "011001101"
        Case 832
            makeUpWhite = "011010010"
        Case 896
            makeUpWhite = "011010011" '?
        Case 960
            makeUpWhite = "011010100"
        Case 1024
            makeUpWhite = "011010101"
        Case 1088
            makeUpWhite = "011010110"
        Case 1152
            makeUpWhite = "011010111"
        Case 1216
            makeUpWhite = "011011000"
        Case 1280
            makeUpWhite = "011011001"
        Case 1344
            makeUpWhite = "011011010"
        Case 1408
            makeUpWhite = "011011011"
        Case 1472
            makeUpWhite = "010011000"
        Case 1536
            makeUpWhite = "010011001"
        Case 1600
            makeUpWhite = "010011010"
        Case 1664
            makeUpWhite = "011000"
        Case 1728
            makeUpWhite = "010011011"
        Case 1792
            makeUpWhite = "00000001000"
        Case 1856
            makeUpWhite = "00000001100"
        Case 1920
            makeUpWhite = "00000001101"
        Case 1984
            makeUpWhite = "000000010010"
        Case 2048
            makeUpWhite = "000000010011"
        Case 2112
            makeUpWhite = "000000010100"
        Case 2176
            makeUpWhite = "000000010101"
        Case 2240
            makeUpWhite = "000000010110"
        Case 2304
            makeUpWhite = "000000010111"
        Case 2368
            makeUpWhite = "000000011100"
        Case 2432
            makeUpWhite = "000000011101"
        Case 2496
            makeUpWhite = "000000011110"
        Case 2560
            makeUpWhite = "000000011111"
        Case Else
            makeUpWhite = ""
    End Select
End Function

Public Function makeUpBlack(makeup As Long) As String
    'Makeup code words / Black bits
    Select Case makeup:
        Case 64
            makeUpBlack = "0000001111" '?
        Case 128
            makeUpBlack = "000011001000" '?
        Case 192
            makeUpBlack = "000011001001"
        Case 256
            makeUpBlack = "000001011011"
        Case 320
            makeUpBlack = "000000110011"
        Case 384
            makeUpBlack = "000000110100"
        Case 448
            makeUpBlack = "000000110101"
        Case 512
            makeUpBlack = "0000001101100"
        Case 576
            makeUpBlack = "0000001101101"
        Case 640
            makeUpBlack = "0000001001010"
        Case 704
            makeUpBlack = "0000001001011"
        Case 768
            makeUpBlack = "0000001001100"
        Case 832
            makeUpBlack = "0000001001101"
        Case 896
            makeUpBlack = "0000001110010"
        Case 960
            makeUpBlack = "0000001110011"
        Case 1024
            makeUpBlack = "0000001110100"
        Case 1088
            makeUpBlack = "0000001110101"
        Case 1152
            makeUpBlack = "0000001110110"
        Case 1216
            makeUpBlack = "0000001110111"
        Case 1280
            makeUpBlack = "0000001010010"
        Case 1344
            makeUpBlack = "0000001010011"
        Case 1408
            makeUpBlack = "0000001010100"
        Case 1472
            makeUpBlack = "0000001010101"
        Case 1536
            makeUpBlack = "0000001011010"
        Case 1600
            makeUpBlack = "0000001011011"
        Case 1664
            makeUpBlack = "0000001100100"
        Case 1728
            makeUpBlack = "0000001100101"
        Case 1792
            makeUpBlack = "00000001000"
        Case 1856
            makeUpBlack = "00000001100"
        Case 1920
            makeUpBlack = "00000001101"
        Case 1984
            makeUpBlack = "000000010010"
        Case 2048
            makeUpBlack = "000000010011"
        Case 2112
            makeUpBlack = "000000010100"
        Case 2176
            makeUpBlack = "000000010101"
        Case 2240
            makeUpBlack = "000000010110"
        Case 2304
            makeUpBlack = "000000010111"
        Case 2368
            makeUpBlack = "000000011100"
        Case 2432
            makeUpBlack = "000000011101"
        Case 2496
            makeUpBlack = "000000011110"
        Case 2560
            makeUpBlack = "000000011111"
        Case Else
            makeUpBlack = ""
    End Select
End Function

Public Sub CreateSFFFile()
    Dim sff_FileName As String
    Dim sff_FileHandle As Integer         ' file handle, from freefile()
    Dim sff_FilePos As Long               ' pointer to last byte read/written
    
    Dim sff_XPelsPerMeter As Long         ' Resolution Horizontal
    Dim sff_YPelsPerMeter As Long         ' Resolution Vertical
    Dim sff_Width As Long                 ' Width
    Dim sff_Height As Long                ' Height
    
    Dim i As Long
    Dim x As Long, y As Long
    Dim j As Long
    
    Dim runlen As Long
    Dim whiteLines As Long
    Dim ScanLine_lenth As Long
    Dim codeline As String 'Scan Line coded using MH
    
    Dim state As BITSTATE
    
    DeleteFile sff_FileName
    
    sff_FileName = "test.sff"
    sff_XPelsPerMeter = 204
    sff_YPelsPerMeter = 196
    sff_Width = 1728
    sff_Height = 2339
    ScanLine_lenth = ((sff_Width + 15) \ 16) * 2

    
    sff_FilePos = 1
    sff_FileHandle = FreeFile(0)
    Open sff_FileName For Binary Access Write Lock Write As sff_FileHandle
    
    'SFF header
    Put sff_FileHandle, sff_FilePos, "Sfff"
    Put sff_FileHandle, sff_FilePos + 4, 1 'Version
    Put sff_FileHandle, sff_FilePos + 5, 0 'reserved
    Put sff_FileHandle, sff_FilePos + 6, 0 'User Information
    Put sff_FileHandle, sff_FilePos + 7, 0
    Put sff_FileHandle, sff_FilePos + 8, 0 'Page Count
    Put sff_FileHandle, sff_FilePos + 9, 0
    Put sff_FileHandle, sff_FilePos + 10, 20 'Offset first page header
    Put sff_FileHandle, sff_FilePos + 11, 0
    Put sff_FileHandle, sff_FilePos + 12, 0 'Offset last page header
    Put sff_FileHandle, sff_FilePos + 13, 0
    Put sff_FileHandle, sff_FilePos + 14, 0
    Put sff_FileHandle, sff_FilePos + 15, 0
    Put sff_FileHandle, sff_FilePos + 16, 0 'Offset of document end
    Put sff_FileHandle, sff_FilePos + 17, 0
    Put sff_FileHandle, sff_FilePos + 18, 0
    Put sff_FileHandle, sff_FilePos + 19, 0
    sff_FilePos = sff_FilePos + 20
    
    'Page header
    Put sff_FileHandle, sff_FilePos, 254 'Page header ID
    Put sff_FileHandle, sff_FilePos + 1, 16 'Page header lenth
    Put sff_FileHandle, sff_FilePos + 2, IIf(sff_YPelsPerMeter < 100, 0, 1) 'Resolution Vertical
    Put sff_FileHandle, sff_FilePos + 3, 0 'Resolution Horizontal
    Put sff_FileHandle, sff_FilePos + 4, 0 'Coding: Modified Huffman
    Put sff_FileHandle, sff_FilePos + 5, 0 'reserved
    Put sff_FileHandle, sff_FilePos + 6, sff_Width Mod 256 'Line lenth
    Put sff_FileHandle, sff_FilePos + 7, sff_Width \ 256
    Put sff_FileHandle, sff_FilePos + 8, sff_Height Mod 256 'Page lenth
    Put sff_FileHandle, sff_FilePos + 9, sff_Height \ 256
    Put sff_FileHandle, sff_FilePos + 10, 0 'Offset Previous page
    Put sff_FileHandle, sff_FilePos + 11, 0
    Put sff_FileHandle, sff_FilePos + 12, 0
    Put sff_FileHandle, sff_FilePos + 13, 0
    Put sff_FileHandle, sff_FilePos + 14, 0 'Offset Next page
    Put sff_FileHandle, sff_FilePos + 15, 0
    Put sff_FileHandle, sff_FilePos + 16, 0
    Put sff_FileHandle, sff_FilePos + 17, 0
    sff_FilePos = sff_FilePos + 18
    
    
    'Modified Huffman
    whiteLines = 0
    For y = sff_Height - 1 To 0 Step -1
        runlen = 0
        state = STATE_WHITE
        codeline = ""
        For x = 0 To ScanLine_lenth - 1
            For j = 0 To 7
                If ((x * 8 + j + 1) <= sff_Width) Then ' интересует первые 1728 бит
                    If (GetBitX(bDib(x, y), 7 - j)) = 1 Then  'black bit
                        If (state = STATE_WHITE) Then
                            If whiteLines > 0 Then 'если предыдущие линии белые
                                'Debug.Print "whiteLines=" & whiteLines
                                sff_FilePos = writeWhiteLines(whiteLines, sff_FileHandle, sff_FilePos)
                                whiteLines = 0
                            End If
                            'кодируем предыдущие белые биты
                            codeline = codeline & DoWhite(runlen)
                            state = STATE_BLACK
                            runlen = 1
                        Else
                            runlen = runlen + 1
                        End If
                    Else 'white bit
                        If (state = STATE_BLACK) Then
                            'кодируем предыдущие черные биты
                            codeline = codeline & DoBlack(runlen)
                            state = STATE_WHITE
                            runlen = 1
                        Else
                            runlen = runlen + 1
                        End If
                    End If
                End If
            Next j
        Next x
        If (runlen = sff_Width) Then 'And (state = STATE_WHITE) Then 'все биты белые
            whiteLines = whiteLines + 1
            If y = 0 Then 'last scanline
                sff_FilePos = writeWhiteLines(whiteLines, sff_FileHandle, sff_FilePos)
                whiteLines = 0
            End If
        Else
            If state = STATE_WHITE Then
                codeline = codeline & DoWhite(runlen)
            Else
                codeline = codeline & DoBlack(runlen)
            End If
            codeline = codeline & "000000000001" '+ EOL
            'codeline = DoWhite(0) & DoBlack(763) & DoWhite(865) & DoBlack(100) & "000000000001"
            sff_FilePos = writeLine(codeline, sff_FileHandle, sff_FilePos)
        End If
    Next y

    
'    'test 2339 empty lines
'    For i = 1 To 63
'        Put sff_FileHandle, sff_FilePos, 253 '37 lines -> 2331 lines
'        sff_FilePos = sff_FilePos + 1
'    Next i
'    Put sff_FileHandle, sff_FilePos, 224 '+8 lines
'    sff_FilePos = sff_FilePos + 1
    
    'Document end
    Put sff_FileHandle, sff_FilePos, 254
    'Put sff_FileHandle, sff_FilePos + 1, 0
    
    Close sff_FileHandle
End Sub

Public Function GetBitXY(x As Byte, y As Byte, Bit As Long) As Long
    'WORD - 2 байта x - первый байт (0-255) y - второй байт (0-255)
   Dim L As Long
   L = CLng(x) + CLng(y) * 256
   GetBitXY = IIf(((L And 2 ^ Bit) > 0), 0, 1)
End Function

Public Function GetBitX(x As Byte, Bit As Long) As Long
    'x - первый байт (0-255)
   Dim L As Long
   L = CLng(x)
   GetBitX = IIf(((L And 2 ^ Bit) > 0), 0, 1)
End Function

Private Function DoWhite(runlen As Long) As String
    'coding white bits
    Dim code As String
    Dim run_len As Long
    Dim make_up As Long
    run_len = runlen
    code = ""
    Do While run_len > 2623 ' 2560+63=2623
        code = code & makeUpWhite(2560)
        run_len = run_len - 2560
    Loop
    If run_len > 63 Then ' max 2560
        make_up = (run_len \ 64) * 64
        run_len = run_len Mod 64
        code = code & makeUpWhite(make_up)
    End If
    If (run_len > 0) Or (Len(code) = 0) Then
        code = code & termWhite(run_len) ' max 63
    End If
    DoWhite = code
End Function

Private Function DoBlack(runlen As Long) As String
    'coding black bits
    Dim code As String
    Dim run_len As Long
    Dim make_up As Long
    run_len = runlen
    code = ""
    Do While run_len > 2623 ' 2560+63=2623
        code = code & makeUpBlack(2560)
        run_len = run_len - 2560
    Loop
    If run_len > 63 Then ' max 2560
        make_up = (run_len \ 64) * 64
        run_len = run_len Mod 64
        code = code & makeUpBlack(make_up)
    End If
    If (run_len > 0) Or (Len(code) = 0) Then
        code = code & termBlack(run_len) ' max 63
    End If
    DoBlack = code
End Function

Private Function writeWhiteLines(whiteLines As Long, FileHandle As Integer, start As Long) As Long
    'returns next position in file
    Dim white_Lines As Long
    Dim the_start As Long
    white_Lines = whiteLines
    the_start = start
    If (white_Lines > 0) Then
        Do While white_Lines > 37 ' max 37: 217..253
            Put FileHandle, the_start, 253
            white_Lines = white_Lines - 37
            the_start = the_start + 1
        Loop
        Put FileHandle, the_start, 216 + white_Lines
        the_start = the_start + 1
    End If
    writeWhiteLines = the_start
End Function

Private Function writeLine(codeline As String, FileHandle As Integer, start As Long) As Long
    'returns next position in file
    Dim code_Line As String
    Dim the_start As Long
    Dim the_byte As String
    Dim the_lenth As Long
    code_Line = codeline
    the_start = start
    the_lenth = (Len(code_Line) + 7) \ 8
    'Debug.Print the_lenth
    If the_lenth <= 216 Then
        Put FileHandle, the_start, the_lenth
        the_start = the_start + 1
    Else
        Put FileHandle, the_start, 0
        Put FileHandle, the_start + 1, (the_lenth Mod 256)
        Put FileHandle, the_start + 2, (the_lenth \ 256)
        the_start = the_start + 3
    End If
    Do While Len(code_Line) > 0
        If Len(code_Line) >= 8 Then
            the_byte = Left(code_Line, 8)
            code_Line = Right(code_Line, Len(code_Line) - 8)
        Else
            the_byte = code_Line & String(8 - Len(code_Line), "0")
            code_Line = ""
        End If
        Put FileHandle, the_start, generateByte(the_byte)
        the_start = the_start + 1
    Loop
    writeLine = the_start
End Function

Public Function generateByte(byteAsStr As String) As Long
    Dim i As Integer
    generateByte = 0
    If Len(byteAsStr) = 8 Then
        For i = 1 To 8
            generateByte = generateByte + CLng(Mid(byteAsStr, i, 1)) * (2 ^ (i - 1))
        Next i
    End If
End Function

...

Рейтинг:

0 / 0

18.06.2012, 05:21

| Ответить | Цитировать | Написать

25 сообщений из 54, страница 1 из 3

все

Цитировать

Написать

Автор*:

Ввести пароль для входа

Тема*:

Сообщение

Данное сообщение тематическое

Сообщение содержит картинки или видео 18+

Автор:

ВНИМАНИЕ! На данном подфоруме действуют строгие правила. Удостоверьтесь, что ваше сообщение соответствует им!

Форум или тема закрыты для гостей. Необходима авторизация!

Загрузить последнюю сохраненную версию

Вложение:

Вставить как галерею

Максимальный размер вложений: 4,0 МБ, аудио/видео: 8,0 МБ. Картинки большего размера ужимаются, если возможно.

Введите код, изображенный на картинке. Если код нечитаемый, кликните картинку, чтобы загрузить другой вариант.

Отправляя сообщение, я выражаю свое согласие с правилами форума и принимаю пользовательское соглашение.

Читали тему (0):

Читали форум (0):

Пользователи онлайн (0):

start [/forum/topic.php?fid=60&msg=37834928&tid=2157584]:	0ms
get settings:	11ms
get forum list:	15ms
check forum access:	4ms
check topic access:	4ms
track hit:	42ms
get topic data:	11ms
get forum data:	3ms
get page messages:	63ms
get tp. blocked users:	1ms
others:	16ms

total:	170ms