Sample 00

画像合成
いわゆる半透明化合成

DownLoad
2000年1月25日修正



Command1
Picture1
Picture2
Picture3
List1

をフォームに貼り付けて、以下のコードを、フォームのソースコードへコピーして貼り付けてください。
Picture1と Picture2 にお好きな画像を貼り付ければ実行できます。

注意
画像の大きさは異なってもOKですが、画像サイズは画像Aを基準とします。

修正個所

[標準モジュール]のコードが全体的に修正されました。
以前のものと置き換えるだけで、互換性は保たれます


Option Explicit
'--------------------------------------------------------------
Private Sub Command1_Click()

    'マウスポインターを砂時計にする
    Screen.MousePointer = 11

    '画像サイズを合わせる
    Picture2.Height = Picture1.Height
    Picture2.Width = Picture1.Width

    '合成を実行
    Call export_Composition(Picture1.hdc, _
                                    Picture2.hdc, _
                                    Picture3.hdc, _
                                    Picture1.ScaleWidth, _
                                    Picture1.ScaleHeight, _
                                    List1.ListIndex)
    '出力後の再描画
    Picture3.Refresh

    'マウスポインターを通常に
    Screen.MousePointer = 0
End Sub
'--------------------------------------------------------------
Private Sub Form_Load()

    '初期設定(サンプルということで...)

    Me.ScaleMode = vbPixels 'ピクセル

    Picture1.AutoSize = True
    Picture1.AutoRedraw = True
    Picture1.BorderStyle = 0
    Picture1.ScaleMode = vbPixels 'ピクセル

    Picture2.AutoSize = True
    Picture2.AutoRedraw = True
    Picture2.BorderStyle = 0
    Picture2.ScaleMode = vbPixels 'ピクセル

    Picture3.AutoSize = False
    Picture3.AutoRedraw = True
    Picture3.BorderStyle = 0
    Picture3.ScaleMode = vbPixels 'ピクセル
    'リスト1へ追加する
    List1.Clear
    List1.AddItem "A + B = C"
    List1.AddItem "A - B = C"
    List1.AddItem "A * B = C"
    List1.AddItem "A / B = C"
    List1.AddItem "RGB最大値"
    List1.AddItem "RGB最小値"
    List1.AddItem "最大値"
    List1.AddItem "最小値"
    List1.ListIndex = 0
End Sub


以下のコードは、[標準モジュール]へ追加してください。

Option Explicit

'index
Enum
Enum_OperationMode
    '各RGB間の演算
    mAPlusB = 0
    mAMinusB = 1
    mAMultiplicationB = 2
    mADivisionB = 3
    mrgbAmaxB = 4
    mrgbAminB = 5
    'RGB間の演算
    mMAX = 6 '100
   
mMIN = 7 '101
End Enum

Private Declare Function
GetPixel Lib "gdi32" _
                        (ByVal hdc As Long, _
                         ByVal X As Long, _
                         ByVal Y As Long) As Long

Private Declare Function
SetPixelV Lib "gdi32" _
                        (ByVal hdc As Long, _
                         ByVal X As Long, _
                         ByVal Y As Long, _
                         ByVal crColor As Long) As Long
'--------------------------------------------------------------
' RGB値をR,G,Bに分割する
'--------------------------------------------------------------

Private Sub RGB2R_G_B(ByVal lngRGB As Long, _
                                  ByRef lngR As Long, _
                                  ByRef lngG As Long, _
                                  ByRef lngB As Long)
    lngR = lngRGB And &HFF&
    lngG = (lngRGB And &HFF00&) \ &H100
    lngB = (lngRGB And &HFF0000) \ &H10000
End Sub
'--------------------------------------------------------------
' 加算演算
'--------------------------------------------------------------

Private Sub RGB_APlusB(ByRef R1&, ByRef G1&, ByRef B1&, _
                                   ByVal R2&, ByVal G2&, ByVal B2 As Long)
    R1 = R1 + R2
    G1 = G1 + G2
    B1 = B1 + B2
    '範囲を超えないようにチェック
    If R1 > 255 Then R1 = 255
    If G1 > 255 Then G1 = 255
    If B1 > 255 Then B1 = 255
End Sub
'--------------------------------------------------------------
' 減算演算
'--------------------------------------------------------------

Private Sub RGB_AMinusB(ByRef R1&, ByRef G1&, ByRef B1&, _
                                     ByVal R2&, ByVal G2&, ByVal B2 As Long)
    R1 = R1 - R2
    G1 = G1 - G2
    B1 = B1 - B2
    '範囲を超えないようにチェック
    If R1 < 0 Then R1 = 0
    If G1 < 0 Then G1 = 0
    If B1 < 0 Then B1 = 0
End Sub
'
' 掛算演算
'--------------------------------------------------------------

Private Sub RGB_AMultiplicationB(ByRef R1&, ByRef G1&, ByRef B1&, _
                                               ByVal R2&, ByVal G2&, ByVal B2 As Long)
    R1 = R1 * R2
    G1 = G1 * G2
    B1 = B1 * B2
    '範囲を超えないようにチェック
    If R1 > 255 Then R1 = 255
    If G1 > 255 Then G1 = 255
    If B1 > 255 Then B1 = 255
End Sub
'--------------------------------------------------------------
' 割算演算
'--------------------------------------------------------------

Private Sub RGB_ADivisionB(ByRef R1&, ByRef G1&, ByRef B1&, _
                                       ByVal R2&, ByVal G2&, ByVal B2 As Long)

    If R1 = 0 Or R2 = 0 Then R1 = 0 Else R1 = R1 \ R2
    If G1 = 0 Or G2 = 0 Then G1 = 0 Else G1 = G1 \ G2
    If B1 = 0 Or B2 = 0 Then B1 = 0 Else B1 = B1 \ B2
    '範囲を超えないようにチェック
    If R1 < 0 Then R1 = 0
    If G1 < 0 Then G1 = 0
    If B1 < 0 Then B1 = 0
End Sub
'--------------------------------------------------------------
' 最大値抽出
'--------------------------------------------------------------

Private Sub RGB_rgbAmaxB(ByRef R1&, ByRef G1&, ByRef B1&, _
                                       ByVal R2&, ByVal G2&, ByVal B2 As Long)
    If R1 < R2 Then R1 = R2
    If R1 < R2 Then R1 = R2
End Sub
'--------------------------------------------------------------
' 最小値抽出
'--------------------------------------------------------------

Private Sub RGB_rgbAminB(ByRef R1&, ByRef G1&, ByRef B1&, _
                                      ByVal R2&, ByVal G2&, ByVal B2 As Long)
    If Not R1 < R2 Then R1 = R2
    If Not R1 < R2 Then R1 = R2
    If Not R1 < R2 Then R1 = R2
End Sub

'==============================================================
' 画像合成
' わかりやすくするため、最適化していません。
'--------------------------------------------------------------
' PicAhDC:合成のベースとなる画像のhDCを指定します。
' PicBhDC:PicAhDCへ合成する画像のhDCを指定します。
' outhDC:出力となるオブジェクトのhDCを指定します。
' PicWidth:PicAhDC画像の幅を指定します。
' PicHeight:PicAhDC画像の高さを指定します。
' OperationMode:演算方法を指定します。Enum_OperationMode を参照してください。

Public Function export_Composition(ByVal PicAhDC&, _
                                                 ByVal PicBhDC&, _
                                                 ByVal outhDC&, _
                                                 ByVal PicWidth&, _
                                                 ByVal PicHeight&, _
                                                 ByVal OperationMode As Enum_OperationMode _
                                        ) As Boolean
    ' ループ用
    Dim X&, Y As Long
    Dim i As Long
    ' 合成用に用意する配列
    Dim PicAc() As Long
    Dim PicBc() As Long
    Dim MAX_XYSize As Single
    ' RGB分解用
    Dim ColA(2) As Long
    Dim ColB(2) As Long

    Dim OpMode As Integer

    'サイズにあわせて配列を確保する
    MAX_XYSize = (PicWidth& + 1) * (PicHeight& + 1)
    ReDim PicAc(MAX_XYSize) As Long
    ReDim PicBc(MAX_XYSize) As Long

    '合成画像AとBの色情報を読取る
    For X = 0 To PicWidth& - 1
        For Y = 0 To PicHeight& - 1
            PicAc(i) = GetPixel(PicAhDC, X, Y)
            PicBc(i) = GetPixel(PicBhDC, X, Y)
            '
            '読み取った色情報をRGBに分解して、合成演算を行う
            '

            If OperationMode <= 5 Then
                '各RGBに対する処理
                Call RGB2R_G_B(PicAc(i), ColA(0), ColA(1), ColA(2))
                Call RGB2R_G_B(PicBc(i), ColB(0), ColB(1), ColB(2))

                '合成演算

                Select Case OperationMode
                    Case Enum_OperationMode.mAPlusB
                    'A+B
                       
Call RGB_APlusB( _
                                        ColA(0), ColA(1), ColA(2), _
                                        ColB(0), ColB(1), ColB(2))
                    Case Enum_OperationMode.mAMinusB
                    'A-B
                        Call RGB_AMinusB( _
                                        ColA(0), ColA(1), ColA(2), _
                                        ColB(0), ColB(1), ColB(2))
                    Case Enum_OperationMode.mAMultiplicationB
                    'A*B
                        Call RGB_AMultiplicationB( _
                                        ColA(0), ColA(1), ColA(2), _
                                        ColB(0), ColB(1), ColB(2))
                    Case Enum_OperationMode.mADivisionB
                    'A/B
                        Call RGB_ADivisionB( _
                                        ColA(0), ColA(1), ColA(2), _
                                        ColB(0), ColB(1), ColB(2))
                    Case Enum_OperationMode.mrgbAmaxB
                    'rgb_MAX
                        Call RGB_rgbAmaxB(ColA(0), ColA(1), ColA(2), _
                                        ColB(0), ColB(1), ColB(2))
                    Case Enum_OperationMode.mrgbAminB
                    'rgb_MIN
                        Call RGB_rgbAminB(ColA(0), ColA(1), ColA(2), _
                                        ColB(0), ColB(1), ColB(2))
                End Select
                '演算したものをOutPicへ書き込む
                '
                Call SetPixelV(outhDC, X, Y, RGB(ColA(0), ColA(1), ColA(2)))
            Else
                Select Case OperationMode
                    Case Enum_OperationMode.mMAX
                    'MAX
                        '大きい方へ入れ替える

                        If PicAc(i) < PicBc(i) Then PicAc(i) = PicBc(i)
                    Case Enum_OperationMode.mMIN
                    'MIN
                        '小さい方へ入れ替える

                        If Not PicAc(i) < PicBc(i) Then PicAc(i) = PicBc(i)
                End Select
                '
                '演算したものをOutPicへ書き込む
                '

                Call SetPixelV(outhDC, X, Y, PicAc(i))
            End If
            i = i + 1
        Next Y, X
    export_Composition = True
End Function