Короче, пока так:
Я нашел следующий код:
True Colour DIBSection
Там как раз описывается метод, предложенный Бенедиктом: VarPtrArray на двухмерный массив:
У меня "заработал" следующий (буквально) код:
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.
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 (сверху вниз)
а снизу вверх:
1.
For Y = bmiDst.bmiHeader.biHeight - 1 To 0 Step -1
3) читать не слово Word (2 байта), а читать по одному байту
при этом переворачивая биты от 7 до 0 (в обратном порядке), а не от 0 до 7 как я делал.
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.
Ну лучше чтоб грамотные люди объяснили.
