asked on

Problem with semi transparent window code

I found the following code to create a semi transparent window. It looks like it has reasonable control over the transparency, but I can't seem to get it to work. When calling the function I get an error message

Member already exists in an Object Module from which this object module derives

can anyone shed any light please

'****************************************************************************************************************************'
 '********************************               /REMOVE USERFORM FRAME START\                 ********************************'
 '***                                            /TRANSPARENT BACKGROUND START\                                             ***'
 '***
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
 
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
 
Private Declare Function GetActiveWindow Lib "user32" () As Long
 
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
ByVal hwnd As Long, ByVal lngWinIdx As Long, ByVal dwNewLong As Long) As Long
 
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
ByVal hwnd As Long, ByVal lngWinIdx As Long) As Long
 
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Integer, _
ByVal bAlpha As Integer, ByVal dwFlags As Long) As Long
 
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_COLORKEY = &H1
Private Const LWA_ALPHA = &H2
Private Const GWL_EXSTYLE = &HFFEC
 
Dim hwnd As Long
Dim bytOpacity As Byte
 '***                                                                                                                      ***'
 '***                                             \REMOVE USERFORM FRAME END/                                                                        ***'
 '********************************                \TRANSPARENT BACKGROUND END/                 ********************************'
 '****************************************************************************************************************************'
 
Function SemiTransparent()
     
     '\\Call SemiTransparent to set userforms background to 150 transparent
     'bytOpacity can be set to (=255 No Transparency to (=0 full transparent)
     
    bytOpacity = 150
    Dim lngWinIdx As Long
    hwnd = GetActiveWindow
    lngWinIdx = GetWindowLong(hwnd, GWL_EXSTYLE)
    SetWindowLong hwnd, GWL_EXSTYLE, lngWinIdx Or WS_EX_LAYERED
    Call SetLayeredWindowAttributes(hwnd, 0, bytOpacity, LWA_ALPHA)
     
End Function
 
Function Borderless()
     
     '\\Call to get rid of UserForm border
     
    Dim Style As Long, Menu As Long
    hwnd = GetActiveWindow
    Style = GetWindowLong(hwnd, &HFFF0)
    Style = Style And Not &HC00000
    SetWindowLong hwnd, &HFFF0, Style
    DrawMenuBar hwnd
     
End Function


Private Sub Form_Load()
Call SemiTransparent
End Sub

Open in new window

SOLUTION

Jeffrey Coachman

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

ASKER CERTIFIED SOLUTION

Scott McDaniel (EE MVE )

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

martmac

ASKER

Thanks for the input chaps, I have subsequently stumbled upon the problem in that there was another function sharing one of the declared variables, so it was as suggested an Ambiguous Name. So the code is actually good and actually very impressive in terms of delivering great control to popups, my only concern in investigating is that 64bit installs may require some modification to the code. So I am leaving options open as it is not a deal breaker. I am going to leave it in for now, but have a side note in case anything arises as a result.

We will do some more testing before any distribution, thanks for your input which provided food for thought and indication of the source of the problem, which turned out to be correct, so I have split the points and thank you both.

Martin

DatabaseMX (Joe Anderson - Former Microsoft Access MVP)

Can you post a screen shot of what this looks like ?

mx

Jeffrey Coachman

Ditto...
...and specify the Access and Windows versions...

martmac

ASKER

See pic as requested. This is just a very quick example with transparency set to 220 (255 being nontransparent) It reall can lift the presentation value. Also I have some code that allows me to drag the form around despite it being borderless. Gives some great flexibility.

This is Access 2010 Windows 7 as that is our dev environment. Once I have finished this project I will test in other versions, but am really happy with the results. I can even allow the users to pass a transparency variable to se their own transparency levels for forms.

DatabaseMX (Joe Anderson - Former Microsoft Access MVP)

That's pretty cool.

"Also I have some code that allows me to drag the form around despite it being borderless."
I would like to see that also.
I have something like that

martmac

ASKER

This might give you a better feel, still in design at the moment, but it's been a great project to really push the envelope with Access 2010 and third party component integration with MAPI for email and HTML editor component.

DatabaseMX (Joe Anderson - Former Microsoft Access MVP)

Definitely cool. I will test this out ...

If you have the move code ... would like to see that also.

martmac

ASKER

You need to first create a box that is the size of your form and send it to the back. Then you can attache the MouseDown code to that element

Place this at teh top of your form

Const WM_NCLBUTTONDOWN = &HA1
Const HT_CAPTION = 2
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Then this on the MouseDown of the box

ReleaseCapture
SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HT_CAPTION, 0

Have fun!

DatabaseMX (Joe Anderson - Former Microsoft Access MVP)

So ... a quick test with a Form ... it's making both the Access App window and the Form semi transparent ...?

mx

martmac

ASKER

I makes just the popup semitransparent NOT the Access App. if you drag the popup beyond the boundaries of the app, it remains transparent as per my first screenshot.

I am finding that blending VBA coding and leveraging Windows API provides some really cool options. In this app I have a snippets window that is an always on top popup I can then effectively shrink the access app inside the popup allowing it to interact with other Office apps like passing data strings to Word. It introduces a new way of thinking about application visual interaction. Also using SQL Server at the back end just opens the door to a whole new world.

As you can gather I am loving it, so I'll stop rambling and get back to the creative process.

DatabaseMX (Joe Anderson - Former Microsoft Access MVP)

"I makes just the popup semitransparent NOT the Access App'
I have Win 7 and A2010.

It's making both Form and Access App background transparent. I can see Windows desktop behind. Strange.

Do you have an actual Popup Form - Popup and/or Modal set to yes ?

DatabaseMX (Joe Anderson - Former Microsoft Access MVP)

btw ... are you familiar with these two sites ... a load of this kind of code on these sites:

http://access.mvps.org/access/

http://www.lebans.com/toc.htm

mx

DatabaseMX (Joe Anderson - Former Microsoft Access MVP)

If the Popup Property is set to No, I get the result in the image below.
If the Popup Property is set to Yes, then only the Access App Window is transparent.
(Note I modified the code to pass the transparent value.)
Weird thing is - I put Call SemiTransparent(255) in the Unload event. If Popup property is set to No, form closes and normal mode is restored. IF ... Popup is set to yet - again, you get the expected result, BUT ... when form closes, normal (no transparency) is not restored!

Do you get this result ?

DatabaseMX (Joe Anderson - Former Microsoft Access MVP)

odd - I cannot get the Move code to work either ... no movement on borderless form.

IrogSinta

@MX,
That's odd about the move code not working. This link gives just a slight bit more explanation but not much more. It also includes a link for moving controls around rather than the form (though I'm not sure how useful that would be).

Ron

DatabaseMX (Joe Anderson - Former Microsoft Access MVP)

Trans(apparently) I'm having a bad hair day !

Link ?

IrogSinta

MX, the hyperlink is on the word "link" itself. This is only for the Move code.

Ron

DatabaseMX (Joe Anderson - Former Microsoft Access MVP)

Oops ... contrast sucks apparently ...

DatabaseMX (Joe Anderson - Former Microsoft Access MVP)

"Then in your form, insert an image icon that users would be able to recognize as "form movement" or maybe a label that just says "Drag Me." "

OK ... so then, the 'box' approach is not correct ? And the 'Send To Back' ?

IrogSinta

Actually, the box approach should work to if you want any area of the form (other than the controls) to be a drag area. But the box's BackStyle needs to be solid, not transparent. As an alternative to the box, you can just use the MouseDown event of the Detail section. Or Header/Footer as applicable.

DatabaseMX (Joe Anderson - Former Microsoft Access MVP)

Ok the detail section MD works.
Thanks for that.

If you add this code below, you can have the Mouse change during Mouse Move - to one of the symbols. I use Hand for buttons. In the screen shot below, I used SizeAll for the MouseMove in the Detail Section.
Put this code in a Standard VBA module (mine is in my Library MDA) ... the put the call on the property sheet - MouseMove - for a given control (or Detail Section in this example).

Option Compare Database
Option Explicit

'This code for Cursors was originally written by Terry Kreft.
'Also, SSF_DsplyMouseCursor and SSF_DsplyIcon (both modified by ADI)

Declare Function adiSWA_LoadCursorByNum Lib "user32" Alias "LoadCursorA" _
(ByVal hInstance As Long, ByVal lpCursorName As Long) As Long

Declare Function adiSWA_LoadCursorFromFile Lib "user32" Alias _
"LoadCursorFromFileA" (ByVal lpFileName As String) As Long

Declare Function adiSWA_adiSetCursor Lib "user32" Alias "SetCursor" _
(ByVal hCursor As Long) As Long

Function SSF_DsplyMouseCursor(sCursorType As String) As Boolean

'---------------------------------------------
' Action(s) : Changes the mouse cursor to the type indicated by sCursorType.
' Comments : Typically called from an object's MouseMove event
' Protocol : =SSF_DsplyMouseCursor("Hand")
'---------------------------
' Argument Description
' -------- -----------
' sCursorType Cursor type desired, as specified below
'Hand
'AppStarting
'No
'Wait
'Arrow
'Cross
'SizeAll
'SizeNESW
'SizeNS
'SizeNWSE
'SizeWE
'UpArrow
'---------------------------

Dim sCursors As String
Dim iCursorPos As Integer
Dim lCursorType As Long

sCursors = "Hand32649AppStarting32650No32648Wait32514Arrow32512Cross32515SizeAll32646SizeNESW32643SizeNS32645SizeNWSE32642SizeWE32644UpArrow32516"
iCursorPos = InStr(1, sCursors, sCursorType)
lCursorType = Mid(sCursors, iCursorPos + Len(sCursorType), 5)
Call adiSWA_adiSetCursor(adiSWA_LoadCursorByNum(0&, lCursorType))

End Function

martmac

ASKER

Sorry was asleep while all this was going on, give me a mo to look through your comments.

martmac

ASKER

IrogSinta is correct, you can use it on the MouseDown of the detail area Re the popup not being set, I had not considered that option as I was looking specifically at popup behaviour. Do you have the Move code working now?

DatabaseMX (Joe Anderson - Former Microsoft Access MVP)

Yes ... using the MM of the Detail Section.

However ... the Transparent code ... did you see my comments/issues ?

martmac

ASKER

I'm a little unclear as to what you are trying to do. Are you looking for transparency beyond a popup? My objective within my project was to have access to semitransparent popups that are draggable and I have exactly that implemented with the code provided. I am a bit unclear as to what it is you are trying to do?

DatabaseMX (Joe Anderson - Former Microsoft Access MVP)

Well ... Yes .. the popup mode works ... Access App Window becomes transparent ... but, when I close the Popup Form ... the transparency remains - if the Popup property is set to Yes. But, if Popup property is set to No, then when I close the Form, then transparency disappears. (Note I modified the code to pass the transparent value.)

And I put Call SemiTransparent(255) in the Unload event.

So, the question is ... how are you removing the transparency when you close your Popup Form ?

And yes ... it mainly makes sense to use a Popup Form - then have the Access App Window become transparent.

martmac

ASKER

I've now woke up a little (20 hour days on this project is killing me!)

I am not getting any transparency in the app at all. Just transparency in the popup as required. Is your code only in the popup form. My popup is NOT modal, but is set as popup.

Am struggling with time at the moment, but will experiment further when I get a mo

DatabaseMX (Joe Anderson - Former Microsoft Access MVP)

I changed the Form the Popup only ... that works. BUT ... when I close the Form, the transparency remains.
How are you getting rid of the transparency when you close the form?

Also ... for the record, I forgot the post the image below - this is what happens IF .. the form is NOT Popup - which I agree - does not make much sense ...

DatabaseMX (Joe Anderson - Former Microsoft Access MVP)

fyi ... I have to zzzzOut now ... back in am.
thx for your input ... this is pretty cool. I have immediate uses.

DatabaseMX (Joe Anderson - Former Microsoft Access MVP)

OK ... I've been messing with this a bit more. Based on the images you posted, it appears that both the Popup and Access App window are transparent (?).
The effect that I would want to create is like - for example - what you see on Facebook when you click on "38 people Like this" - and a window opens up and shows the complete list of who Likes whatever. Now, the window that pops up is not transparent. Only the browser window becomes semi transparent (see image below). So ... how do we make this happen?

And ... back to your specific usage/situation ...
How are you getting rid of the transparency when you close the form?

martmac

ASKER

Only the popup is transparent at my end. The form which you saw against my desktop was just a popup. I have no issues with transparency when closing the popup. So not sure what the problem is at your end. I see what you are trying to do and it would be useful for me to. I am just pushed for time at the moment, so can't really devote any time to experimenting, but I will once I have some free time.

DatabaseMX (Joe Anderson - Former Microsoft Access MVP)

Yeah it's weird. I have the exact same code, but ... if I set Popup to Yes ... transparency happens - but - when I close the form - transparency remains.

So - when you close the Form, transparency is removed?
I noticed that ... with Popup set - hwnd (using Debug.Print) has a *different* value for ActiveWindow - when the popup closes - which is why transparency remains.

mx

IrogSinta

mx, perhaps the code is confused with hWnd. I put mine in a public module and call it this way (note the revision I made using the local variable "hnd" instead):

Call SemiTransparent(me, 150)

'****************************************************************************************************************************'
'***                                               /TRANSPARENT BACKGROUND\                                               ***'

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
 
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
 
Private Declare Function GetActiveWindow Lib "user32" () As Long
 
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
ByVal hwnd As Long, ByVal lngWinIdx As Long, ByVal dwNewLong As Long) As Long
 
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
ByVal hwnd As Long, ByVal lngWinIdx As Long) As Long
 
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Integer, _
ByVal bAlpha As Integer, ByVal dwFlags As Long) As Long
 
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_COLORKEY = &H1
Private Const LWA_ALPHA = &H2
Private Const GWL_EXSTYLE = &HFFEC
 
 
Public Function SemiTransparent(frm As Form, bytOpacity As Byte)
     'Set PopUp userforms background to transparent
     'bytOpacity can be set to (=255 No Transparency to (=0 full transparent)
     
    Dim hnd As Long
    Dim lngWinIdx As Long
     
    hnd = frm.hwnd
    lngWinIdx = GetWindowLong(hnd, GWL_EXSTYLE)
    SetWindowLong hnd, GWL_EXSTYLE, lngWinIdx Or WS_EX_LAYERED
    Call SetLayeredWindowAttributes(hnd, 0, bytOpacity, LWA_ALPHA)
     
End Function
 
Function Borderless()
     
     '\\Call to get rid of UserForm border
     
    Dim Style As Long, Menu As Long
    hwnd = GetActiveWindow
    Style = GetWindowLong(hwnd, &HFFF0)
    Style = Style And Not &HC00000
    SetWindowLong hwnd, &HFFF0, Style
    DrawMenuBar hwnd
     
End Function

' To use in form open or load event
' Call SemiTransparent(Me, 200)

Open in new window

DatabaseMX (Joe Anderson - Former Microsoft Access MVP)

OK ... that works. Kind of where I was heading - passing Form hwnd.

Now ... we need to reverse the effect - like the Facebook Example above.

Set the semi transparency to the Access App Window (like it's doing to the browser above) and leave the Form normal. When Form closes, put Access App Window back to normal.

So ... get the handle of the Access App window ?

mx

DatabaseMX (Joe Anderson - Former Microsoft Access MVP)

Well ... actually, that's easy:
(quick test- change to your code Ron)

hnd = Access.hWndAccessApp 'frm.hwnd

btw ... the test form below is borderless (with move) and Popup/Modal !

Capture4.gif