Memorandum

ビットマップ画像の色の取得

Win32APIを用い、ビットマップ画像の色を取得するサンプルコードとメモです。

ポイント

 ・画像の高さ・幅の取得
 ・Application.PathSeparatorプロパティ
 ・WinAPI


サンプルコード

BMP画像の色を取得し、セル背景色にそれらを設定していくサンプルコード。
※Excel2007以降用。Excel2003でも動作するが、色が正確に反映されない。
※下記のコードをVBEに貼り付ると、一部赤く表示される場合があるが、エラーではない。
※320×240ピクセル以内のBMP画像をデスクトップに準備し、「sample.bmp」と名前を付けた後実行
※次のコードを利用したソフト:「画像とセル背景色の相互変換」アドイン


'///宣言セクションに記述///
#If VBA7 Then
    'Excel2010以上
    Private Declare PtrSafe Function CreateCompatibleDC Lib "gdi32" ( _
        ByVal hDC As LongPtr) As LongPtr
    Private Declare PtrSafe Function DeleteDC Lib "gdi32" ( _
        ByVal hDC As LongPtr) As Long
    Private Declare PtrSafe Function DeleteObject Lib "gdi32" ( _
        ByVal hObject As LongPtr) As Long
    Private Declare PtrSafe Function SelectObject Lib "gdi32" ( _
        ByVal hDC As LongPtr, _
        ByVal hObject As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetPixel Lib "gdi32" ( _
        ByVal hDC As LongPtr, _
        ByVal x As Long, _
        ByVal y As Long) As Long
    Private Declare PtrSafe Function LoadImage Lib "user32" Alias "LoadImageA" ( _
        ByVal hinst As LongPtr, _
        ByVal lpszName As String, _
        ByVal uType As Long, _
        ByVal cxDesired As Long, _
        ByVal cyDesired As Long, _
        ByVal fuLoad As Long) As LongPtr
#Else
    Private Declare Function CreateCompatibleDC Lib "gdi32" ( _
        ByVal hDC As Long) As Long
    Private Declare Function DeleteDC Lib "gdi32" ( _
        ByVal hDC As Long) As Long
    Private Declare Function DeleteObject Lib "gdi32" ( _
        ByVal hObject As Long) As Long
    Private Declare Function SelectObject Lib "gdi32" ( _
        ByVal hDC As Long, _
        ByVal hgdiobj As Long) As Long
    Private Declare Function GetPixel Lib "gdi32" ( _
        ByVal hDC As Long, _
        ByVal x As Long, _
        ByVal y As Long) As Long
    Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" ( _
        ByVal hinst As Long, _
        ByVal lpszName As String, _
        ByVal uType As Long, _
        ByVal cxDesired As Long, _
        ByVal cyDesired As Long, _
        ByVal fuLoad As Long) As Long
#End If

Private Const LR_LOADFROMFILE = &H10

Type FileWH
    w As Long
    h As Long
    ERROR As String
End Type

'///ここまで/// Sub Get_BMP_Sample() Dim strPS As String Dim strFP As String Dim typFWH As FileWH strPS = Application.PathSeparator strFP = DeskTop_Path() & strPS & "sample.bmp" typFWH = Check_FileSize(strFP) With typFWH If .ERROR <> "" Then MsgBox .ERROR, vbExclamation + vbOKOnly: Exit Sub End If Call Load_BMP_Image(strFP, .w, .h) End With End Sub
Private Function DeskTop_Path() As String Dim objWShell As Object 'WScript.Shell Set objWShell = CreateObject("WScript.Shell") 'デスクトップパス DeskTop_Path = objWShell.SpecialFolders("Desktop") End Function
Private Function Check_FileSize(ByVal FP As String) As FileWH Dim objImage As Object On Error GoTo ERROR Set objImage = LoadPicture(FP) With Check_FileSize .w = CLng(objImage.Width * 0.0378) .h = CLng(objImage.Height * 0.0378) If .w < 321 And .h < 321 Then Exit Function .ERROR = "処理対応上限を超えています" & vbCrLf _ & "最大処理対応ピクセル:240×320" End With On Error GoTo 0 Exit Function ERROR: Check_FileSize.ERROR = "ファイルが存在しない、またはファイル形式が対象外、" _ & vbCrLf & "又はフォルダへのアクセスが制限されています。" End Function
Private Sub Load_BMP_Image(file As String, w As Long, h As Long) Dim intI As Long Dim intII As Long Dim oldBmp As Long Dim DC, bmp DC = CreateCompatibleDC(0) 'スクリーンDCに関連あるDCを作成 bmp = LoadImage(0, file, 0, 0, 0, LR_LOADFROMFILE) 'BMP読込 oldBmp = SelectObject(DC, bmp) '作成したDCにbmpを関連付ける With Application .ScreenUpdating = False With .ActiveWorkbook.ActiveSheet With .Cells .Clear .ColumnWidth = 0.23 .RowHeight = 2.25 End With If .Columns.Count < w Then w = .Columns.Count For intI = 1 To h For intII = 1 To w .Cells(intI, intII).Interior.Color = GetPixel(DC, intII - 1, intI - 1) Next Next End With .ScreenUpdating = True End With bmp = SelectObject(DC, oldBmp) Call DeleteDC(DC) Call DeleteObject(bmp) End Sub

メモ

画像の大きさ(高さと幅)の取得】

LoadPicture関数を用い、Object変数に画像を読み込み、その高さと幅を取得。
LoadPicture関数は、Picture型のオブジェクトを返す。PictureオブジェクトのWidth、Heightプロパティから、画像の高さと幅を求めるが、それらの単位はピクセルではない。単位をピクセルに変換するため、0.0378を掛け、さらにCLngで丸める。

LoadPicture関数

フォームやイメージコントロール等のPictureプロパティや、Iconプロパティに画像を表示する。

構文:LoadPicture([picturefilename])

[picturefilename]
画像のパス・ファイル名を指定。引数を省略、又は「""」空の文字列にすると、既に設定されている画像が消去される。

Application.PathSeparatorプロパティ

[ 参照 ]

CreateCompatibleDC/DeleteDC関数(Win32API)

[ 参照 ]

LoadImage/SelectObject/DeleteObject関数(Win32API)

[ 参照 ]

GetPixel関数(Win32API)

後日記載

ページトップへ戻る
Copyright(C) 2009- 坂江 保 All Rights Reserved.