form1.frm

这是一个关于图像技术的源码,会有很大的帮助的

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "图象合成技术"
   ClientHeight    =   5430
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7695
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   5430
   ScaleWidth      =   7695
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame3 
      Caption         =   "结果图象"
      Height          =   1455
      Left            =   150
      TabIndex        =   8
      Top             =   3165
      Width           =   7410
      Begin VB.PictureBox Final 
         AutoRedraw      =   -1  'True
         BackColor       =   &H80000004&
         Height          =   960
         Left            =   135
         ScaleHeight     =   60
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   471
         TabIndex        =   9
         Top             =   330
         Width           =   7125
      End
   End
   Begin VB.Frame Frame2 
      Caption         =   "中间图象"
      Height          =   915
      Left            =   150
      TabIndex        =   4
      Top             =   2085
      Width           =   7380
      Begin VB.PictureBox Mask 
         AutoRedraw      =   -1  'True
         BackColor       =   &H80000004&
         Height          =   525
         Left            =   135
         ScaleHeight     =   31
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   88
         TabIndex        =   7
         Top             =   240
         Width           =   1380
      End
      Begin VB.PictureBox ReverseMask 
         AutoRedraw      =   -1  'True
         BackColor       =   &H80000004&
         Height          =   525
         Left            =   2985
         ScaleHeight     =   31
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   88
         TabIndex        =   6
         Top             =   270
         Width           =   1380
      End
      Begin VB.PictureBox Foreground 
         AutoRedraw      =   -1  'True
         BackColor       =   &H80000004&
         Height          =   525
         Left            =   5835
         ScaleHeight     =   31
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   88
         TabIndex        =   5
         Top             =   300
         Width           =   1380
      End
   End
   Begin VB.CommandButton CmdNextStep 
      Caption         =   "下一步>>"
      Height          =   372
      Left            =   3120
      TabIndex        =   3
      Top             =   4905
      Width           =   1452
   End
   Begin VB.Frame Frame1 
      Caption         =   "原始图象"
      Height          =   1935
      Left            =   165
      TabIndex        =   0
      Top             =   45
      Width           =   7380
      Begin VB.PictureBox Background 
         AutoSize        =   -1  'True
         Height          =   960
         Left            =   180
         Picture         =   "Form1.frx":0000
         ScaleHeight     =   60
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   468
         TabIndex        =   2
         Top             =   840
         Width           =   7080
      End
      Begin VB.PictureBox Sprite 
         AutoSize        =   -1  'True
         Height          =   525
         Left            =   180
         Picture         =   "Form1.frx":3F4B
         ScaleHeight     =   31
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   88
         TabIndex        =   1
         Top             =   285
         Width           =   1380
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

Private Sub CmdNextStep_Click()
    Static Step As Integer
    Step = Step + 1
    Select Case Step
        Case 1: Step1
        Case 2: Step2
        Case 3: Step3
        Case 4: Step4
        Case 5: Step5
        Case 6: Step6
        Case 7: Step7
        Case 8: Step8
        Case 9: Step9
        Case 10: Step10
    End Select
End Sub

Private Sub Step1()
    '拷贝一份前景图
    Caption = "拷贝一份前景图----步骤1"
    Result = BitBlt(Mask.hDC, 0, 0, Mask.Width, Mask.Height, Sprite.hDC, 0, 0, vbSrcCopy)
    Mask.Picture = Mask.Image
End Sub

Private Sub Step2()
    Dim i As Integer, j As Integer
    CmdNextStep.Enabled = False
    '将前景图的背景色设置为白色
    Caption = "将前景图的背景色设置为白色----步骤2"
    Dim TransColor As Long
    TransColor = Sprite.Point(2, 2) '取出背景色颜色
    Sprite.Picture = Sprite.Image
    
    For i = 0 To Sprite.ScaleWidth - 1
        For j = 0 To Sprite.ScaleHeight - 1
            If Sprite.Point(i, j) = TransColor Then
                Mask.PSet (i, j), vbWhite
            End If
        Next j
        DoEvents
    Next i
    CmdNextStep.Enabled = True
End Sub

Private Sub Step3()
    Dim i As Integer, j As Integer
    CmdNextStep.Enabled = False
    '将所有非白色区域设置为黑色
    Caption = "将所有非白色区域设置为黑色----步骤3"
    For i = 0 To Sprite.ScaleWidth - 1
        For j = 0 To Sprite.ScaleHeight - 1
            If Mask.Point(i, j) <> vbWhite Then
                Mask.PSet (i, j), vbBlack
            End If
        Next j
        DoEvents
    Next i
    CmdNextStep.Enabled = True
End Sub

Private Sub Step4()
    '将背景图拷贝到目标区域
    Caption = "将背景图拷贝到目标区域----步骤4"
    BitBlt Final.hDC, 0, 0, Final.Width, Final.Height, Background.hDC, 0, 0, vbSrcCopy
    Final.Picture = Final.Image
End Sub

Private Sub Step5()
    'Now use mergepaint (this only copies the back bits) to white out the foreground on the final pic"
    '将黑色部分（前景图透明）也拷贝到目标区域
    Caption = "将黑色部分（前景图透明）也拷贝到目标区域----步骤5"
    BitBlt Final.hDC, 0, 0, Final.Width, Final.Height, Mask.hDC, 0, 0, vbMergePaint
    Final.Picture = Final.Image
End Sub

Private Sub Step6()
    '将透明前景色反色处理
    Caption = "将透明前景色反色处理----步骤6"
    BitBlt ReverseMask.hDC, 0, 0, Mask.Width, Mask.Height, Mask.hDC, 0, 0, vbNotSrcCopy
    ReverseMask.Picture = ReverseMask.Image
End Sub

Private Sub Step7()
    '重新拷贝一份前景色（原始图象）
    Caption = "重新拷贝一份前景色（原始图象）----步骤7"
    BitBlt Foreground.hDC, 0, 0, Mask.Width, Mask.Height, Sprite.hDC, 0, 0, vbSrcCopy
    Foreground.Picture = Foreground.Image
End Sub

Private Sub Step8()
    '将背景色变成白色
    Caption = "将背景色变成白色----步骤8"
    BitBlt Foreground.hDC, 0, 0, Mask.Width, Mask.Height, ReverseMask.hDC, 0, 0, vbMergePaint
    Foreground.Picture = Foreground.Image
End Sub

Private Sub Step9()
    '将前景色拷贝到目标区域
    Caption = "将前景色拷贝到目标区域----完成"
    BitBlt Final.hDC, 0, 0, Mask.Width, Mask.Height, Foreground.hDC, 0, 0, vbSrcAnd
    Final.Picture = Final.Image
    CmdNextStep.Caption = "结束"
End Sub

Private Sub Form_Load()
    Mask.ScaleWidth = Sprite.ScaleWidth
    Mask.ScaleHeight = Sprite.ScaleHeight
    ReverseMask.ScaleWidth = Sprite.ScaleWidth
    ReverseMask.ScaleHeight = Sprite.ScaleHeight
    Foreground.ScaleWidth = Sprite.ScaleWidth
    Foreground.ScaleHeight = Sprite.ScaleHeight
    
    Final.ScaleWidth = Background.ScaleWidth
    Final.ScaleHeight = Background.ScaleHeight
End Sub

Private Sub Step10()
    End
End Sub
Private Sub Form_Unload(Cancel As Integer)
    End
End Sub