|
Other Tips
All Tips
By Date
By Subject
API (33)
Bit
Manipulation (3)
Clipboard (3)
Combo
Box (5)
Desktop (3)
GDI (13)
Graphics (13)
Internet (2)
Interprocess
Comms (3)
Keyboard (2)
Mouse (1)
Shell (1)
Sprites (1)
Subclassing (3)
Text
Box (2)
Windows (11)
Windows
Controls (10)
Submit
|
This tip shows you how to create a mask image from a picture. Mask images are useful
for emulating transparency, and for replacing colours in images. This comes about
because they are black where you want to leave an image unaffected, and white otherwise.
Because they are either on or off, you can use boolean operations while copying the
mask image elsewhere.
Start a new project in VB. Add a new module, then add the following
code to it:
' Creates a memory DC
Private Declare Function CreateCompatibleDC Lib "gdi32" ( _
    ByVal hDC As Long _
    ) As Long
' Creates a bitmap in memory:
Private Declare Function CreateCompatibleBitmap Lib "gdi32" ( _
    ByVal hDC As Long, _
    ByVal nWidth As Long, ByVal nHeight As Long _
    ) As Long
' Places a GDI Object into DC, returning the previous one:
Private Declare Function SelectObject Lib "gdi32" _
    (ByVal hDC As Long, ByVal hObject As Long _
    ) As Long
' Deletes a GDI Object:
Private Declare Function DeleteObject Lib "gdi32" _
    (ByVal hObject As Long _
    ) As Long
' Copies Bitmaps from one DC to another, can also perform
' raster operations during the transfer:
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 Const SRCCOPY = &HCC0020
' Sets the backcolour of a device context:
Private Declare Function SetBkColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
Public Function CreateMaskImage( _
        ByRef picFrom As PictureBox, _
        ByRef picTo As PictureBox, _
        Optional ByVal lTransparentColor As Long = -1 _
    ) As Boolean
Dim lhDC As Long
Dim lhBmp As Long
Dim lhBmpOld As Long
   
   
' Make picTo the same size as picFrom and clear it:
    With picTo
        .Width = picFrom.Width
        .Height = picFrom.Height
        .Cls
    End With
   
   
' Create a monochrome DC & Bitmap of the
   
' same size as the source picture:
    lhDC = CreateCompatibleDC(0)
    If (lhDC 0) Then
        lhBmp = CreateCompatibleBitmap(lhDC, picFrom.ScaleWidth \ Screen.TwipsPerPixelX, picFrom.ScaleHeight \ Screen.TwipsPerPixelY)
        If (lhBmp 0) Then
            lhBmpOld = SelectObject(lhDC, lhBmp)
           
           
' Set the back 'colour' of the monochrome
           
' DC to the colour we wish to be transparent:
            If (lTransparentColor = -1) Then lTransparentColor = picFrom.BackColor
            SetBkColor lhDC, lTransparentColor
           
           
' Copy from the from picture to the monochrome DC
           
' to create the mask:
            BitBlt lhDC, 0, 0, picFrom.ScaleWidth \ Screen.TwipsPerPixelX, picFrom.ScaleHeight \ Screen.TwipsPerPixelY, picFrom.hDC, 0, 0, SRCCOPY
           
           
' Now put the mask into picTo:
            BitBlt picTo.hDC, 0, 0, picFrom.ScaleWidth \ Screen.TwipsPerPixelX, picFrom.ScaleHeight \ Screen.TwipsPerPixelY, lhDC, 0, 0, SRCCOPY
            picTo.Refresh
           
           
' Clear up the bitmap we used to create
           
' the mask:
            SelectObject lhDC, lhBmpOld
            DeleteObject lhBmp
        End If
       
' Clear up the monochrome DC:
        DeleteObject lhDC
    End If
   
   
End Function
To test out the function, add a Command button and two Picture Boxes to the project's form.
Set the Autoredraw property on both Picture boxes to true.
The following code will create a mask image in the second Picture box (Picture2) from the
image in Picture1 when you click the Command button::
Private Sub Command1_Click()
    CreateMaskImage Picture1, Picture2
End Sub
Private Sub Form_Load()
Dim i As Long
   
' Draw something in the from picture box.
   
' Alternatively, you could load a picture
   
' into it and set the BackColor to the
   
' colour you want to make transparent.
    Picture1.BackColor = &HFFFF00
    With Picture1.Font
        .Name = "Arial"
        .Bold = True
        .Italic = True
        .Size = 12
    End With
    For i = 1 To 20
        Picture1.ForeColor = QBColor(i Mod 15)
        Picture1.Print "vbAccelerator Mask Demo"
    Next i
End Sub
|
Author: