Allow user to draw on Image Box or Picture Box

Umm... are you trying to draw on the top or bottom image?

If it's the bottom (picturebox) then PSET should do it for you.

Other alternative is to combine the images *first* and then only have the one control.

M

I am trying to draw on the top image.  Yeah, I thought of that...problem is that I really need the top image to be able to be drawn on, and also have a BackStyle of transparent.  Am curious if XGlassPicture Control is what I am looking for, and if so where to get it.  I may have to create my on User Control, something I nothing about.  Hmmmmm, what a world.  Thanks.

Errr...I meant XPictureGlass.

Hi !
I'd realise that on image control doesn't had this "Backstyle" peroperties and how did you make it tranparent ??
Anyway, I guess "API Bitblt" is what you want. It make things easier.

Oh Dear...User Control, eh?  I have just begun to scratch the surface of how to create a User Control, and each attempt fails miserably (Vingamel <----new at this).  Any chance you could give me a quick rundown on creating the UserControl and how to wrap the picturebox.  Thanks gobs.  --Vingamel

To Sendoh: No, the imagebox has no BackStyle property.  I premade pictures with transparent parts and plopped them into image boxes.  Which is great until I try to do anything similar to PSet on the imageboxes (that is, allow the user to draw on the imagebox)...sooooo, I am going to work with mdlilly's proposal and see if it works, but I still open to any other ideas (the main objective: User be able to draw on an image or picture which you can see through).  Thanks Sendoh.  --Vingamel

Yes indeed, I do need some help with this UserControl/wrapped picturebox procedure.  I am increasing the points a bit to hopefully get complete step-by-step help here...like:
1) How do I create the UserControl and wrap the Picture box in it?
2) Where does the code mentioned above get put?  Declarations?  UserControl_GotFocus?  Form_Load?
Thank ya.  --Vingamel

What follows is the code for a picture box, wrapped in a user control, that supports transparency.  I only give this because I cost me 3 weeks of pain and about 5 calls to Microsoft tech support to totally hash this out.  There are limitations, but it does transparency (a feat that Microsoft at first claimed was impossible *brag, brag*).  Anyways...

The process ...
1) create an new user control
2) place a picture box on the control (I named it "Pic")
3) place an image list on the control (I named it "Images")
4) normally run the "Add usercontrol wizard" (to add the default functionality of the control you are wrapping, but I have already done this.
5) add a handler for the Pic's on paint function.  to do all the drawing.
6) you will need to turn the "AutoRedraw" property of the usercontrol off (you will get some terrible flicker otherwise.
7) the "ColorPic" property is a string which needs to be the file name (full path) of the picture you want be transparent.  The transparent color is true black &h00000000 where the mask pic is true white &hffffffff
8) the "MaskPic" is a monochrome mask of the picture you want to be transparent.  True White is for the transparent region, and true black is for the non-opaque region.
9) the property "Transparent" is a boolean flag for whether to use transparency or not.
10) There are some limitations with this method, such as it only
will do transparency between this custom control and it's parent.

The basic concept here is that I to a straight copy of the background onto the picture box, then I bitwise AND the mask picture onto the picture box (black in the mask picture blacks the image, white leaves it intact).  Then I bitwise OR the color picture onto the picture box, black in the picture box OR the color = the color, background image OR black is the background image.

If you have more questions about this control post them and I will check back regularly to answer them.  There may be some peices of this control that may not make sence, this is because in my control I implement several interfaces for use in an application, and my not have deleted all the interface crap, sorry if that happens :)

You will also have to look up some of the API Calls and constants that I use, or if you have alot of trouble finding them ask and I will post them too.

Option Explicit

Private Const MY_NAME = "TransPictureBox"
Private Const ERR_MSG = MY_NAME + " Error"
Private Const LR_FLAGS = LR_LOADFROMFILE Or LR_MONOCHROME Or LR_SHARED
Private myInstanceName As String

Private Const COLOR_KEY = "Color"
Private Const MASK_KEY = "Mask"

Private Const myDefMaskPic = ""
Private Const myDefColorPic = ""
Private Const myDefVisible = True
Private Const myDefisTranparent = False
Private Const myDefAutoResize = False

Private myMaskPic As String
Private myColorPic As String

Private myMaskDC As Long
Private myColorDC As Long

Private myMaskBMP As Long
Private myColorBMP As Long

Private myFinishedBMP As Long
Private myFinishedDC As Long

Private isPainted As Boolean
Private isTransparent As Boolean
Private myVisible As Boolean
Private myAutoResize As Boolean

Event Click()
Event DblClick()
Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

Private Sub Pic_Paint()
On Error GoTo Catch
    If isTransparent Then 'we are using tranparency
        Pic.Picture = Nothing 'clear the current picture
        If Not isPainted Then 'the current image needs to be updated not just reloaded
            Dim kid As RECT
            Dim dad As RECT
            Call GetWindowRect(Pic.hwnd, kid) 'get my location on the screen
            Call GetWindowRect(UserControl.Parent.hwnd, dad) 'get my parents location
            If UserControl.Parent.BorderStyle <> 0 Then 'if it has a border allow for the border
                dad.Top = dad.Top + _
                          ((UserControl.Parent.Height - UserControl.Parent.ScaleHeight) _
                          / (Screen.TwipsPerPixelY)) - 3
                dad.Left = dad.Left + 3
            End If
               
            If UserControl.Parent.Picture <> 0 Then 'the parent has a picture
                'Copy the parent's picture onto myself (makes me totally transparent)
                Call Pic.PaintPicture(UserControl.Parent.Picture, _
                                      0, _
                                      0, _
                                      Pic.Width, _
                                      Pic.Height, _
                                      kid.Left - dad.Left, _
                                      kid.Top - dad.Top, _
                                      Pic.Width, _
                                      Pic.Height, _
                                      vbSrcCopy)
            Else    'use the parents color
                Pic.BackColor = UserControl.Parent.BackColor
            End If
           
            'copy my images onto myself after the parents images have been copied
            Call paintBlt(myColorPic, COLOR_KEY, myMaskPic, MASK_KEY, Images, Pic)
           
            'get a copy of this finished product to use in redraws to save time
            Call DeleteObject(myFinishedBMP)
            Call DeleteDC(myFinishedDC)
            myFinishedDC = CreateCompatibleDC(Pic.hdc)
            myFinishedBMP = CreateCompatibleBitmap(Pic.hdc, Pic.Width, Pic.Height)
            DeleteDC (SelectObject(myFinishedDC, myFinishedBMP))
            Call BitBlt(myFinishedDC, _
                        0, _
                        0, _
                        Pic.Width, _
                        Pic.Height, _
                        Pic.hdc, _
                        0, _
                        0, _
                        SRCCOPY)
                                 
            isPainted = True
        Else
            Call BitBlt(Pic.hdc, _
                        0, _
                        0, _
                        Pic.Width, _
                        Pic.Height, _
                        myFinishedDC, _
                        0, _
                        0, _
                        SRCCOPY)
        End If
    Else    'the image is not transparent so just load the image
        If isAvailable(myColorPic) And Images.ListImages.Count > 0 Then
            Set Pic.Picture = Images.ListImages(COLOR_KEY).Picture
        End If
    End If
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Sub

Private Sub UserControl_InitProperties()
On Error GoTo Catch
    isTransparent = myDefisTranparent
    ColorPic = myDefColorPic
    MaskPic = myDefMaskPic
    myAutoResize = myDefAutoResize
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Sub

Private Sub UserControl_Resize()
On Error GoTo Catch
    resize
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Sub

Private Sub resize()
On Error GoTo Catch
    Pic.Top = 0
    Pic.Left = 0
    If myAutoResize Then
        Pic.Width = Images.ImageWidth
        Pic.Height = Images.ImageHeight
        UserControl.Width = Pic.Width * Screen.TwipsPerPixelX
        UserControl.Height = Pic.Height * Screen.TwipsPerPixelY
    Else
        Pic.Width = UserControl.Width
        Pic.Height = UserControl.Height
        UserControl.Width = Pic.Width
        UserControl.Height = Pic.Height
    End If
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Sub

Private Sub UserControl_Show()
On Error GoTo Catch
    Init
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Sub

Private Sub UserControl_Terminate()
On Error GoTo Catch
    'delete the dc's and bmps that you have created
    Call DeleteObject(myMaskBMP)
    Call DeleteDC(myMaskDC)
    Call DeleteObject(myColorBMP)
    Call DeleteDC(myColorDC)
   
    Call DeleteObject(myFinishedBMP)
    Call DeleteDC(myFinishedDC)
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
On Error GoTo Catch
    myColorPic = PropBag.ReadProperty("ColorPic", myDefColorPic)
    myMaskPic = PropBag.ReadProperty("MaskPic", myDefMaskPic)
    UserControl.Width = PropBag.ReadProperty("Width", 0)
    UserControl.Height = PropBag.ReadProperty("Height", 0)
    Pic.Enabled = PropBag.ReadProperty("Enabled", True)
    isTransparent = PropBag.ReadProperty("Transparent", myDefisTranparent)
    myAutoResize = PropBag.ReadProperty("AutoResize", myDefAutoResize)
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
On Error GoTo Catch
    Call PropBag.WriteProperty("ColorPic", myColorPic, myDefColorPic)
    Call PropBag.WriteProperty("MaskPic", myMaskPic, myDefMaskPic)
    Call PropBag.WriteProperty("Width", UserControl.Width, 0)
    Call PropBag.WriteProperty("Height", UserControl.Height, 0)
    Call PropBag.WriteProperty("Enabled", Pic.Enabled, True)
    Call PropBag.WriteProperty("Transparent", isTransparent, myDefisTranparent)
    Call PropBag.WriteProperty("AutoResize", myAutoResize, myDefAutoResize)
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Sub

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=Pic,Pic,-1,Refresh
Public Sub Refresh()
On Error GoTo Catch
    isPainted = False
    If Me.Visible Then
        Pic_Paint
    End If
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Sub

Private Sub Pic_Click()
On Error GoTo Catch
    If isInMask Or Not isTransparent Then
        RaiseEvent Click
    End If
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Sub

Private Sub Pic_DblClick()
On Error GoTo Catch
    If isInMask Or Not isTransparent Then
        RaiseEvent DblClick
    End If
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Sub

Private Sub Pic_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error GoTo Catch
    If isInMask Or Not isTransparent Then
        RaiseEvent MouseDown(Button, Shift, x, y)
    End If
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Sub

Private Sub Pic_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error GoTo Catch
    If isInMask Or Not isTransparent Then
        RaiseEvent MouseMove(Button, Shift, x, y)
    End If
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Sub

Private Sub Pic_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error GoTo Catch
    If isInMask Or Not isTransparent Then
        RaiseEvent MouseUp(Button, Shift, x, y)
    End If
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Sub

Private Function isInMask() As Boolean
On Error GoTo Catch
    Dim pt As POINTAPI
    Dim Box As RECT
   
    'Get the mouse's position on the screen and the picture's position on the screen,
    'then calculate the mouse's position relative to the picture
    Call GetCursorPos(pt)
    Call GetWindowRect(Pic.hwnd, Box)
    pt.x = pt.x - Box.Left
    pt.y = pt.y - Box.Top
    'Get the pixel at the mouse's cordinates from the mask picture and compare that color to
    'black (aka 0), if they match we are in the mask, or inother words in the non tranparent
    'portion of the image.
    If GetPixel(myMaskDC, pt.x, pt.y) = 0 Then
        isInMask = True
    Else
        isInMask = False
    End If
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Function

''WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
''MappingInfo=UserControl,UserControl,0,Width
Public Property Get Width() As Long
On Error GoTo Catch
    Width = UserControl.Width
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Property

Public Property Let Width(ByVal New_Width As Long)
On Error GoTo Catch
    UserControl.Width = New_Width
    PropertyChanged "Width"
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Property

''WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
''MappingInfo=UserControl,UserControl,0,Height
Public Property Get Height() As Long
On Error GoTo Catch
    Height = UserControl.Height
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Property

Public Property Let Height(ByVal New_Height As Long)
On Error GoTo Catch
    UserControl.Height = New_Height
    PropertyChanged "Height"
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Property

''WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
''MappingInfo=Pic,Pic,-1,Visible
Public Property Get Visible() As Boolean
On Error GoTo Catch
    Visible = Pic.Visible
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Property

Public Property Let Visible(ByVal New_Visible As Boolean)
On Error GoTo Catch
    Pic.Visible = New_Visible
    PropertyChanged "Visible"
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Property

Public Property Get Transparent() As Boolean
On Error GoTo Catch
    Transparent = isTransparent
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Property

Public Property Let Transparent(ByVal New_Transparent As Boolean)
On Error GoTo Catch
    isTransparent = New_Transparent
    Refresh
    PropertyChanged "Transparent"
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=Pic,Pic,-1,hWnd
Public Property Get hwnd() As Long
On Error GoTo Catch
    hwnd = Pic.hwnd
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=Pic,Pic,-1,hDC
Public Property Get hdc() As Long
On Error GoTo Catch
    hdc = Pic.hdc
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=Pic,Pic,-1,HasDC
Public Property Get HasDC() As Boolean
On Error GoTo Catch
    HasDC = Pic.HasDC
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=Pic,Pic,-1,Enabled
Public Property Get Enabled() As Boolean
On Error GoTo Catch
    Enabled = Pic.Enabled
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)
On Error GoTo Catch
    Pic.Enabled = New_Enabled
    PropertyChanged "Enabled"
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=Pic,Pic,-1,BorderStyle
Public Property Get BorderStyle() As Integer
On Error GoTo Catch
    BorderStyle = Pic.BorderStyle
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Property

Public Property Let BorderStyle(ByVal New_BorderStyle As Integer)
On Error GoTo Catch
    Pic.BorderStyle() = New_BorderStyle
    PropertyChanged "BorderStyle"
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=Pic,Pic,-1,BackColor
Public Property Get BackColor() As OLE_COLOR
On Error GoTo Catch
    BackColor = Pic.BackColor
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
On Error GoTo Catch
    Pic.BackColor() = New_BackColor
    PropertyChanged "BackColor"
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Property

Public Property Get AutoResize() As Boolean
On Error GoTo Catch
    AutoResize = myAutoResize
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Property

Public Property Let AutoResize(ByVal New_AutoResize As Boolean)
On Error GoTo Catch
    myAutoResize = New_AutoResize
    resize
    PropertyChanged "AutoResize"
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Property

Public Property Get MaskPic() As String
On Error GoTo Catch
    MaskPic = myMaskPic
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Property

Public Property Let MaskPic(ByVal New_MaskPic As String)
On Error GoTo Catch
    myMaskPic = New_MaskPic
    Init
    PropertyChanged "MaskPic"
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Property

Public Property Get ColorPic() As String
On Error GoTo Catch
    ColorPic = myColorPic
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Property

Public Property Let ColorPic(ByVal New_ColorPic As String)
On Error GoTo Catch
    myColorPic = New_ColorPic
    Init
    PropertyChanged "ColorPic"
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Property

Private Sub Init()
On Error GoTo Catch
    'Before we can update images in the image list we need to clear them so we don't try to
    'repeat image keys
    Images.ListImages.Clear
   
    'Load the mask and color images into the imagelist
    Call SetMaskPic(myMaskPic, MASK_KEY, myMaskDC, myMaskBMP)
    Call SetColorPic(myColorPic, COLOR_KEY)
   
    'create the dc and bmp for the dc and bmp to use to refresh the picture
    If myFinishedDC <> 0 Then
        Call DeleteDC(myFinishedDC)
    End If
    myFinishedDC = CreateCompatibleDC(Pic.hdc)
    If myFinishedBMP <> 0 Then
        Call DeleteObject(myFinishedBMP)
    End If
    myFinishedBMP = CreateCompatibleBitmap(Pic.hdc, Pic.Width, Pic.Height)
    Refresh
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Sub

Private Function SetColorPic(ByVal aColorPic As String, ByVal anImageListKey As String) As Boolean
On Error GoTo Catch
    If isAvailable(aColorPic) Then
        'Add the color picture to the image list
        Images.ListImages.Add , (anImageListKey), LoadPicture(aColorPic)
        'set the pictures size based off the image that was loaded
        Pic.Width = Images.ListImages(anImageListKey).Picture.Width
        Pic.Width = Pic.ScaleX(Pic.Width, vbHimetric, vbPixels)
        UserControl.Height = Images.ListImages(anImageListKey).Picture.Height
        UserControl.Height = Pic.ScaleY(Pic.Height, vbHimetric, vbPixels)
        AutoResize = True
        SetColorPic = True
    Else
        SetColorPic = False
    End If
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Function

Private Function SetMaskPic(ByVal aMaskPic As String, _
                            ByVal anImageListKey As String, _
                            ByRef aMaskDC As Long, _
                            ByRef aMaskBMP As Long) As Boolean
On Error GoTo Catch
    If isAvailable(aMaskPic) Then
        'Load the mask image into the image list
        Images.ListImages.Add , (anImageListKey), LoadPicture(aMaskPic)
        'Make new a new dc and bmp for the mask image
        DeleteDC (aMaskDC)
        DeleteObject (aMaskBMP)
        aMaskDC = CreateCompatibleDC(Pic.hdc)
        aMaskBMP = LoadImage(0, aMaskPic, IMAGE_BITMAP, 0, 0, LR_FLAGS)
        DeleteObject (SelectObject(aMaskDC, aMaskBMP))
        SetMaskPic = True
    Else
        SetMaskPic = False
    End If
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Function

Okay...bear with me here...for me this is like, "son, this is particle accelerator...put it together".  Lemme see...LR_LOADFROMFILE came up with Variable Not Defined, so I commented it out.  
Call DeleteDC came up with Sub or Function not defined.
Your step 5, add a handler for the Pic's paint function...is this in the code or is this something I need to add?
I apologize but all of this UserControl stuff is brand-spankin' new, and I want to learn it, but at the same time I don't want to be a pest.  
Do I save the user control (once functional) and plop it onto a new form to begin?  Thanks.  If I get this working I'll up the points even more because this is the longest I've been stalled in my project.  --Vingamel  Brady.Boyd@Yellowcorp.com

Hey don't sweat it, I busted my butt for what seems like forever on trying to get transparency in VB.

The Pic_Paint function is already in there, I was just explaining the process I went through to do what I did.  Since it is the Pic_Paint function that gets called whenever windows sends a paint message to that picture box, it will be the function you will do most of your "hard core coding" in when it comes to graphics.

Once you have a working control, you can compile it into and ocx and then load it like you would any control and then plop it on any old form you would like, and hopefully (fingers crossed) it will do what you want it to do.

If you have any more questions, or if I still am missing some code, just tell me and I'll do my best to rectify the situation.

M. David Lilly

place this code in a module:
Public Const LR_LOADFROMFILE = &H10
Public Const LR_MONOCHROME = &H1
Public Const LR_SHARED = &H8000&
Public Const IMAGE_BITMAP = 0

'Delete DC's if you create them
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
'Creates a bitmap that is compatible with a given DC
Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, _
                                                            ByVal nWidth As Long, _
                                                            ByVal nHeight As Long) As Long
'Creates a DC that is compatible to a given dc
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
'Delete DC's if you create them
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
'Used for tiling
'Gets the window rectangle in screen cordinates
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, _
                                                    lpRect As RECT) As Long
'Creates a handle to a bitmap in memory from a bitmap file
Public Declare Function LoadImage Lib "user32" Alias _
                       "LoadImageA" (ByVal hInst As Long, _
                                     ByVal lpsz As String, _
                                     ByVal un1 As Long, _
                                     ByVal n1 As Long, _
                                     ByVal n2 As Long, _
                                     ByVal un2 As Long) As Long
'Selects an object to use on a DC and returns the last object (should be saved to restore it)
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, _
                                                  ByVal hObject As Long) As Long

Here is another module I added sorry forgot about it earlier:
Option Explicit

Private Const MY_NAME = "TranPictureBoxMod"
Private Const ERR_MSG = MY_NAME + " Error"

'This function requres that the VB project include the control that has ImageList in it
'Probably Microsoft Common Controls 6.0
'This function uses a mask and a color picture to tranparently put the color picture onto a
'picture box
'Limitations:
'-  must have the tranparent color on the color pic be black
'-  must have a black and white picture that serves as a mask where the visible portion of the
'   color picture is black and the invisible portion is white.
Public Sub paintBlt(ByVal aColorPic As String, _
                    ByVal aColorKey As String, _
                    ByVal aMaskPic As String, _
                    ByVal aMaskKey As String, _
                    ByRef aImageList As MSComctlLib.ImageList, _
                    ByRef aPic As PictureBox)
On Error GoTo Catch
    If isAvailable(aMaskPic) And aImageList.ListImages.Count > 0 Then
        'Bitwise AND the mask picture with the background, since the mask is black and white
        'the result will be a picture with a black hole where the color image will be put, and
        'since white (RGB == 1) anything and 1 is anything
        Call aPic.PaintPicture(aImageList.ListImages(aMaskKey).Picture, _
                               0, _
                               0, _
                               , _
                               , _
                               , _
                               , _
                               , _
                               , _
                               vbSrcAnd) 'vbSrcAnd is the AND flag
    End If

    If isAvailable(aColorPic) And aImageList.ListImages.Count > 0 Then
        'Bitwise OR the color picture onto the picturebox.  Since the transparent color is
        'black (RGB == 0) anything OR anything is anything, and since there is a black hole
        'where the color picture will be the color picture OR the black hole becomes the color
        'picture.
        Call aPic.PaintPicture(aImageList.ListImages(aColorKey).Picture, _
                               0, _
                               0, _
                               , _
                               , _
                               , _
                               , _
                               , _
                               , _
                               vbSrcPaint) 'vbSrcPaint is the OR flag
    End If
GoTo Final
Catch:
    Call Err.Raise(Err.Number, ERR_MSG, Str(Err.Number) + " " + Err.Description)
Final:
End Sub

Okay, plopped first part into 1st module, and second part into second module, and got error message: Ambiguous Name detected:
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Thanks.   --Vingamel

what OS/compiler are you using?

Okay, plopped first part into 1st module, and second part into second module, and got error message: Ambiguous Name detected:
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Thanks.   --Vingamel

Do you have DeleteDC defined somewhere else?  

Do you have DeleteDC defined somewhere else?  

Okay, plopped first part into 1st module, and second part into second module, and got error message: Ambiguous Name detected:
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Thanks.   --Vingamel

Oh...you had it listed twice (see above) and I didn't notice it...just cut & paste it now.  Now I have message: User-Defined type not defined:
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, _
                                                    lpRect As RECT) As Long

sorry to keep bugging you, and normally I would just debug this stuff, but being new to API stuff, I'm like a baboon trying to set the time on the VCR

Oh...you had it listed twice (see above) and I didn't notice it...just cut & paste it now.  Now I have message: User-Defined type not defined:
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, _
                                                    lpRect As RECT) As Long

sorry to keep bugging you, and normally I would just debug this stuff, but being new to API stuff, I'm like a baboon trying to set the time on the VCR

Oh...you had it listed twice (see above) and I didn't notice it...just cut & paste it now.  Now I have message: User-Defined type not defined:
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, _
                                                    lpRect As RECT) As Long

sorry to keep bugging you, and normally I would just debug this stuff, but being new to API stuff, I'm like a baboon trying to set the time on the VCR

Oh...you had it listed twice (see above) and I didn't notice it...just cut & paste it now.  Now I have message: User-Defined type not defined:
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, _
                                                    lpRect As RECT) As Long

sorry to keep bugging you, and normally I would just debug this stuff, but being new to API stuff, I'm like a baboon trying to set the time on the VCR

Oh...you had it listed twice (see above) and I didn't notice it...just cut & paste it now.  Now I have message: User-Defined type not defined:
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, _
                                                    lpRect As RECT) As Long

sorry to keep bugging you, and normally I would just debug this stuff, but being new to API stuff, I'm like a baboon trying to set the time on the VCR

Oh...you had it listed twice (see above) and I didn't notice it...just cut & paste it now.  Now I have message: User-Defined type not defined:
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, _
                                                    lpRect As RECT) As Long

sorry to keep bugging you, and normally I would just debug this stuff, but being new to API stuff, I'm like a baboon trying to set the time on the VCR

Oh...you had it listed twice (see above) and I didn't notice it...just cut & paste it now.  Now I have message: User-Defined type not defined:
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, _
                                                    lpRect As RECT) As Long

sorry to keep bugging you, and normally I would just debug this stuff, but being new to API stuff, I'm like a baboon trying to set the time on the VCR

Oh...you had it listed twice (see above) and I didn't notice it...just cut & paste it now.  Now I have message: User-Defined type not defined:
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, _
                                                    lpRect As RECT) As Long

sorry to keep bugging you, and normally I would just debug this stuff, but being new to API stuff, I'm like a baboon trying to set the time on the VCR

There is a tool you can use it is called something like API viewer or somesuch you should be able to get to it by clicking on Add-ins->Add-in Manager you can use this to get API stuff when you know what to look for, else you can just do it manually from help *ooooo help* :P

You'll need to put these in a module:
Public Type POINTAPI
        x As Long
        y As Long
End Type

Public Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Mr. Lilly: You have been very patient with me on this.  I will only have time tomorrow to work on this some more...do you want the points I have offered now or would you prefer to wait until I get this working (in which I will throw in some more points).  Regarding your OS/Compiler question: I am not certain what this means...I am on Windows 95 at home and NT at work, and I use the compiler I guess that comes with VB 6.0.  Thanks!!  --Vingamel

As far as to points go ... really they are not that big of a deal to me, so what ever/when ever you want is fine.  If you have any more questions feel free.  I still remember a few months ago when I posted a similar question ang got zero usable responces.

So if I can help you because of my former trials, more's the better.

Maybe I am doing something wrong.  I have all the code in place as you have here, the ImageList & Picturebox on the form and named correctly.  I then hit RUN and get error: Compile Error: User-Defined Type Not Defined.  This is in Module 1, Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long.  Am I doing something wrong.  Thanks.  --Vingamel

I commented out the line noted above and hit RUN and now I get a SUB or FUNCTION not DEFINED on this code:
Private Function SetMaskPic(ByVal aMaskPic As String, _
                            ByVal anImageListKey As String, _
                            ByRef aMaskDC As Long, _
                            ByRef aMaskBMP As Long) As Boolean
On Error GoTo Catch
    If isAvailable(aMaskPic) Then...

Oops, another function I've created and didn't include ... sorry.
This I have in a module.

'Returns whether a file exists or not
Public Function isAvailable(ByVal aFile As String) As Boolean
On Error GoTo Catch
    Dim fs As Variant
    Set fs = CreateObject("Scripting.FileSystemObject")
    If fs.fileexists(aFile) Then
        isAvailable = True
    Else
        isAvailable = False
    End If
GoTo Final
Catch:
    isAvailable = False
Final:
End Function

Okay, got that done, but still having same problem with GetWindowRectLIB where it shows User-Defined Type not Defined.  So I commented it out again just to check for other things and got a Sub or Function not defined on the RECT in the following:
Private Sub Pic_Paint()
On Error GoTo Catch
    If isTransparent Then 'we are using tranparency
        Pic.Picture = Nothing 'clear the current picture
        If Not isPainted Then 'the current image needs to be updated not just reloaded
            Dim kid As RECT
I assume this is because of the line I had to comment out...
Also, when  I run this it opens Internet Explorer with the following address: C:\Program Files\Microsoft Visual Studio\VB98\UserControl1.html with a blank screen.

Have you included the Public Type RECT that I posted previously?

that could be the problem

Okay, got that done, but still having same problem with GetWindowRectLIB where it shows User-Defined Type not Defined.  So I commented it out again just to check for other things and got a Sub or Function not defined on the RECT in the following:
Private Sub Pic_Paint()
On Error GoTo Catch
    If isTransparent Then 'we are using tranparency
        Pic.Picture = Nothing 'clear the current picture
        If Not isPainted Then 'the current image needs to be updated not just reloaded
            Dim kid As RECT
I assume this is because of the line I had to comment out...
Also, when  I run this it opens Internet Explorer with the following address: C:\Program Files\Microsoft Visual Studio\VB98\UserControl1.html with a blank screen.

The default way to debug controls in VB is through IE, what you need to do so that you get something, is to fill out the DEF_COLOR_IMAGE (or PIC I don't recal) property.  But for more ture functionality you need to place this control on a form.  Do this by adding a form to your project then setting the starup object as that form.  You will also need to switcht the project type from ActiveX control to Standard .EXE

Duh, Brady...okay, got that and things are looking much better...actually seeing something happening.  Next error message: Variable not defined SRCCOPY (in the Private Sub Pic_Paint).  Almost there :-)

Duh, Brady...okay, got that and things are looking much better...actually seeing something happening.  Next error message: Variable not defined SRCCOPY (in the Private Sub Pic_Paint).  Almost there :-)

Put in a module:

Public Const SRCCOPY = &HCC0020

Duh, Brady...okay, got that and things are looking much better...actually seeing something happening.  Next error message: Variable not defined SRCCOPY (in the Private Sub Pic_Paint).  Almost there :-)

And now the BitBlt Sub or Function is not defined...I have that somewhere, but not sure if your syntax will be different from what I have.  Sank U.  --Vingnut

And now the BitBlt Sub or Function is not defined...I have that somewhere, but not sure if your syntax will be different from what I have.  Sank U.  --Vingnut

And now the BitBlt Sub or Function is not defined...I have that somewhere, but not sure if your syntax will be different from what I have.  Sank U.  --Vingnut

Yes, I know I have it (BitBlt Function)saved on my computer at home, but if you have it handy I can plop it in now and give 'er a test run.  I have increased the points.  You deserve it for your patience and beyond-the-call-of-duty assistance.  --Ving

Okay, I found BitBlt at a website, got it working...
Now Call GetCursorPos(pt) is one I don't have and it is not defined.  
GetPixel is also not defined.

place this code in a module to define API calls:

'Delete DC's if you create them
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
'Creates a bitmap that is compatible with a given DC
Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, _
                                                            ByVal nWidth As Long, _
                                                            ByVal nHeight As Long) As Long
'Creates a DC that is compatible to a given dc
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
'Delete DC's if you create them
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
'Used for tiling
'Gets the window rectangle in screen cordinates
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, _
                                                    lpRect As RECT) As Long
'Creates a handle to a bitmap in memory from a bitmap file
Public Declare Function LoadImage Lib "user32" Alias _
                       "LoadImageA" (ByVal hInst As Long, _
                                     ByVal lpsz As String, _
                                     ByVal un1 As Long, _
                                     ByVal n1 As Long, _
                                     ByVal n2 As Long, _
                                     ByVal un2 As Long) As Long
'Selects an object to use on a DC and returns the last object (should be saved to restore it)
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, _
                                                  ByVal hObject As Long) As Long

Already had those in, Sir, per earlier stuff you sent me.  I found GetPixel at http://www.perplexed.com/GPMega/vb/ddtut02.htm
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
So next I need to find the GetCursorPos Function.  
We're so close...my program that will help me take over the whole world is almost there.  :-)  I am going to accept your answer now...I hope you can still answer any questions as I tweak this thing.  Thank you.  
--Vingamel AKA Brady.Boyd@Yellowcorp.com

sure, just ask and I'll see if I can answer.

Just as irony/humor/sucks to be me side, today we had some MS senior consultants in, and they were looking over my code, and they informed me of a supposed WAY better method, but I have not had a chance to try it out yet.  If you are interested it involves the OnHitTest event which I didn't know existed, but ... per senior MS consultants is the STUFF!  Well, there is a tip, I don't know how good of a tip, but it (along with some other stuff) cost the company in excess of $1000 this morning :)

Catch you later.
mdl

And now I found the GetCursorPos at:
http://www.vb-world.net/tips/tip65.html
I compiled, and got no errors.  Cheers!!!  Whew, I can only imagine the hell you went through to get all this info in the first place. My hats off to you.  You have my E-Mail address if you are interested in play-testing my strategy game once it is ready.  Thanks.  --Brady Boyd

Say, Mr. Lilly: I am hitting a wall on a couple of things.
1) When I try to change UserControl Transparent property to True I get a Stack 28 error.
2) Second, I can't figure out how to use the darn thing now that I have it working.  How do I get layers of images into the usercontrol so that I can get the same effect as Overlay (see original question).  Thanks.  --Vingamel