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