Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 260
  • Last Modified:

I need something like a "transparent" container

I've a lot of controls (mostly Images) contained in a picbox, 'cause i need to hide and show the whole group in a single PicBoxContainer.visible=MyVar.

The problem is that the PicBox is not transparent, and i need to show things under it.

There's a way to "create" a transparent control container, or to make the PicBox transparent?
I'll like to avoid to use (and distribute) OCX or DLL (if possible).
0
fcp
Asked:
fcp
1 Solution
 
supunrCommented:
why don't you use a image control with transparent pictures (Transparent GIFs or ICons) add to it....

Good Luck!
0
 
JohnMcCannCommented:
One method

Private Declare Function CreateRectRgn Lib _
   "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, _
   ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib _
   "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, _
   ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function SetWindowRgn Lib _
   "user32" (ByVal hWnd As Long, ByVal hRgn As Long, _
   ByVal bRedraw As Boolean) As Long
Private Declare Function DeleteObject Lib _
   "gdi32" (ByVal hObject As Long) As Long

' Constants used by the CombineRgn function
Private Const RGN_AND = 1
Private Const RGN_OR = 2
Private Const RGN_XOR = 3
Private Const RGN_DIFF = 4
Private Const RGN_COPY = 5

Private Sub cmdExit_Click()
   Unload Me
End Sub

Private Sub Form_Activate()
   Dim rgnPic As Long, rgnCombined As Long
   Dim rgnControl As Long, x As Long
   Dim ctlLeft As Single, ctlTop As Single
   Dim ctlWidth As Single, ctlHeight As Single
   Dim ctl As Control

   ' Create a region for the whole form
   rgnForm = CreateRectRgn(0, 0, picture1.width, picture1.Height)
   
   rgnCombined = CreateRectRgn(0, 0, 0, 0)
   ' Make the graphical area transparent by combining the two regions
   x = CombineRgn(rgnCombined, rgnPic , rgnPic , RGN_DIFF)

   For Each ctl In Controls
       If TypeOf ctl.Container Is Form Then
           ctlLeft = ScaleX(ctl.Left, vbTwips, vbPixels) + borderWidth
           ctlTop = ScaleX(ctl.Top, vbTwips, vbPixels) + titleHeight
           ctlWidth = ScaleX(ctl.Width, vbTwips, vbPixels) + ctlLeft
           ctlHeight = ScaleX(ctl.Height, vbTwips, vbPixels) + ctlTop
           rgnControl = CreateRectRgn(ctlLeft, ctlTop, ctlWidth, ctlHeight)
           x = CombineRgn(rgnCombined, rgnCombined, rgnControl, RGN_OR)
       End If
   Next ctl
 
   SetWindowRgn hWnd, rgnCombined, True
   x = DeleteObject(rgnCombined)
   x = DeleteObject(rgnControl)
   x = DeleteObject(rgnForm)
End Sub

0
 
JohnMcCannCommented:
This line

SetWindowRgn hWnd, rgnCombined, True
 
should read

SetWindowRgn picture1.hWnd, rgnCombined, True
 
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
JohnMcCannCommented:
If you create a new usercontrol and paste the following code.  The code simply masks the backcolor out so the backcolor must not be used by any control.  You will need to set AutoRedraw to true

Option Explicit

Private Const RC_PALETTE As Long = &H100
Private Const SIZEPALETTE As Long = 104
Private Const RASTERCAPS As Long = 38

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type

Private Type PicBmp
    Size As Long
    Type As Long
    hBmp As Long
    hPal As Long
    Reserved As Long
End Type

Private Type PALETTEENTRY
    peRed As Byte
    peGreen As Byte
    peBlue As Byte
    peFlags As Byte
End Type

Private Type LOGPALETTE
    palVersion As Integer
    palNumEntries As Integer
    palPalEntry(255) As PALETTEENTRY ' Enough for 256 colors
End Type

Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
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 Declare Function CreateCompatibleBitmap Lib "GDI32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "GDI32" (ByVal hDC As Long) As Long
Private Declare Function CreatePalette Lib "GDI32" (lpLogPalette As LOGPALETTE) As Long
Private Declare Function DeleteDC Lib "GDI32" (ByVal hDC As Long) As Long
Private Declare Function GetCurrentObject Lib "GDI32" (ByVal hDC As Long, ByVal uObjectType As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "GDI32" (ByVal hDC As Long, ByVal iCapabilitiy As Long) As Long
Private Declare Function GetSystemPaletteEntries Lib "GDI32" (ByVal hDC As Long, ByVal wStartIndex As Long, ByVal wNumEntries As Long, lpPaletteEntries As PALETTEENTRY) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Private Declare Function RealizePalette Lib "GDI32" (ByVal hDC As Long) As Long
Private Declare Function SelectObject Lib "GDI32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function SelectPalette Lib "GDI32" (ByVal hDC As Long, ByVal hPalette As Long, ByVal bForceBackground As Long) As Long

Private m_Initializing              As Boolean

Private Sub UserControl_Initialize()
   m_Initializing = True
End Sub

Private Sub UserControl_InitProperties()
   m_Initializing = False
   pDraw
End Sub

Private Sub UserControl_Paint()
   If Not m_Initializing Then pDraw
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
   m_Initializing = False
   pDraw
End Sub

Private Sub UserControl_Resize()
   If Not m_Initializing Then pDraw
End Sub

Private Sub pDraw()
On Error GoTo Err_Handler

Static bPainting As Boolean

Start_Painting:
   If bPainting Then Exit Sub
   bPainting = True
   LockWindowUpdate hWnd
   With UserControl
      If .MaskPicture <> 0 Then Set .MaskPicture = Nothing
      If .BackStyle <> 1 Then .BackStyle = 1
      If .ScaleMode <> vbPixels Then .ScaleMode = vbPixels
      .Cls
   End With
   DoEvents
         
Draw_Mask:
   Set UserControl.MaskPicture = CreatePictureFromDC(hDC, 0, 0, ScaleWidth, ScaleHeight)
   UserControl.MaskColor = UserControl.BackColor
   UserControl.BackStyle = 0
   
Exit_Handler:
   LockWindowUpdate False
   bPainting = False
   Exit Sub
   
Err_Handler:
   MsgBox TypeName(Me) & " - " & "pDraw" & " - " & Err.Description
   Resume Exit_Handler
End Sub

Private Function CreatePictureFromDC(ByVal hDCSrc As Long, ByVal LeftSrc As Long, ByVal TopSrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long) As Picture
Dim hDCMemory As Long, hBmp As Long, hBmpPrev As Long
Dim hPal As Long, hPalPrev As Long, RasterCapsScrn As Long
Dim HasPaletteScrn As Long, PaletteSizeScrn As Long
Dim typLogPal As LOGPALETTE

    hDCMemory = CreateCompatibleDC(hDCSrc)
    hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc)
    hBmpPrev = SelectObject(hDCMemory, hBmp)

    RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS) ' Raster
    HasPaletteScrn = RasterCapsScrn And RC_PALETTE ' Palette
    PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE) ' Size of

   If HasPaletteScrn And (PaletteSizeScrn = 256) Then
      typLogPal.palVersion = &H300
      typLogPal.palNumEntries = 256
      GetSystemPaletteEntries hDCSrc, 0, 256, typLogPal.palPalEntry(0)
      hPal = CreatePalette(typLogPal)
      hPalPrev = SelectPalette(hDCMemory, hPal, 0)
      RealizePalette hDCMemory
   End If

   BitBlt hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, LeftSrc, TopSrc, vbSrcCopy
   hBmp = SelectObject(hDCMemory, hBmpPrev)
   
   If HasPaletteScrn And (PaletteSizeScrn = 256) Then
      hPal = SelectPalette(hDCMemory, hPalPrev, 0)
   End If
   
   DeleteDC hDCMemory

   Set CreatePictureFromDC = CreatePictureFromBitmap(hBmp, hPal)
End Function

Private Function CreatePictureFromBitmap(ByVal hBmp As Long, ByVal hPal As Long) As Picture
Dim typGUID As GUID
Dim typPicBmp As PicBmp
Dim objIPicture As IPicture

    With typGUID
        .Data1 = &H20400
        .Data4(0) = &HC0
        .Data4(7) = &H46
    End With

    With typPicBmp
        .Size = Len(typPicBmp)
        .Type = vbPicTypeBitmap
        .hBmp = hBmp
        .hPal = hPal
    End With

    OleCreatePictureIndirect typPicBmp, typGUID, 1, objIPicture
    Set CreatePictureFromBitmap = objIPicture
End Function
0
 
avya2kCommented:
if this is ur form or mdi form control then u can do it directly
set picture property of form to the picture you want
thats it
0
 
fcpAuthor Commented:
John,
i have'nt yet test your samples... anyway i have some questions:
What exactly do your first sample? Seems it makes the Form transparent, or not?
About user controls: reading the MSDN that comes with VS6, seems that making a container transparent makes object contained as invisible, so unclickable... it's your way a "cheat" for that? have you tested it?

Thanks
0
 
JohnMcCannCommented:
Sample 1) Creates a region from each control on your form and adds them all together.  If you imagine each control has a rectangular region its left, top, right (Left + width) and Bottom (Top + Height).  Basically the regions are combined to create a series of Rectangles that make up the visible area of the control.

Sample 2) Creates a mask for the form/control that will mask out the back color.  This method requires you set the Backcolor to a color different from all the currentlky used colors.

As for

About user controls: reading the MSDN that comes with VS6, seems that making a container transparent makes object contained as invisible, so unclickable... it's your way a "cheat" for that? have you tested it?

Yes and Yes

What Microsoft is saying that if you simply set the transparent = true property WITHOUT a mask every diapears.
0
 
CleanupPingCommented:
fcp:
This old question needs to be finalized -- accept an answer, split points, or get a refund.  For information on your options, please click here-> http:/help/closing.jsp#1 
Experts: Post your closing recommendations!  Who deserves points here?
0
 
DanRollinsCommented:
Moderator, my recommended disposition is:

    Accept JohnMcCann's comment(s) as an answer.

DanRollins -- EE database cleanup volunteer
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Tackle projects and never again get stuck behind a technical roadblock.
Join Now