demo.frm

一款漂亮的控件。 快

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1 
   Caption         =   "透明图片的设置及叠加"
   ClientHeight    =   4095
   ClientLeft      =   885
   ClientTop       =   1425
   ClientWidth     =   7680
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   8.25
      Charset         =   134
      Weight          =   700
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H80000008&
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   4095
   ScaleWidth      =   7680
   Begin VB.PictureBox Picture1 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1092
      Left            =   5880
      ScaleHeight     =   1035
      ScaleWidth      =   1395
      TabIndex        =   10
      Top             =   2280
      Width           =   1452
   End
   Begin VB.CommandButton Command4 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "C&lose"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   6120
      TabIndex        =   1
      Top             =   1320
      Width           =   1335
   End
   Begin VB.CommandButton Command3 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "改变目标图片"
      Height          =   375
      Left            =   3480
      TabIndex        =   3
      Top             =   2640
      Width           =   1935
   End
   Begin VB.CommandButton Command2 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "改变源图片"
      Height          =   375
      Left            =   600
      TabIndex        =   2
      Top             =   2640
      Width           =   1815
   End
   Begin VB.CommandButton Command1 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "透明叠加(&C)"
      BeginProperty Font 
         Name            =   "黑体"
         Size            =   8.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   6120
      TabIndex        =   0
      Top             =   720
      Width           =   1335
   End
   Begin VB.PictureBox pictSource 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2052
      Left            =   360
      Picture         =   "DEMO.frx":0000
      ScaleHeight     =   1995
      ScaleWidth      =   2475
      TabIndex        =   4
      TabStop         =   0   'False
      Top             =   480
      Width           =   2532
   End
   Begin VB.PictureBox pictDest 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2055
      Left            =   3120
      Picture         =   "DEMO.frx":0B05
      ScaleHeight     =   1995
      ScaleWidth      =   2595
      TabIndex        =   5
      TabStop         =   0   'False
      Top             =   480
      Width           =   2655
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   3240
      Top             =   1800
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      DefaultExt      =   "bmp"
      Filter          =   "Bitmap|*.bmp|All|*.*"
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      Caption         =   "单击源图片改变透明色."
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Left            =   360
      TabIndex        =   9
      Top             =   3360
      Width           =   1875
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "目标图片:"
      Height          =   165
      Left            =   3360
      TabIndex        =   8
      Top             =   120
      Width           =   840
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "源图片:"
      Height          =   165
      Left            =   360
      TabIndex        =   7
      Top             =   120
      Width           =   660
   End
   Begin VB.Shape Shape1 
      FillStyle       =   0  'Solid
      Height          =   255
      Left            =   2040
      Shape           =   1  'Square
      Top             =   3120
      Width           =   615
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "透明色:"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Left            =   1320
      TabIndex        =   6
      Top             =   3120
      Width           =   615
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim cTransparent As Long
#If Win32 Then
    Private Type BITMAP '14 bytes
        bmType As Long
        bmWidth As Long
        bmHeight As Long
        bmWidthBytes As Long
        bmPlanes As Integer
        bmBitsPixel As Integer
        bmBits As Long
    End Type
    Private Declare Function GetObj Lib "gdi32" Alias "GetObjectA" (ByVal _
        hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
#Else
    Private Type BITMAP
        bmType As Integer
        bmWidth As Integer
        bmHeight As Integer
        bmWidthBytes As Integer
        bmPlanes As String * 1
        bmBitsPixel As String * 1
        bmBits As Long
    End Type
    Private Declare Function GetObj Lib "GDI" Alias "GetObject" (ByVal hObject _
        As Integer, ByVal nCount As Integer, bmp As Any) As Integer
#End If

Private Sub Command1_Click()
    Dim bmp As BITMAP
    
    ' Get the dimension of specific bitmap
    GetObj pictSource.Picture, Len(bmp), bmp
    TransparentBlt pictDest.hdc, pictSource.hdc, _
        0, 0, bmp.bmWidth, bmp.bmHeight, 0, 0, cTransparent
End Sub

Private Sub Command2_Click()
    CommonDialog1.FileName = ""
    CommonDialog1.ShowOpen
    If CommonDialog1.FileName <> "" Then
        pictSource.Picture = LoadPicture(CommonDialog1.FileName)
    End If
End Sub

Private Sub Command3_Click()
    CommonDialog1.FileName = ""
    CommonDialog1.ShowOpen
    If CommonDialog1.FileName <> "" Then
        pictDest.Picture = LoadPicture(CommonDialog1.FileName)
    End If
End Sub

Private Sub Command4_Click()
    End
End Sub

Private Sub pictSource_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    cTransparent = pictSource.Point(x, y)
    pictDest.Refresh
    Picture1.Refresh
    Shape1.FillColor = cTransparent
End Sub

Private Sub Form_Activate()
    cTransparent = pictSource.Point(0, 0)
    Shape1.FillColor = cTransparent
End Sub