8bitインデックス画像の入出力方法

質問

http://okwave.jp/qa/q8852322.html
http://okwave.jp/qa/q8856128.html

このページで画像の配列への入出力の仕方を教えていただきました。

配列の読み書きの方法が分かればできるかと思ったのですが
やり方がわかりませんでしたので質問いたします。

24あるいは32bitの場合には教えていただいた方法で問題ないのですが
8bitの画像（インデックスカラー画像）の場合にはどうしたら良いでしょうか？

8bit画像を

GdipCreateBitmapFromFile(ByVal StrPtr(strInName), pSrcBitmap)

で取得し、そのまま

GdipSaveImageToFile pSrcBitmap, StrPtr(strOutName), encTIFF, VarPtr(udtEncParam)

を使って、別の画像形式に再圧縮して出力しても
8bit画像として出力されるので、
pSrcBitmapにはインデックスカラーに関する情報と
256階調（8bit）での画像情報も含まれているようです。

しかしながら、

GdipBitmapGetPixel pSrcBitmap, x, y, myARGB

で画像情報を抽出すると
8bit画像を読み込んだとしても
32bitカラー情報として抽出されてしまいます。

http://www.vbforums.com/showthread.php?718163-GDI-GdipGetImagePixelFormat-(untrusted)

このサイトにPixelFormatの設定の仕方が書かれてあって、
PixelFormat24bppRGB = &H21808
を用いると24bit画像として出力できることが分かりました。

PixelFormat8bppIndexed = &H30803
を指定してみたのですが、
一応、8bit画像として出力することは確認できたのですが
出力にものすごく時間がかかってしまうのですが。

恐らくインデックスを生成するのに時間がかかっているのだと思うのですが
既にインデックスがでている場合にどのように指定すれば良いか、
8bit画像からインデックスを抽出するのかが分からないのですが。

どのようにすれば
インデックスカラーと256階調（8bit）での画像情報を
配列に読み込み、および配列から画像への書き出しを行えますでしょうか？

回答No.7

mitarashi · ベストアンサー

mitarashiです。ひょっとしてこういう事がご希望だったのでしょうか？新規作成をやってみました。ご参考まで。
Private Declare Function GdipCreateBitmapFromScan0 Lib "gdiplus.dll" (ByVal nWidth As Long, ByVal Height As Long, ByVal stride As Long, ByVal PixelFormat As Long, scan0 As Any, nBitmap As Long) As Long

Sub make8bitIndexedBitmap()
Dim GDIsi As GdiplusStartupInput, gToken As Long, pBitmap As Long
Dim bmpData As BitmapData
Dim lrect As RECT
Dim x As Long, y As Long
Dim lWidth As Single, lHeight As Single
Dim buf(0) As Byte
Dim strOutName As String
Dim encBMP As UUID
Dim paletteSize As Long
Dim palette As ColorPalette
Dim i As Long
Dim strBGR As String
Dim myARGB As Long

GDIsi.GdiplusVersion = 1&
GdiplusStartup gToken, GDIsi

lWidth = 200: lHeight = 100
Call GdipCreateBitmapFromScan0(lWidth, lHeight, 0, PixelFormat8bppIndexed, ByVal 0&, pBitmap)

lrect.Top = 0: lrect.Left = 0
lrect.Bottom = CLng(lHeight): lrect.Right = CLng(lWidth)

If GdipBitmapLockBits(pBitmap, lrect, ImageLockMode.ReadWrite, PixelFormat8bppIndexed, bmpData) <> 0 Then
Exit Sub
End If

For x = 0 To lWidth - 1
For y = 0 To lHeight - 1
buf(0) = y \ 10
MoveMemory ByVal bmpData.scan0 + (y * bmpData.stride) + x, buf(0), 1
Next y
Next x
Call GdipBitmapUnlockBits(pBitmap, bmpData)

'Palette設定
Call GdipGetImagePaletteSize(pBitmap, paletteSize)
Call GdipGetImagePalette(pBitmap, palette, paletteSize)
'Range("A1:P16")のセルの色からPaletteの色を設定する
For i = 0 To 255
strBGR = Hex(ActiveSheet.Cells((i \ 16) + 1, (i Mod 16) + 1).Interior.Color)
strBGR = Right("000000" & strBGR, 6)
myARGB = CLng("&H" & "FF" & Mid(strBGR, 5, 2) & Mid(strBGR, 3, 2) & Mid(strBGR, 1, 2))
palette.Entries(i) = myARGB
Next i
Call GdipSetImagePalette(pBitmap, palette)

'BMP保存
strOutName = GetDesktopPath & "\make8bitIndexed.bmp"
CLSIDFromString StrPtr("{557CF400-1A04-11D3-9A73-0000F81EF32E}"), encBMP
Call GdipSaveImageToFile(pBitmap, StrPtr(strOutName), encBMP, ByVal 0&)

GdipDisposeImage pBitmap
GdiplusShutdown gToken
End Sub

お礼

ありがとうございます。

一通り、配列への読み書きができることを確認できました。

しかしpalette.Entriesへのデータの入出力で変な挙動をするのですが
なぜでしょうか？

いまやりたいことは、
配列に収められたデータとインデックスカラーをbmp画像として出力することです。

最初に

lngResult = GdipCreateBitmapFromScan0(Nx, Ny, 0, PixelFormat8bppIndexed, ByVal 0&, hBmp)

で8bit画像のオブジェクトを生成した後に

palette.count = 255
を行いました

その後、例えば、配列PPP()にグレースケールの値が入っているとします。

For DDD = 0 To 255
PPP(DDD, 0) = DDD '青
PPP(DDD, 1) = DDD '緑
PPP(DDD, 2) = DDD '赤
PPP(DDD, 3) = ((alpha - 128) * &H1000000 Or &H80000000) Or _
cl_pl(DDD, 0) Or (cl_pl(DDD, 1) * &H100&) Or (cl_pl(DDD, 2) * &H10000)

Next DDD

これを実行すると

ARGB=FF000000で、PPP(0, 3)=-16777216で
線形的に数値が下がっていき
ARGB=FFFFFFFFで、PPP(255, 3)=-1となります。

この配列を使って

for i= 0 to 255

palette.Entries(i) = PPP(i)

next i

としてパレットに代入していくと、

p(190, 3)で一度極小点となり、-82242
p(191, 3)で再度上がって、-16449
p(192, 3)で-4144960
というように、p(190, 3)近辺で
palette.Entries(i) = PPP(i, 3)
で代入した値に何か規格化されたような値が代入されてしまいます。
それ以外の場所は正常に代入できています。

palettesizeを指定していないからではないかと思うのですが

GdipSetImagePaletteSize

というコマンドは存在しないようです。

どのようにすればうまくカラーパレットに思ったデータを代入できますでしょうか？

補足

うまくいきました。

ありがとうございます。

回答No.6

mitarashi

#5です。
>型が一致しません　というエラーが出て止まってしまいます。
当方の環境 Win7Home(64bit),xl2010(32bit)で動作するコードをそのままコピペしてありますので、原因が分かりかねます。何処で、何が型違いになるのか、お調べ下さい。

>8bit 画像のデータ部はどのようにして配列から作成および配列への読み込みを行えば良いでしょうか？
これは#2に1Pixcelずつ読込、書き出しする例を上げてあります。GDI+のBitmapオブジェクト（またはImageオブジェクト）から取得できるBitmapData構造体は行毎に画素以外のデータを含む不連続な構造なので、まとめて配列に取込という訳にはいかないと存じます。1Pixelずつ配列に読込、書き出すしか無いように思います。（当方知恵が無いです）

回答No.5

mitarashi

mitarashiです。いろんなところで拾ってきたコードを使っているので、Declareの内容が微妙に異なる様です。今回のコードではGdiplusStartupの第三引数がOptionalになっていました。とりあえずPalette関係のコードを全て載せます。ご参考まで。
Private Declare Function GdiplusStartup Lib "gdiplus" (Token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Function GdipLoadImageFromFile Lib "gdiplus.dll" (ByVal mFilename As Long, ByRef mImage As Long) As Long
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal Image As Long) As Long
Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal Token As Long)
Private Declare Function GdipSaveImageToFile Lib "gdiplus.dll" (ByVal Image As Long, ByVal fileName As Long, ByRef clsidEncoder As UUID, ByVal encoderParams As Long) As Long
Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpszCLSID As Long, ByRef pclsid As UUID) As Long
Private Declare Function GdipGetImagePalette Lib "gdiplus" (ByVal Image As Long, palette As ColorPalette, ByVal size As Long) As Long 'GpStatus
Private Declare Function GdipSetImagePalette Lib "gdiplus" (ByVal Image As Long, palette As ColorPalette) As Long 'GpStatus
Private Declare Function GdipGetImagePaletteSize Lib "gdiplus" (ByVal Image As Long, size As Long) As Long 'GpStatus

Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type

Private Type UUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type

Private Type ColorPalette
flags As Long
count As Long
Entries(0 To 255) As Long
End Type

Sub setPalette()
Dim GDIsi As GdiplusStartupInput, gToken As Long, pBitmap As Long
Dim srcFileName As String, destFileName
Dim paletteSize As Long
Dim palette As ColorPalette
Dim i As Long
Dim strBGR As String
Dim myARGB As Long
Dim encBMP As UUID

GDIsi.GdiplusVersion = 1&
GdiplusStartup gToken, GDIsi

srcFileName = GetDesktopPath & "\" & "lockbitstest.bmp"
destFileName = GetDesktopPath & "\" & "lockbitstest2.bmp"
Call GdipLoadImageFromFile(StrPtr(srcFileName), pBitmap)

Call GdipGetImagePaletteSize(pBitmap, paletteSize)
Call GdipGetImagePalette(pBitmap, palette, paletteSize)

For i = 0 To 255
strBGR = Hex(ActiveSheet.Cells((i \ 16) + 1, (i Mod 16) + 1).Interior.Color)
strBGR = Right("000000" & strBGR, 6)
myARGB = CLng("&H" & "FF" & Mid(strBGR, 5, 2) & Mid(strBGR, 3, 2) & Mid(strBGR, 1, 2))
palette.Entries(i) = myARGB
Next i
Call GdipSetImagePalette(pBitmap, palette)

CLSIDFromString StrPtr("{557CF400-1A04-11D3-9A73-0000F81EF32E}"), encBMP
GdipSaveImageToFile pBitmap, StrPtr(destFileName), encBMP, ByVal 0&

GdipDisposeImage pBitmap
GdiplusShutdown gToken
End Sub

Sub getPalette()
Dim GDIsi As GdiplusStartupInput, gToken As Long, pBitmap As Long
Dim fileName As String
Dim paletteSize As Long
Dim palette As ColorPalette
Dim mycolor As Long
Dim i As Long
Dim strARGB As String

GDIsi.GdiplusVersion = 1&
GdiplusStartup gToken, GDIsi

fileName = GetDesktopPath & "\" & "lockbitstest.bmp"
Call GdipLoadImageFromFile(StrPtr(fileName), pBitmap)
Call GdipGetImagePaletteSize(pBitmap, paletteSize)
Call GdipGetImagePalette(pBitmap, palette, paletteSize)
For i = 0 To 255
mycolor = palette.Entries(i)
strARGB = Hex(mycolor)
Cells((i \ 16) + 1, (i Mod 16) + 1).Interior.Color = RGB(CInt("&H" & Mid(strARGB, 3, 2)), CInt("&H" & Mid(strARGB, 5, 2)), CInt("&H" & Mid(strARGB, 7, 2)))
Next i

GdipDisposeImage pBitmap
GdiplusShutdown gToken
End Sub

Private Function GetDesktopPath() As String
Dim wScriptHost As Object, strInitDir As String
Set wScriptHost = CreateObject("Wscript.Shell")
GetDesktopPath = wScriptHost.SpecialFolders("Desktop")
Set wScriptHost = Nothing
End Function

お礼

何度もありがとうございます。

Sub setPalette()
の方は正常に動作することが確認できました。

Sub getPalette()
の方は動作するのですが
最後のところで

Cells((i \ 16) + 1, (i Mod 16) + 1).Interior.color = RGB(CInt("&H" & Mid(strARGB, 3, 2)), CInt("&H" & Mid(strARGB, 5, 2)), CInt("&H" & Mid(strARGB, 7, 2)))

の場所で　型が一致しません　というエラーが出て止まってしまいます。

どのように改良すれば良いでしょうか？

補足

すいません、あともう一つ

プログラムを追っていて気がついたのですが
setPalette()は
既存の8bit bmp画像のパレットを書き換えるプログラム

getPalette()は
既存の8bit bmp画像のパレットを抽出するプログラム

であるようなのですが、
8bit 画像のデータ部はどのようにして配列から作成および配列への読み込みを行えば良いでしょうか？

PixelFormat8bppIndexed = &H30803
を定義して

lngResult = GdipCreateBitmapFromScan0(lngWidth, lngHeight, 0, PixelFormat8bppIndexed , ByVal 0&, hBmp)
で8bit画像のオブジェクトを作成して、

SaveImageToFile(hBmp, fileout_path(i), ext_out, 30)

で出力しようとしてもうまくいかないのですが。

回答No.4

mitarashi

#3だけでは中途半端なので、書き込みも投稿しておきます。#3のセル配置のセルの色を読み込んでパレットに設定します。（ちょっとしたパレットエディターですね。）ご参考まで。
Private Declare Function GdipSetImagePalette Lib "gdiplus" (ByVal Image As Long, palette As ColorPalette) As Long 'GpStatus

Sub setPalette()
Dim GDIsi As GdiplusStartupInput, gToken As Long, pBitmap As Long
Dim srcFileName As String, destFileName
Dim paletteSize As Long
Dim palette As ColorPalette
Dim i As Long
Dim strBGR As String
Dim myARGB As Long
Dim encBMP As UUID

GDIsi.GdiplusVersion = 1&
GdiplusStartup gToken, GDIsi
If Err Then
Err.Clear
Exit Sub
ElseIf gToken = 0& Then
Exit Sub
End If

srcFileName = GetDesktopPath & "\" & "lockbitstest.bmp"
destFileName = GetDesktopPath & "\" & "lockbitstest2.bmp"
Call GdipLoadImageFromFile(StrPtr(srcFileName), pBitmap)

Call GdipGetImagePaletteSize(pBitmap, paletteSize)
Call GdipGetImagePalette(pBitmap, palette, paletteSize)

For i = 0 To 255
strBGR = Hex(ActiveSheet.Cells((i \ 16) + 1, (i Mod 16) + 1).Interior.Color)
strBGR = Right("000000" & strBGR, 6)
myARGB = CLng("&H" & "FF" & Mid(strBGR, 5, 2) & Mid(strBGR, 3, 2) & Mid(strBGR, 1, 2))
palette.Entries(i) = myARGB
Next i
Call GdipSetImagePalette(pBitmap, palette)

CLSIDFromString StrPtr("{557CF400-1A04-11D3-9A73-0000F81EF32E}"), encBMP
GdipSaveImageToFile pBitmap, StrPtr(destFileName), encBMP, ByVal 0&

GdipDisposeImage pBitmap
GdiplusShutdown gToken
End Sub

お礼

重ね重ねありがとうございます。

試してみたのですが

GdiplusStartup gToken, GDIsi
で　引数は省略できません。
とエラーが出ます。

GdiplusStartup gToken, GDIsi, 0&

にするべきだと思いますが合っていますか？

これを変更すると

Call GdipLoadImageFromFile(StrPtr(fileName), pBitmap)
で

SubまたはFunctionは定義されていません。
とエラーが出ます。

GdipLoadImageFromFileをPrivate Declare Function しないといけないと思うのですが
どのようにしたら良いですか？
検索してもなぜかかからないのですが。

回答No.3

mitarashi

#2です。#2の補足に関してですが、
Private Type UUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
が、抜けていました。申し訳ありません。

さて、パレットの取得ですが、結局GDI+の関数と、VBAでのDeclare文を見つけ出して来てなんとかなりました。これからどう料理するかは質問者様次第です。ご参考まで。
Private Declare Function GdipGetImagePalette Lib "gdiplus" (ByVal Image As Long, palette As ColorPalette, ByVal size As Long) As Long
Private Declare Function GdipGetImagePaletteSize Lib "gdiplus" (ByVal Image As Long, size As Long) As Long

Private Type ColorPalette
flags As Long
count As Long
Entries(0 To 255) As Long
End Type

Sub getPalette()
Dim GDIsi As GdiplusStartupInput, gToken As Long, pBitmap As Long
Dim fileName As String
Dim paletteSize As Long
Dim palette As ColorPalette
Dim mycolor As Long
Dim i As Long
Dim strARGB As String

GDIsi.GdiplusVersion = 1&
GdiplusStartup gToken, GDIsi
If Err Then
Err.Clear
Exit Sub
ElseIf gToken = 0& Then
Exit Sub
End If

fileName = GetDesktopPath & "\" & "lockbitstest.bmp"
Call GdipLoadImageFromFile(StrPtr(fileName), pBitmap)

Call GdipGetImagePaletteSize(pBitmap, paletteSize)
Call GdipGetImagePalette(pBitmap, palette, paletteSize)

For i = 0 To 255
mycolor = palette.Entries(i)
strARGB = Hex(mycolor)
Cells((i \ 16) + 1, (i Mod 16) + 1).Interior.Color = RGB(CInt("&H" & Mid(strARGB, 3, 2)), CInt("&H" & Mid(strARGB, 5, 2)), CInt("&H" & Mid(strARGB, 7, 2)))
Next i

GdipDisposeImage pBitmap
GdiplusShutdown gToken
End Sub

なお、以前に記した、下記コードは今回のパレットで、条件により色がおかしい箇所がありましたので取り下げさせていただきます。
ARGB→BGR
myColor = myARGB And &HFFFFFF
newColor = (myColor And &HFF&) * &H10000 Or _
((myColor \ &H100&) And &HFF&) * &H100& Or _
((myColor \ &H10000) And &HFF&)

回答No.2

mitarashi

#1です。Lockbitsをやってみました。パレットはとりあえずフリーソフトのお世話になって確認しました。添付画像のウィンドウの方がパレットの内容になります。使用した原色が後の方に載っています。
'http://www.vector.co.jp/soft/dl/winnt/art/se357055.html
bitmapdata構造体に直接アクセスしていますが、#1で紹介させていただいた様な不連続な構造になっていますので、1pixelずつアクセスする仕方しか思いつきませんでした。

>256階調（8bit）での画像情報も含まれているようです。
これは誤解されている様ですが、パレット上の番号が入っているだけです。
パレットについてはDIBの構造について調べてみる必要がありそうです。
文字数の制限回避のため、前回までに使用したと覚しきAPI宣言、構造体、関数等は割愛させていただきます。

Private Declare Function GdipGetImageDimension Lib "gdiplus" _
(ByVal image As Long, ByRef Width As Single, _
ByRef Height As Single) As Long
Private Declare Function GdipBitmapLockBits Lib "gdiplus" (ByVal bitmap As Long, RECT As RECT, ByVal flags As Long, ByVal PixelFormat As Long, lockedBitmapData As BitmapData) As Long
Private Declare Function GdipBitmapUnlockBits Lib "gdiplus" (ByVal bitmap As Long, lockedBitmapData As BitmapData) As Long

Public Declare Sub MoveMemory Lib "KERNEL32" Alias "RtlMoveMemory" (Dest As Any, Source As Any, ByVal length As Long)

Private Type BitmapData
Width As Long
Height As Long
stride As Long
PixelFormat As Long
scan0 As Long
Reserved As Long
End Type

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Const PixelFormat8bppIndexed = &H30803

Private Enum ImageLockMode
ReadWrite = &H3
End Enum

Sub test()
Dim GDIsi As GdiplusStartupInput, gToken As Long, pBitmap As Long
Dim fileName As String
Dim bmpData As BitmapData
Dim lrect As RECT
Dim x As Long, y As Long
Dim lWidth As Single, lHeight As Single
Dim buf(0) As Byte
Dim strOutName As String
Dim encBMP As UUID

On Error Resume Next
GDIsi.GdiplusVersion = 1&
GdiplusStartup gToken, GDIsi
If Err Then
Err.Clear
Exit Sub
ElseIf gToken = 0& Then
Exit Sub
End If
On Error GoTo 0

fileName = GetDesktopPath & "\" & "lockbitstest.bmp"
Call GdipLoadImageFromFile(StrPtr(fileName), pBitmap)
GdipGetImageDimension pBitmap, lWidth, lHeight
lrect.Top = 0: lrect.Left = 0
lrect.Bottom = CLng(lHeight): lrect.Right = CLng(lWidth)

If GdipBitmapLockBits(pBitmap, lrect, ImageLockMode.ReadWrite, PixelFormat8bppIndexed, bmpData) <> 0 Then
Exit Sub
End If

'画素1pixelの取得
x = 10: y = 20
MoveMemory buf(0), ByVal bmpData.scan0 + (y * bmpData.stride) + x, 1
Debug.Print buf(0) '249 - 今回の例では

'書き換えてみる
buf(0) = 252
For x = 0 To 20
For y = 0 To 20
MoveMemory ByVal bmpData.scan0 + (y * bmpData.stride) + x, buf(0), 1
Next y
Next x

'BMP保存
strOutName = GetDesktopPath & "\destLockbitstest.bmp"
CLSIDFromString StrPtr("{557CF400-1A04-11D3-9A73-0000F81EF32E}"), encBMP
GdipSaveImageToFile pBitmap, StrPtr(strOutName), encBMP, ByVal 0&

Call GdipBitmapUnlockBits(pBitmap, bmpData)
GdipDisposeImage pBitmap
GdiplusShutdown gToken
End Sub

お礼

ありがとうございます。

実行してみたのですが
Dim encBMP As UUID
のところで
ユーザー定義型は定義されていません。
というエラーが出て実行することができないのですが、
どのようにすれば良いでしょうか？

よろしくお願いいたします。

回答No.1

mitarashi

先のご質問に回答した者ですが、
8bit画像を取り扱おうと思った事が無いので、お役に立てないと思います。
検索してみました
http://www.pcreview.co.uk/forums/changing-pixel-color-using-gdi-t1324194.html
こちらにご質問と類似のQAがあります。考え方の提供に止まっている様です。

上記によると、LockBitsというのを用いる必要がありそうです。
http://bobpowell.net/lockingbits.aspx
ここに載っているVBのコードは、残念ながら、VB.NETのコードですね。（詳しく無いですが）

https://github.com/javiercrowsoft/cairo-vb6/blob/master/CSChart/GDI%2B/Codigo2/GpGDIPlus/Class/cBitmap.cls
GdipBitmapLockBitsのVB6での使用例があります。API宣言等は下記にありました。
https://github.com/javiercrowsoft/cairo-vb6/blob/master/CSChart/GDI%2B/Codigo2/GpGDIPlus/Module/modGDIPlus.bas
おかげさまで面白そうなコードに巡り会えました。

http://arkham46.developpez.com/articles/office/clgdiplus/#LIII
こちらのソースをGDI+のFLAT API使用の参考にさせてもらっております。ざっと眺めてみましたが、
GdipBitmapLockBits(lBitmap, lrect, &H2 Or &H4, PixelFormat32bppARGB, lbmpData)
と、32bitカラーの使用例しかなさそうでした。
また、日本語リファレンスを提供して下さっている方がいらっしゃいますが、arkham46.developpez.comで公開しているクラス（巨大です）には、お望みの機能はなさそうに思います。
http://www.f3.dion.ne.jp/~element/msaccess/clgdiplusdoc.html

平日には新しい事に取り組む時間は取れませんので、とり急ぎ参考情報を提供させていただきます。

お礼

ありがとうございます。

もうしばらくこの質問ページを立ち上げたままにしておきますので
土日とか時間がある時にでも解決策が分かりましたら
教えていただけないでしょうか？

よろしくお願いいたします。