asked on

How to modify code to allow transparent userforms

Hi,

How do I add the ability to make the userform generated by the following, transparent to say 192?

And is there any code in the following that is not required?

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Private Sub UserForm_Activate()
hWndForm = FindWindow(vbNullString, Me.Caption)
SetWindowLong hWndForm, -16, GetWindowLong(hWndForm, -16) And Not &HC00000
SetWindowLong hWndForm, -20, GetWindowLong(hWndForm, -20) And Not &H1
DrawMenuBar hWndForm
end sub

ASKER CERTIFIED SOLUTION

Roy Cox

membership

This solution is only available to members.

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

Start Free Trial

Roy Cox

This just displays a transparent form, adjust this line to change the transparency, currently 75%

Call Semitransparent(75)

Open in new window

Transparent-UserForm.xlsm

MirageSF

ASKER

Roy thank you for those, on the first one transparent how do I remove the title bar and borders so its basically just the background and info shown from the form?

This is basically what my originally code from above done, but without the transparency everythime I tried to add it didn't work.

Thanks

Roy Cox

The code is all in the workbooks. There is a Class Module to remove the Title Bar.

Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
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 Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Private Const GWL_STYLE As Long = (-16)
Private Const WS_CAPTION As Long = &HC00000
Public Property Set Form(oForm As Object)
    Dim iStyle As Long
    Dim hWndForm As Long
    If Val(Application.Version) < 9 Then
        hWndForm = FindWindow("ThunderXFrame", oForm.Caption)
    Else
        hWndForm = FindWindow("ThunderDFrame", oForm.Caption)
    End If
    iStyle = GetWindowLong(hWndForm, GWL_STYLE)
    iStyle = iStyle And Not WS_CAPTION
    SetWindowLong hWndForm, GWL_STYLE, iStyle
    DrawMenuBar hWndForm
End Property

Open in new window

In the UserForm you will see

Dim oTitleBarHider As New cTitleBarHider

Open in new window

Then in the UserForm_Activate event

Private Sub UserForm_Activate()
''/// this line is relevant to hiding the Title bar
Set oTitleBarHider.Form = Me
''/// the next two lines initiate the fade routine    
    Running = True
    Call Transparency

End Sub

Open in new window

MirageSF

ASKER

Perfect thank you. With a few tweaks here and their it now does exactly as I like!.

The splash pops up then fades out slowly once 20 seconds or close has been clicked, which is great. Just a quick question, if I create the form and call Semitransparency to say 50, the form shows briefly in full colour before then droping to 50%, is there a way to get it to appear straight at the 50%?

Otherwise great and thank you very much :)