VBAでbmp画像をASCIIデータとして開く

質問

VBAでbmp画像ファイルをASCIIの配列データとして開き、
青色を全て赤色に変更して、jpegファイルとして保存するようなプログラムを書きたいのですが
bmpファイルををASCIIの配列データとして開くためにはどのような記述を使えば良いでしょうか？

回答No.2

mitarashi · ベストアンサー

お望みの回答とは異なりますが、純粋な青ARGB = &HFF0000FFを、赤&HFFFF0000に変換してJPEG保存する、GDI+を用いたコードです。（念のため、最初のAは透明度です）バイナリでBMPを開けたとしても、JPEGにする際にGDI+または他のDLL等に頼らざるを得ないと思いますので、最初からGDI+でいかがでしょうか。近頃のPCなら標準でインストールされております。
青っぽい色を赤っぽい色に変換するのには対応しておりませんので、実用にならないかと思いますが、その辺はご自分でお願いします。

Private Type UUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
Private Type EncoderParameter
Guid As UUID
NumberOfValues As Long
Type As Long
Value As Long
End Type
Private Type EncoderParameters
Count As Long
Parameter(15) As EncoderParameter
End Type

Private Declare Function GdiplusStartup Lib "gdiplus.dll" (ByRef token As Long, ByRef inputBuf As GdiplusStartupInput, ByVal outputBuf As Long) As Long
Private Declare Sub GdiplusShutdown Lib "gdiplus.dll" (ByVal token As Long)
Private Declare Function GdipDisposeImage Lib "gdiplus.dll" (ByVal image As Long) 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 GdipCreateBitmapFromFile Lib "gdiplus" (fileName As Any, bitmap As Long) As Long
Private Declare Function GdipGetImageHeight Lib "gdiplus" (ByVal image As Long, Height As Long) As Long
Private Declare Function GdipGetImageWidth Lib "gdiplus" (ByVal image As Long, Width As Long) As Long
Private Declare Function GdipBitmapGetPixel Lib "gdiplus" (ByVal bitmap As Long, ByVal x As Long, ByVal y As Long, color As Long) As Long
Private Declare Function GdipBitmapSetPixel Lib "gdiplus" (ByVal bitmap As Long, ByVal x As Long, ByVal y As Long, ByVal color As Long) As Long

Sub retouchImage()
Dim strInName As String
Dim strOutName As String
Dim lngWidth As Long
Dim lngHeight As Long
Dim Quality As Long
Dim lngGDIPToken As Long
Dim pSrcBitmap As Long
Dim udtEncParam As EncoderParameters
Dim udtGdiPlus As GdiplusStartupInput
Dim x As Long, y As Long
Dim myARGB As Long

Const CLSID_JPEG = "{557CF401-1A04-11D3-9A73-0000F81EF32E}"
Const CLSID_QUALITY = "{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"

Quality = 90
strInName = "C:\Users\hoge\Desktop\test.bmp"
strOutName = "C:\Users\hoge\Desktop\test.jpg"

udtGdiPlus.GdiplusVersion = 1
If GdiplusStartup(lngGDIPToken, udtGdiPlus, 0&) <> 0 Then
Exit Sub
End If

If GdipCreateBitmapFromFile(ByVal StrPtr(strInName), pSrcBitmap) <> 0 Then
Exit Sub
End If

GdipGetImageWidth pSrcBitmap, lngWidth
GdipGetImageHeight pSrcBitmap, lngHeight
For y = 0 To lngHeight - 1
For x = 0 To lngWidth - 1
GdipBitmapGetPixel pSrcBitmap, x, y, myARGB
If myARGB = &HFF0000FF Then
GdipBitmapSetPixel pSrcBitmap, x, y, &HFFFF0000
End If
Next x
Next y

udtEncParam.Count = 1
With udtEncParam.Parameter(0)
.Guid = GetCLSID(CLSID_QUALITY)
.NumberOfValues = 1
.Type = 4
.Value = VarPtr(Quality)
End With
Call GdipSaveImageToFile(pSrcBitmap, StrPtr(strOutName), GetCLSID(CLSID_JPEG), VarPtr(udtEncParam))
GdipDisposeImage (pSrcBitmap)
Call GdiplusShutdown(lngGDIPToken)
End Sub

Private Function GetCLSID(ByVal strGuid As String) As UUID
Dim lngResult As Long
lngResult = CLSIDFromString(StrPtr(strGuid), GetCLSID)
End Function

回答No.1

ap_2

読込みは、バイナリモードでOpenして、1byteずつGet。
文字コードの変換＆格納は、自分でやらなきゃダメ。変換はたぶん、Hex()が使える。

jpg変換は、何かAPIを使うのかな？