[CDR X5-X8] Помогите 16-ричный файл втянуть в массив

_MBK_ · 02.04.2017

~RA~ сказал(а):
все они бинарные.

Все они состоят из пустоты и движения электронов
Бинарные или текстовые - это классификация способов открытия их на чтение/запись

Erchizo · 02.04.2017

Ну мужики вас уже на философию потянуло ))))

~RA~ · 02.04.2017

Все данные в цифровом мире бинарные, ибо хранятся в виде последовательности единиц и нулей. Остальное софистика.

_MBK_ · 02.04.2017

~RA~ сказал(а):
ибо хранятся в виде последовательности единиц и нулей

Это и есть софистика, ибо представление информации в виде нулей и единиц - антропоморфизм, причем очень молодой
В данный момент рассматривается значение слова "бинарный" (binary) как способ открытия файла бейсиковской командой Open и система счисления тут ни при чем
В принципе да, можно любой файл открыть и так и эдак, но надо ли?

~RA~ · 02.04.2017

_MBK_ сказал(а):
рассматривается значение слова "бинарный" (binary) как способ открытия файла бейсиковской командой Open

О как.

_MBK_ · 02.04.2017

А то

splxgf · 02.04.2017

Erchizo сказал(а):
VBA 7.1 все это не работает (((((

На кореле проверю завтра, но вообще все должно работать. Только определения переставить, и переменную объявить "Dim strVarPath As String"

Код:

Type BGR '3 байта / 1 вариант
     rgbBlue As Byte
     rgbGreen As Byte
     rgbRed As Byte
End Type 'Обратите внимание, что поля всегда имеют синий цвет -> зеленый -> красный


Type BITMAPFILEHEADER '14 байт
     bfType As Integer
     bfSize As Long
     bfReserved1 As Integer
     bfReserved2 As Integer
     bfOffBits As Long
End Type

Type BITMAPINFOHEADER '40 байт
     biSize As Long
     biWidth As Long
     biHeight As Long
      iplanes As Integer
     biBitCount As Integer
     biCompression As Long
     biSizeImage As Long
     biXPelsPerMeter As Long
     biYPelsPerMeter As Long
     biClrUsed As Long
     biClrImportant As Long
End Type

Type BITMAPFILE
     bmfh As BITMAPFILEHEADER
     bmih As BITMAPINFOHEADER
     aBitmapBits() As BGR  'Содержат 3-байтовые элементы
End Type

_MBK_ · 02.04.2017

splxgf сказал(а):
вообще все должно работать.

Нет

splxgf · 03.04.2017

Ну он же не ругается на сами типы, а только на область видимости.
Возможно вылечится сменой "type" на "public type".

_MBK_ · 03.04.2017

splxgf сказал(а):
Возможно вылечится сменой "type" на "public type".

На самом деле на "Private type"
Вот такой код у меня скомпилировался без проблем во всяком случае

Код:

Private Type BITMAPFILEHEADER '14 байт
     bfType As Integer
     bfSize As Long
     bfReserved1 As Integer
     bfReserved2 As Integer
     bfOffBits As Long
End Type

Private Type BITMAPINFOHEADER '40 байт
     biSize As Long
     biWidth As Long
     biHeight As Long
      iplanes As Integer
     biBitCount As Integer
     biCompression As Long
     biSizeImage As Long
     biXPelsPerMeter As Long
     biYPelsPerMeter As Long
     biClrUsed As Long
     biClrImportant As Long
End Type

Private Type BGR '3 байта / 1 вариант
     rgbBlue As Byte
     rgbGreen As Byte
     rgbRed As Byte
End Type 'Обратите внимание, что поля всегда имеют синий цвет -> зеленый -> красный

Private Type BITMAPFILE
     bmfh As BITMAPFILEHEADER
     bmih As BITMAPINFOHEADER
     aBitmapBits() As BGR  'Содержат 3-байтовые элементы
End Type


Dim bitmap1 As BITMAPFILE
Dim headers As Integer
Dim hei, wid, kx, ky As Long

Sub Init()
     Open strVarPath For Binary As #1
End Sub

Sub Read_header()
     Get #1, , bitmap1.bmfh
     Get #1, , bitmap1.bmih
     headers = LOF(1) - bitmap1.bmih.biSizeImage 'Размер части от начала до данных
End Sub

Sub Next_init()
Dim i, j As Long
Dim bitmp As String
     hei = bitmap1.bmih.biHeight
     wid = bitmap1.bmih.biWidth
     '--------------- Получить высоту и ширину
     kx = wid
     ky = hei
     '--------------- Сделать ширину ровной
     If (kx Mod 2 <> 0) Then
          kx = kx + 1
     End If
     '--------------- объявить массив, из которых размер = высота х ширина
     ReDim bitmap1.aBitmapBits(ky, kx)
     Close #1
     Init
     bitmp = Space(headers)
     Get #1, , bitmp '------ Прочитайте часть перед данными
     For i = 1 To ky
          For j = 1 To kx
               Get #1, , bitmap1.aBitmapBits(i, j) 'Здесь мы читаем данные пострчно
          Next j
     Next i
End Sub

Sub process()
'Здесь выполняются задачи на основе полученного массива данных
End Sub

Sub Finish()
     Close #1
End Sub

Private Sub cmdWork_Click()
     Init
     Read_header
     Next_init
     process
     Finish
End Sub

splxgf · 03.04.2017

_MBK_ сказал(а):
На самом деле на "Private type"
Вот такой код у меня скомпилировался без проблем во всяком случае

Если помещать код в Global Macros - Modules, то и обычный type проходит без вопросов.
К самому коду вопросов нет.

_MBK_ · 03.04.2017

Это да, в итоге при ближайшем рассмотрении выходит, что проблемы никакой нет

Erchizo · 09.04.2017

Ух ты, и правда заработало ))))))))
Спасибо, большое спасибо

ydobemos · 27.04.2017

Очень интересная тема. Лет 10 назад я для проекта средствами Виндоус считывал значения пикселей прямо с экрана. Это было ооооочень медленно и требовало полного бездействия пользователя.

Начиная с Х8 функция пипетки доступно через ВБА, но почти также медленна как тогдашний хак + глючит иногда с красками.

А этот метод быстрый... это откроет много интересних возможностей, спасибо за тему.

ydobemos · 27.04.2017

Хотя, возможно рановато порадовался - как только бмп файл больше 64 пикселов происходит сдвиг. Или в этом случае меняется хэдэр или что-то еще... Результат таков:

Кто-то сталкивался с таким, как обойти?

Вот код:

Код:

Private Type BITMAPFILEHEADER '14 bytes
     bfType As Integer
     bfSize As Long
     bfReserved1 As Integer
     bfReserved2 As Integer
     bfOffBits As Long
End Type

Private Type BITMAPINFOHEADER '40 bytes
     biSize As Long
     biWidth As Long
     biHeight As Long
      iplanes As Integer
     biBitCount As Integer
     biCompression As Long
     biSizeImage As Long
     biXPelsPerMeter As Long
     biYPelsPerMeter As Long
     biClrUsed As Long
     biClrImportant As Long
End Type

Private Type BGR '3 bytes / 1 variant
     rgbBlue As Byte
     rgbGreen As Byte
     rgbRed As Byte
End Type 'Always B - G - R

Private Type BITMAPFILE
     bmfh As BITMAPFILEHEADER
     bmih As BITMAPINFOHEADER
     aBitmapBits() As BGR  '3xByte
End Type

Dim bitmap1 As BITMAPFILE
Dim headers As Integer
Dim hei, wid, kx, ky As Long

Sub Init()
     Open DesktopPath + "ATest.bmp" For Binary As #1
End Sub

Sub Read_header()
     Get #1, , bitmap1.bmfh
     Get #1, , bitmap1.bmih
     headers = LOF(1) - bitmap1.bmih.biSizeImage 'Part before data
End Sub

Sub Next_init()
Dim i, j As Long
Dim bitmp As String
     hei = bitmap1.bmih.biHeight
     wid = bitmap1.bmih.biWidth
     '--------------- Width and Height
     kx = wid
     ky = hei
     '--------------- Straighten
     If (kx Mod 2 <> 0) Then
          kx = kx + 1
     End If
     '--------------- Array of pixels
     ReDim bitmap1.aBitmapBits(ky, kx)
     Close #1
     Init
     bitmp = Space(headers)
     Get #1, , bitmp '------ Read in header
     For i = 1 To ky
          For j = 1 To kx
               Get #1, , bitmap1.aBitmapBits(i, j) 'Read in data
          Next j
     Next i
End Sub

Sub process()
    ActiveDocument.Unit = cdrMillimeter
    
    Dim i, j As Long
    Dim S As Shape, SR As New ShapeRange

     For i = 1 To ky
          For j = 1 To kx
               Set S = ActiveVirtualLayer.CreateEllipse2(j, i, 0.5)
               S.Fill.ApplyUniformFill CreateRGBColor(bitmap1.aBitmapBits(i, j).rgbRed, bitmap1.aBitmapBits(i, j).rgbGreen, bitmap1.aBitmapBits(i, j).rgbBlue)
               S.Outline.SetNoOutline
               SR.Add S
          Next j
     Next i
    
     ActiveDocument.LogCreateShapeRange SR

End Sub

Sub Finish()
     Close #1
End Sub

Private Sub cmdWork_Click()
    boostStart "BitmapRead"

     Init
     Read_header
     Next_init
     process
     Finish
    
    boostFinish True
End Sub

Public Function DesktopPath() As String
    DesktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
End Function

_MBK_ · 27.04.2017

ydobemos сказал(а):
Кто-то сталкивался с таким, как обойти?

Вы не учитываете выравнивание на двойное слово?

ydobemos · 27.04.2017

_MBK_ сказал(а):
Вы не учитываете выравнивание на двойное слово?

Если я правильно понял в таком случае 53х72 пикселя должны бы быть ровными и только 70x96 кривыми. Тут вроде что-то другое...

_MBK_ · 27.04.2017

ydobemos сказал(а):
Если я правильно понял в таком случае 53х72 пикселя должны бы быть ровными и только 70x96 кривыми. Тут вроде что-то другое...

Без понятия
Я повторяю - вы упорно требуете от меня рыбу, когда я буквально в лицо настойчиво вам тыкаю удочку
От которой вы еще и отбиваетесь, говоря что дырявыми трусами поймаете больше и жирнее
У вас в алгоритме НЕ УЧИТЫВАЕТСЯ выравнивание строки BMP на слово
Курите спецификацию BMP

ydobemos · 27.04.2017

_MBK_ сказал(а):
Без понятия
Я повторяю - вы упорно требуете от меня рыбу, когда я буквально в лицо настойчиво вам тыкаю удочку
От которой вы еще и отбиваетесь, говоря что дырявыми трусами поймаете больше и жирнее
У вас в алгоритме НЕ УЧИТЫВАЕТСЯ выравнивание строки BMP на слово
Курите спецификацию BMP

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

Алгоритм же полностью взят из примера - как записывается в массиве значение RGB, так и считывается. Со спецификацией BMP я не знаком, по этому и вопрос. Одна строчка "Вы не учитываете выравнивание на двойное слово?" не особенно помогает.

Буду смотреть спецификацию битмапа да, спасибо.

_MBK_ · 27.04.2017

ydobemos сказал(а):
Со спецификацией BMP я не знаком, по этому и вопрос. Одна строчка "Вы не учитываете выравнивание на двойное слово?" не особенно помогает.

Странно слышать такое от программиста с десятилетним стажем 'stick'

Ладно, у меня сегодня праздник, я добрый. 'vine'

Первая ссылка по гуглу

Сразу за палитрой идет сам растр. Тут уже более запутано. Во-первых, пиксели тут описываются так, как написано в таблице выше в зависимости от формата. И могут сами содержать значение компонентов цвета (для беспалитровых), а могут быть индексами массива-палитры. Сама картинка записывается построчно. Во-вторых, картинка идет как бы перевернутая вверх ногами. То есть сначала записана нижняя строка, потом предпоследняя и так далее до самого верха. И, в-третьих, как написано в [1], если размер строки растра не кратен 4, то она дополняется от 1 до 3 пустыми (нулевыми) байтами, чтобы длина строки оказалась кратна параграфу.

Поиск

[CDR X5-X8] Помогите 16-ричный файл втянуть в массив

_MBK_

Пикирующий бомбардировщик

Erchizo

Участник

~RA~

Любезнейшая ~RA~ 🄯

_MBK_

Пикирующий бомбардировщик

~RA~

Любезнейшая ~RA~ 🄯

_MBK_

Пикирующий бомбардировщик

splxgf

_MBK_

Пикирующий бомбардировщик

splxgf

_MBK_

Пикирующий бомбардировщик

splxgf

_MBK_

Пикирующий бомбардировщик

Erchizo

Участник

ydobemos

Участник

ydobemos

Участник

_MBK_

Пикирующий бомбардировщик

ydobemos

Участник

_MBK_

Пикирующий бомбардировщик

ydobemos

Участник

_MBK_

Пикирующий бомбардировщик