Solved

transparent picture boxes

Posted on 1998-09-28
4
240 Views
Last Modified: 2010-04-30
can anyone tell me how to create transparent picture boxes?  using api or whatever.  i can't use image boxes in my application,  so that option is out.

thanks in advance
0
Comment
Question by:janeausten
4 Comments
 
LVL 3

Expert Comment

by:fguerreiro_inix
ID: 1436960
Picture boxes are containers, they can't be transparent!
0
 

Author Comment

by:janeausten
ID: 1436961
hi,

i feared as much, but i was hoping some angel had devised a way of going around this.

i'd like to wait for some more people's comments, and if i don't hear other comments any different from yours, i'll tell you to repost your answer and claim your points.

thanks!
0
 
LVL 14

Accepted Solution

by:
waty earned 50 total points
ID: 1436962
Here are some GDI routine, use MakeTransparent Function

Option Explicit

' *** Make transparent
Declare Function CombineRgn Lib "GDI32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Declare Function CreateRectRgn Lib "GDI32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Public Const RGN_AND = 1
Public Const RGN_COPY = 5
Public Const RGN_DIFF = 4
Public Const RGN_OR = 2
Public Const RGN_XOR = 3

' *** Get an RGB Colour from an OLE_COLOR
Private Declare Function OleTranslateColor Lib "olepro32.dll" (ByVal OLE_COLOR As Long, ByVal hPalette As Long, pccolorref As Long) As Long
Private Const CLR_INVALID = -1

' *** CopyDesktop
Private Declare Function DeleteDC Lib "GDI32" (ByVal hDC As Long) As Long
Private Declare Function CreateDCAsNull Lib "GDI32" Alias "CreateDCA" (ByVal lpDriverName As String, lpDeviceName As Any, lpOutput As Any, lpInitData As Any) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long

' *** RepaintWindow
Private Type POINTAPI
   x As Long
   y As Long
End Type

Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function InvalidateRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT, ByVal bErase As Long) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long

' **** CreateMaskImage
' Creates a memory DC1
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

' *** Fonts
Private Const LF_FACESIZE = 32

Private Type LogFont
   lfHeight As Long
   lfWidth As Long
   lfEscapement As Long
   lfOrientation As Long
   lfWeight As Long
   lfItalic As Byte
   lfUnderline As Byte
   lfStrikeOut As Byte
   lfCharSet As Byte
   lfOutPrecision As Byte
   lfClipPrecision As Byte
   lfQuality As Byte
   lfPitchAndFamily As Byte
   lfFaceName As String * LF_FACESIZE
End Type

Private Declare Function CreateFontIndirect Lib "GDI32" Alias "CreateFontIndirectA" (lpLogFont As LogFont) As Long

Private Declare Function SetBkMode Lib "GDI32" (ByVal hDC As Long, ByVal nBkMode As Long) As Long

Private Const TRANSPARENT = 1
Private Const OPAQUE = 2

Declare Function GetDeviceCaps Lib "GDI32" (ByVal hDC As Long, ByVal nIndex As Long) As Long

Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long

Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long

Private Type TEXTMETRIC
   tmHeight As Integer
   tmAscent As Integer
   tmDescent As Integer
   tmInternalLeading As Integer
   tmExternalLeading As Integer
   tmAveCharWidth As Integer
   tmMaxCharWidth As Integer
   tmWeight As Integer
   tmItalic As String * 1
   tmUnderlined As String * 1
   tmStruckOut As String * 1
   tmFirstChar As String * 1
   tmLastChar As String * 1
   tmDefaultChar As String * 1
   tmBreakChar As String * 1
   tmPitchAndFamily As String * 1
   tmCharSet As String * 1
   tmOverhang As Integer
   tmDigitizedAspectX As Integer
   tmDigitizedAspectY As Integer
End Type

Private Declare Function GetTextMetrics Lib "GDI32" Alias "GetTextMetricsA" (ByVal hDC As Long, lpMetrics As TEXTMETRIC) As Long

Private Declare Function GetWindowDC Lib "user32" (ByVal hWnd As Long) As Long

Private Declare Function SetMapMode Lib "GDI32" (ByVal hDC As Long, ByVal nMapMode As Long) As Long

Private Const MM_TEXT = 1

' Constants for get device caps
Private Const PHYSICALOFFSETX = 112
Private Const PHYSICALOFFSETY = 113
Private Const PLANES = 14
Private Const BITSPIXEL = 12

Private Const MARGIN_TOP = 1
Private Const MARGIN_BOTTOM = 2
Private Const MARGIN_LEFT = 3
Private Const MARGIN_RIGHT = 4

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

Private Declare Function CreateSolidBrush Lib "GDI32" (ByVal crColor As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hDC As Long, lpRect As RECT, ByVal hBrush As Long) As Long

' *** Set the toolbar to Office 97
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lparam As Long) As Long
Private Declare Function SendMessageAny Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lparam As Any) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hwndParent As Long, ByVal hWndChildWindow As Long, ByVal lpClassName As String, ByVal lpsWindowName As String) As Long
Private Const WM_USER = &H400
Private Const TB_SETSTYLE = WM_USER + 56
Private Const TB_GETSTYLE = WM_USER + 57
Private Const TBSTYLE_FLAT = &H800

Public Function CreateMaskImage(ByRef picFrom As PictureBox, ByRef picTo As PictureBox, Optional ByVal lTransparentColor As Long = -1) As Boolean
   ' *** Create a mask image (all black for the transparent colour otherwise white) from a bitmap
   
   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

Private Function TranslateColor(ByVal oClr As OLE_COLOR, Optional hPal As Long = 0) As Long
   ' *** Get an RGB Colour from an OLE_COLOR

   ' *** Sometimes you need to know the Red, Green and Blue values of a Visual Basic OLE Colour,
   ' *** particularly if you are going to use the colour in an API function.
   ' *** This functions shows you how to correctly convert an OLE_COLOR type to a RGB value using
   ' *** the OleTranslateColor API call exposed by OLEPRO32.DLL.
   ' *** It works for all colours, whether they are RGB colours, system colours of
   ' *** the type &H80000000F (vbButtonFace) or palette-matching colours such as &H2EECC99.

   ' *** Convert Automation color to Windows color
   If OleTranslateColor(oClr, hPal, TranslateColor) Then
      TranslateColor = CLR_INVALID
   End If

End Function

Public Sub MakeTransparent(frm As Control)
   ' *** Make a form transparent
   
   Dim rctClient As RECT, rctFrame As RECT
   Dim hClient As Long, hFrame As Long
   
   ' *** Grab client area and frame area
   GetWindowRect frm.hWnd, rctFrame
   GetClientRect frm.hWnd, rctClient
   
   ' *** Convert client coordinates to screen coordinates
   Dim lpTL As POINTAPI, lpBR As POINTAPI
   lpTL.x = rctFrame.Left
   lpTL.y = rctFrame.Top
   lpBR.x = rctFrame.Right
   lpBR.y = rctFrame.Bottom
   ScreenToClient frm.hWnd, lpTL
   ScreenToClient frm.hWnd, lpBR
   rctFrame.Left = lpTL.x
   rctFrame.Top = lpTL.y
   rctFrame.Right = lpBR.x
   rctFrame.Bottom = lpBR.y
   rctClient.Left = Abs(rctFrame.Left)
   rctClient.Top = Abs(rctFrame.Top)
   rctClient.Right = rctClient.Right + Abs(rctFrame.Left)
   rctClient.Bottom = rctClient.Bottom + Abs(rctFrame.Top)
   rctFrame.Right = rctFrame.Right + Abs(rctFrame.Left)
   rctFrame.Bottom = rctFrame.Bottom + Abs(rctFrame.Top)
   rctFrame.Top = 0
   rctFrame.Left = 0
   
   ' *** Convert RECT structures to region handles
   hClient = CreateRectRgn(rctClient.Left, rctClient.Top, rctClient.Right, rctClient.Bottom)
   hFrame = CreateRectRgn(rctFrame.Left, rctFrame.Top, rctFrame.Right, rctFrame.Bottom)
   
   ' *** Create the new "Transparent" region
   CombineRgn hFrame, hClient, hFrame, RGN_XOR
   
   ' *** Now lock the window's area to this created region
   SetWindowRgn frm.hWnd, hFrame, True

End Sub


0
 
LVL 2

Expert Comment

by:AllenC_Jr
ID: 1436963
The answer that waty posted is right on the mark...
0

Featured Post

6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

Join & Write a Comment

I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

744 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now