Solved

using the win2k transparency

Posted on 2002-07-07
5
703 Views
Last Modified: 2012-05-04
i know that win2k & up has the ability to set a windows transparency to be semi transparent. how can i set this on a VB6 label or picturebox? i have a form that displays a picture. my user needs to define a hotspot of a rectangular shape. i want to display to him the hotspot as a semi transparent area. i use for the hotspot a label (i can change it to picturebox if needed)
0
Comment
Question by:DanAvni
  • 3
  • 2
5 Comments
 
LVL 1

Expert Comment

by:samsonite1023
ID: 7136103
You can only use the transparency on top level windows, and your picture box is a child of the form it's on.

There is a complicated way around this, which would be setting the picturebox's parent as the desktop, and moving the picturebox to above your form (so it looks like it is part of it).

For transparency, I recommend downloading a class for it, as it is much easier to use and the coding is already done. Also, you must use something that has a window handle (labels do not), like a picturebox.

Hope this helps!
0
 
LVL 2

Author Comment

by:DanAvni
ID: 7136955
do you know of such a class that i can d/l?
0
 
LVL 1

Accepted Solution

by:
samsonite1023 earned 100 total points
ID: 7137390
The class is called "CTranslucentForm."  I couldn't find it available to download anywhere, so I'll cut and paste.  Keep in mind, it's NOT my code:

Make a new class module and add this:

' *************************************************************************
'  Copyright )2001 Sveinn R. Sigurpsson
'  All Rights Reserved, http://www.svenni.com
' *************************************************************************
'  You are free to use this code within your own applications, but you
'  are expressly forbidden from selling or otherwise distributing this
'  source code, non-compiled, without prior written consent.
' *************************************************************************
Option Explicit

'   BOOL SetLayeredWindowAttributes(
'     HWND hwnd,           // handle to the layered window
'     COLORREF crKey,      // specifies the color key
'     BYTE bAlpha,         // value for the blend function
'     DWORD dwFlags        // action
'   );
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Long, ByVal dwFlags As Long) As Long

'   BOOL UpdateLayeredWindow(
'     HWND hwnd,             // handle to layered window
'     HDC hdcDst,            // handle to screen DC
'     POINT *pptDst,         // new screen position
'     SIZE *psize,           // new size of the layered window
'     HDC hdcSrc,            // handle to surface DC
'     POINT *pptSrc,         // layer position
'     COLORREF crKey,        // color key
'     BLENDFUNCTION *pblend, // blend function
'     DWORD dwFlags          // options
'   );
Private Declare Function UpdateLayeredWindow Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long, pptDst As POINTAPI, pSize As SIZE, ByVal hdcSrc As Long, pptSrc As POINTAPI, ByVal crKey As Long, pBlend As BLENDFUNCTION, ByVal dwFlags As Long) As Long

'   typedef struct _BLENDFUNCTION {
'     BYTE     BlendOp;
'     BYTE     BlendFlags;
'     BYTE     SourceConstantAlpha;
'     BYTE     AlphaFormat;
'   }BLENDFUNCTION, *PBLENDFUNCTION, *LPBLENDFUNCTION;
Private Type BLENDFUNCTION
   BlendOp As Byte
   BlendFlags As Byte
   SourceConstantAlpha As Byte
   AlphaFormat As Byte
End Type

Private Type POINTAPI
   x As Long
   y As Long
End Type

Private Type SIZE
   cx As Long
   cy As Long
End Type

Private Const LWA_COLORKEY = &H1&
Private Const LWA_ALPHA = &H2&
Private Const LWA_OPAQUE = &HFF&

Private Const ULW_COLORKEY = &H1
Private Const ULW_ALPHA = &H2
Private Const ULW_OPAQUE = &H4

' Style setting APIs
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000

' Win32 APIs to determine OS information.
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Type OSVERSIONINFO
   dwOSVersionInfoSize As Long
   dwMajorVersion As Long
   dwMinorVersion As Long
   dwBuildNumber As Long
   dwPlatformId As Long
   szCSDVersion As String * 128
End Type
Private Const VER_PLATFORM_WIN32s = 0
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2

' Color translation
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long

' Translucency Modes
Public Enum TranslucencyModes
   lwaNormal = 0
   lwaColorKey = LWA_COLORKEY
   lwaAlpha = LWA_ALPHA
End Enum

' Trick to keep the case of our Enums
#If False Then
   Private Const lwaNormal = 0
   Private Const lwaColorKey = 1
   Private Const lwaAlpha = 2
#End If

' Member variables
Private m_Supported As Boolean
Private m_hWnd As Long
Private m_Alpha As Long
Private m_ColorKey As OLE_COLOR
Private m_Mode As TranslucencyModes

' ************************************************
'  Initialize/Terminate
' ************************************************
Private Sub Class_Initialize()
   ' Make sure we're in Windows 2000, or at
   ' least some version capable of layered
   ' windows.
   Dim os As OSVERSIONINFO
   os.dwOSVersionInfoSize = Len(os)
   Call GetVersionEx(os)
   m_Supported = (os.dwMajorVersion >= 5)
   ' Set some default values.
   m_Alpha = LWA_OPAQUE
   m_ColorKey = vb3DFace
   m_Mode = lwaAlpha
End Sub

Private Sub Class_Terminate()
   ' Restore window to normal.
   ClearTranslucency m_hWnd
End Sub

' ************************************************
'  Public Properties
' ************************************************
Public Property Let Alpha(ByVal NewVal As Byte)
   If m_Supported Then
      ' Set window translucency, and cache value
      ' if successful.
      Select Case m_Mode
         Case lwaAlpha
            If SetLayeredWindowAttributes(m_hWnd, 0, CLng(NewVal), LWA_ALPHA) Then
               m_Alpha = NewVal
            End If
         Case lwaColorKey, lwaNormal
            m_Mode = lwaAlpha
            ToggleTranslucency m_hWnd
      End Select
   End If
End Property

Public Property Get Alpha() As Byte
   Alpha = CByte(m_Alpha)
End Property

Public Property Let ColorKey(ByVal NewVal As OLE_COLOR)
   If m_Supported Then
      ' Set window translucency, and cache value
      ' if successful.
      Select Case m_Mode
         Case lwaColorKey
            If SetLayeredWindowAttributes(m_hWnd, CheckSysColor(NewVal), 0, LWA_COLORKEY) Then
               m_ColorKey = NewVal
            End If
         Case lwaAlpha, lwaNormal
            m_Mode = lwaColorKey
            m_ColorKey = NewVal
            ToggleTranslucency m_hWnd
      End Select
   End If
End Property

Public Property Get ColorKey() As OLE_COLOR
   ColorKey = m_ColorKey
End Property

Public Property Let hWnd(ByVal NewVal As Long)
   If m_Supported Then
      ' Restore previous window to normal.
      ClearTranslucency m_hWnd
      ' Cache handle to new window, and
      ' setup for translucency.
      m_hWnd = NewVal
      SetTranslucency m_hWnd
   End If
End Property

Public Property Get hWnd() As Long
   hWnd = m_hWnd
End Property

Public Property Let Mode(ByVal NewVal As TranslucencyModes)
   Select Case NewVal
      Case lwaColorKey, lwaAlpha
         ' Toggle translucency to clear
         ' previous settings.
         m_Mode = NewVal
         Call ToggleTranslucency(m_hWnd)
     
      Case lwaNormal
         m_Mode = NewVal
         Call ClearTranslucency(m_hWnd)
         
      Case Else
         ' ignore input
   End Select
End Property

Public Property Get Mode() As TranslucencyModes
   Mode = m_Mode
End Property

' ************************************************
'  Public Properties - Read/Only
' ************************************************
Public Property Get Supported() As Boolean
   Supported = m_Supported
End Property

' ************************************************
'  Private Methods
' ************************************************
Private Function CheckSysColor(ByVal ColorRef As OLE_COLOR) As Long
   Const HighBit = &H80000000
   If ColorRef And HighBit Then
      CheckSysColor = GetSysColor(ColorRef And Not HighBit)
   Else
      CheckSysColor = ColorRef
   End If
End Function

Private Function ClearTranslucency(ByVal hWnd As Long) As Boolean
   Dim nStyle As Long
   If hWnd Then
      ' Set translucency to fully opaque.
      Call SetLayeredWindowAttributes(hWnd, 0, LWA_OPAQUE, LWA_ALPHA)
      ' Clear exstyle bit.
      nStyle = GetWindowLong(hWnd, GWL_EXSTYLE) And Not WS_EX_LAYERED
      ClearTranslucency = CBool(SetWindowLong(hWnd, GWL_EXSTYLE, nStyle))
   End If
End Function

Private Function SetTranslucency(ByVal hWnd As Long) As Boolean
   Dim nStyle As Long
   If hWnd Then
      ' Set exstyle bit.
      nStyle = GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED
      If SetWindowLong(hWnd, GWL_EXSTYLE, nStyle) Then
         ' Reset cached value for translucency, and
         ' corresponding window, to fully opaque.
         m_Alpha = LWA_OPAQUE
         SetTranslucency = CBool(SetLayeredWindowAttributes(hWnd, 0, m_Alpha, LWA_ALPHA))
      End If
   End If
End Function

Private Function ToggleTranslucency(ByVal hWnd As Long) As Boolean
   Dim nStyle As Long
   If hWnd Then
      ' Clear, then reset, exstyle bit.
      nStyle = GetWindowLong(hWnd, GWL_EXSTYLE) And Not WS_EX_LAYERED
      If m_Mode <> lwaNormal Then
         If SetWindowLong(hWnd, GWL_EXSTYLE, nStyle) Then
            nStyle = nStyle Or WS_EX_LAYERED
            If SetWindowLong(hWnd, GWL_EXSTYLE, nStyle) Then
               Select Case m_Mode
                  Case lwaAlpha
                     ToggleTranslucency = CBool(SetLayeredWindowAttributes(hWnd, 0, m_Alpha, LWA_ALPHA))
                  Case lwaColorKey
                     ToggleTranslucency = CBool(SetLayeredWindowAttributes(hWnd, CheckSysColor(m_ColorKey), 0, LWA_COLORKEY))
               End Select
            End If
         End If
      End If
   End If
End Function



Add this code to a form:

Dim trans As CTranslucentForm

Private Sub Form_Load()
Set trans = New CTranslucentForm
trans.hWnd = Form1.hWnd
trans.Mode = lwaAlpha
trans.Alpha = 150
End Sub



To make the picture box transparent, you will need to make it a top level window.  Ill type up a sample in a separate post.

0
 
LVL 1

Expert Comment

by:samsonite1023
ID: 7137418
Here is code to make the picture box a top level and translucent.  You can move it around by setting the picture1.left and picture1.top properties, just like you would normally.

Hope this helps!

Add to a form, in a project that has the CTranslucentForm class.

Private Declare Function WindowFromDC Lib "user32" (ByVal hdc As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long

Dim trans As CTranslucentForm

Private Sub Form_Activate()
Set trans = New CTranslucentForm
Dim pictureHWND As Long
'get the picture box's hwnd
pictureHWND = WindowFromDC(Picture1.hdc)
'make it a top level window
SetParent pictureHWND, GetDesktopWindow
'make it translucent
trans.hWnd = pictureHWND
trans.Alpha = 200
End Sub


There you go

-Sam
0
 
LVL 2

Author Comment

by:DanAvni
ID: 7162266
samsonite1023 thx for your help. although i did not test the code you sent me it seems that it will work. we have decided at a system review meeting to change some things in the app and they will also result in the ability to display polygons transparently through an OCX we wrote.

thx again for your help!
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
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.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
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…

757 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

16 Experts available now in Live!

Get 1:1 Help Now