CX's VBScript Diary

2014-12-24

cx2020141224

VBScript + WIA を使って画像ファイルを作成する方法

22:45 | VBScript + WIA を使って画像ファイルを作成する方法 - CX's VBScript Diary を含むブックマーク はてなブックマーク - VBScript + WIA を使って画像ファイルを作成する方法 - CX's VBScript Diary

最近ですが、WindowsWindows Image Acquisition (WIA) という COM コンポーネントが含まれていることを知りました。

これを応用して、VBScript から画像ファイルを生成してみたいと思います。

' File : CreateMarioImage.vbs
' Usage : CScript //Nologo CreateMarioImage.vbs
' Description : VBScript で画像データを生成するサンプル。

Option Explicit

' ‥‥‥‥〓〓〓〓〓〓〓‥‥□□□
' ‥‥○○〓〓〓〓〓〓〓〓‥□□□
' ‥‥○○‥○○○○○○○○○□□
' ‥‥‥‥‥■■■□□■□‥○○○
' ‥‥‥‥■□■□□□■□□■■■
' ‥‥‥‥■□■■□□□■□□□■
' ‥‥‥‥■■□□□□■■■■■‥
' ‥‥‥‥‥‥□□□□□□□■‥‥
' ‥‥■■■■■■■○■■■‥‥‥
' ‥○■■■■■■■■■■■‥‥■
' □□○■■■■■■○■■■‥‥■
' □□□‥■■■■■■■○○■■■
' ‥□‥○○○○○○○○■■■■■
' ‥‥■■■■■■■■■■■■■■
' ‥■■■■■■■■■■‥‥‥‥‥
' ‥■‥‥■■■■‥‥‥‥‥‥‥‥
Dim dataSet
dataSet = Array( _
    "無","無","無","無","赤","赤","赤","赤","赤","赤","赤","無","無","肌","肌","肌", _
    "無","無","白","白","赤","赤","赤","赤","赤","赤","赤","赤","無","肌","肌","肌", _
    "無","無","白","白","無","白","白","白","白","白","白","白","白","赤","肌","肌", _
    "無","無","無","無","無","茶","茶","茶","肌","肌","茶","肌","無","白","白","白", _
    "無","無","無","無","茶","肌","茶","肌","肌","肌","茶","肌","肌","赤","赤","赤", _
    "無","無","無","無","茶","肌","茶","茶","肌","肌","肌","茶","肌","肌","肌","赤", _
    "無","無","無","無","茶","茶","肌","肌","肌","肌","茶","茶","茶","茶","赤","無", _
    "無","無","無","無","無","無","肌","肌","肌","肌","肌","肌","肌","赤","無","無", _
    "無","無","赤","赤","赤","赤","赤","赤","赤","赤","白","赤","赤","無","無","無", _
    "無","白","赤","赤","赤","赤","赤","赤","赤","赤","赤","赤","赤","無","無","茶", _
    "肌","肌","白","赤","赤","赤","赤","赤","赤","赤","白","赤","赤","無","無","茶", _
    "肌","肌","肌","無","赤","赤","赤","赤","赤","赤","赤","赤","白","白","茶","茶", _
    "無","肌","無","白","白","白","白","白","白","白","白","白","赤","赤","茶","茶", _
    "無","無","茶","茶","茶","赤","赤","赤","赤","赤","赤","赤","赤","赤","茶","茶", _
    "無","茶","茶","茶","赤","赤","赤","赤","赤","赤","赤","無","無","無","無","無", _
    "無","茶","無","無","赤","赤","赤","赤","無","無","無","無","無","無","無","無" _
)

Function GetRgbColor( c ) 
    Dim colorHash
    Set colorHash = CreateObject("Scripting.Dictionary")
    colorHash.Add "無", &hFF000000
    colorHash.Add "白", &hFFFFFFFF
    colorHash.Add "肌", &hFFFFCCCC
    colorHash.Add "茶", &hFF800000
    colorHash.Add "赤", &hFFFF0000
    colorHash.Add "黄", &hFFFFFF00
    colorHash.Add "緑", &hFF00FF00
    colorHash.Add "水", &hFF00FFFF
    colorHash.Add "青", &hFF0000FF
    colorHash.Add "紫", &hFF800080

    GetRgbColor = colorHash( c )
End Function

Call Main()

Sub Main()
    Dim vec
    Set vec = CreateObject("WIA.Vector")
    
    Dim color
    Dim i
    For i = 0 To UBound(dataSet)
        color = GetRgbColor( dataSet(i) )
        vec.Add color
    Next
    
    Dim img
    Set img = vec.ImageFile(16, 16)
    img.SaveFile "C:\home\edu\vbscript\WIA\hello\mario.bmp"
End Sub
  • 実行結果

<参考>

■ Create an ImageFile Object that Contains a Blank Page

http://msdn.microsoft.com/en-us/library/windows/desktop/ms630826(v=vs.85).aspx#SharedSample029