柴犬の得意なカエル座りです。
今回の概要
ビットマップ画像の白い領域を透過にしてみることを考えてみました。
ビットマップファイルを読み込み、1 ピクセル毎に白であるか確認します。
比較は 1ピクセルのARGBが &HFFFFFFFF であるなら、&H0 に変換します。
これを PNG にエンコードして保存します。
次の画像は、この方法によりビットマップ test.bmp を test.png に変換したものです。
透過になっているのが確認できます。
大量なAPI関数群
使用したAPI関数です。
Option Explicit
'--------------------------------------------------
'------GDI+ API定義
Private Declare PtrSafe Function GdiplusStartup Lib "gdiplus" ( _
ByRef tokenPtr As LongPtr, _
ByRef inputPtr As GdiplusStartupInput, _
Optional ByVal outputPtr As LongPtr = 0) As Long
'------GdiplusStartupn のtokenPtrが渡される
Private Declare PtrSafe Sub GdiplusShutdown Lib "gdiplus" ( _
ByVal tokenPtr As LongPtr)
'------ファイルからImageオブジェクトを取得する
Private Declare PtrSafe Function GdipLoadImageFromFile Lib "gdiplus" ( _
ByVal FileNamePtr As LongPtr, _
ByRef imagePtr As LongPtr) As Long
Private Declare PtrSafe Function GdipDisposeImage Lib "gdiplus" ( _
ByVal imagePtr As LongPtr) As Long
Private Declare PtrSafe Function GdipSaveImageToFile Lib "gdiplus.dll" ( _
ByVal imagePtr As LongPtr, _
ByVal fileName As LongPtr, _
ByRef clsidEncoder As UUID, _
ByVal encoderParams As LongPtr) As Long
Private Declare PtrSafe Function CLSIDFromString Lib "ole32" ( _
ByVal lpszCLSID As LongPtr, _
ByRef pclsid As UUID) As Long
Private Declare PtrSafe Function GdipGetImageWidth Lib "gdiplus" ( _
ByVal imagePtr As LongPtr, _
ByRef width As Long) As Long
Private Declare PtrSafe Function GdipGetImageHeight Lib "gdiplus" ( _
ByVal imagePtr As LongPtr, _
ByRef height As Long) As Long
Private Declare PtrSafe Function GdipBitmapGetPixel Lib "gdiplus" ( _
ByVal imagePtr As LongPtr, _
ByVal x As Long, _
ByVal y As Long, _
ByRef colorARGB As Long) As Long
Private Declare PtrSafe Function GdipBitmapSetPixel Lib "gdiplus" ( _
ByVal imagePtr As LongPtr, _
ByVal x As Long, _
ByVal y As Long, _
ByVal colorARGB As Long) As Long
Private Type UUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
'------GdiplusStartup構造体
Private Type GdiplusStartupInput
GdiplusVersion As Long 'GDI+ のバージョン 1 を指定
DebugEventCallback As LongPtr '既定値は 0
SuppressBackgroundThread As Long '既定値は 0
SuppressExternalCodecs As Long '既定値は 0
End Type
Private Type EncoderParameter
Guid As UUID
NumberOfValues As Long
TypeAPI As Long
Value As LongPtr
End Type
Private Type EncoderParameters
Count As Long
Parameter(15) As EncoderParameter
End Type
変換は簡単、保存が大変
変換は、x と y の For ループのところで行っています。
GetCLSID 関数については、こういうこともできるのだと考えさせられました。
'--------------------------------------------------
'画像を読み込んで1ピクセルを1セルで描画する
'対応フォーマット:GDI+準拠(BMP, JPEG, GIF, TIFF, PNG)
Public Function ImageConverter(ByVal strInName As String, _
ByVal strOutName As String, _
ByVal sFormat As String) As Boolean
Dim myGdiStartupInput As GdiplusStartupInput
Dim myEncoderParam As EncoderParameters
Dim myToken As LongPtr
Dim hBitmap As LongPtr
Dim width As Long
Dim height As Long
Dim Quality As Long
Dim myARGB As Long
Dim myEncode As String
Dim x As Integer
Dim y As Integer
Dim RES As Boolean
Const CLSID_BMP As String = _
"{557CF400-1A04-11D3-9A73-0000F81EF32E}"
Const CLSID_GIF As String = _
"{557CF402-1A04-11D3-9A73-0000F81EF32E}"
Const CLSID_TIF As String = _
"{557CF405-1A04-11D3-9A73-0000F81EF32E}"
Const CLSID_PNG As String = _
"{557CF406-1A04-11D3-9A73-0000F81EF32E}"
Const CLSID_JPEG As String = _
"{557CF401-1A04-11D3-9A73-0000F81EF32E}"
Const CLSID_QUALITY As String = _
"{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"
Select Case sFormat
Case "JPG"
myEncode = CLSID_JPEG
Case "GIF"
myEncode = CLSID_GIF
Case "TIF"
myEncode = CLSID_TIF
Case "PNG"
myEncode = CLSID_PNG
Case Else
myEncode = CLSID_BMP
End Select
'------GDI+ のバージョン 1 を指定
' 他は規定値
myGdiStartupInput.GdiplusVersion = 1
'------戻り値 Status 列挙体 成功 0 失敗 0以外
If GdiplusStartup(myToken, myGdiStartupInput) <> 0 Then
GoTo ERRSHORI
End If
'------画像読み込み 戻り値 GpStatus 列挙体（Status 列挙体と同じ）
If GdipLoadImageFromFile(ByVal StrPtr(strInName), hBitmap) <> 0 Then
GoTo ERRSHORI
End If
'------幅取得 戻り値 GpStatus 列挙体
If GdipGetImageWidth(hBitmap, width) <> 0 Then
GoTo ERRSHORI
End If
'------高さ取得 戻り値 GpStatus 列挙体
If GdipGetImageHeight(hBitmap, height) <> 0 Then
GoTo ERRSHORI
End If
For y = 0 To height - 1
For x = 0 To width - 1
'------ピクセルの取得 戻り値 GpStatus 列挙体
If GdipBitmapGetPixel(hBitmap, x, y, myARGB) <> 0 Then
GoTo ERRSHORI
End If
'------ピクセルの変換です。
If myARGB = &HFFFFFFFF Then
Call GdipBitmapSetPixel(hBitmap, x, y, &H0)
End If
Next x
Next y
If sFormat = "JPEG" Then
'------JPEGのクオリティー設定
Quality = 90
'------JPEG用
myEncoderParam.Count = 1
With myEncoderParam.Parameter(0)
.Guid = GetCLSID(CLSID_QUALITY)
.NumberOfValues = 1
.TypeAPI = 4
.Value = VarPtr(Quality)
End With
Call GdipSaveImageToFile(hBitmap, _
StrPtr(strOutName), _
GetCLSID(myEncode), _
VarPtr(myEncoderParam))
Else
Call GdipSaveImageToFile(hBitmap, _
StrPtr(strOutName), _
GetCLSID(myEncode), _
ByVal 0&)
End If
Call GdipDisposeImage(hBitmap)
Call GdiplusShutdown(myToken)
RES = True
OWARI:
ImageConverter = RES
Exit Function
ERRSHORI:
Call GdiplusShutdown(myToken)
RES = False
MsgBox "エラーが発生"
Resume OWARI
End Function
'--------------------------------------------------
'文字列から CLSID を取得する
Private Function GetCLSID(ByVal S As String) As UUID
Dim RES As Long
RES = CLSIDFromString(StrPtr(S), GetCLSID)
End Function
EXCELのシートから実行しました
エクセルのシートのセルをダブルクリックすると実行します。
'--------------------------------------------------
'
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
Cancel = True
Call MakeImage
End Sub
'--------------------------------------------------
'
Private Sub MakeImage()
Dim inImage As String
Dim outImage As String
inImage = "C:\Users\sora\Desktop\test.bmp"
outImage = "C:\Users\sora\Desktop\test.png"
If ImageConverter(inImage, outImage, "PNG") Then
MsgBox "完了"
End If
End Sub
GetCLSID 関数の疑問
Private Function GetCLSID(ByVal S As String) As UUID
Dim RES As Long
RES = CLSIDFromString(StrPtr(S), GetCLSID)
End FunctionCLSIDFromString(StrPtr(S), GetCLSID) の解釈
GetCLSID関数の中にこれが、ぱっと見、GetCLSID が入れ子になっているので再帰？と考えがよぎりました。
でも、違う。
表題のことについて、私自身かなり考え込みました。
Microsoft のCLSIDFromString 関数の解説
HRESULT CLSIDFromString(
[in] LPCOLESTR lpsz,
[out] LPCLSID pclsid
);これを読んで自分なりのまとめは次のようになりました。
GetCLSID が第二引数の位置にあるのは、StrPtr(S) を処理した結果を関数が返しているだけである。
つまり、
RES = CLSIDFromString(StrPtr(S), GetCLSID) は
Dim output As Variant
RES = CLSIDFromString(StrPtr(S), output)
GetCLSID = outputである。
確信
先ほどの考えを実践してみました。
EXCEL で次のコードを考えてみました。
早速、これを実行してみました。
結果、何らエラーも出ることなく 4 がメッセージで示されました。
疑問の推測が正しいことが分かりました。
