Form not changing transparency

[Aussiebear]

I found the following code at Colo's but it fails to change the transparency.

[VBA]
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

Private Sub cmdExit_Click()
Unload Me
End Sub

Private Sub ScrollBar1_Change()
Call Semitransparent(Me.ScrollBar1.Value)
End Sub

Private Sub UserForm_Activate()
Me.ScrollBar1.Value = 50
End Sub

Private Sub Semitransparent(ByVal intLevel As Integer)
Dim lngWinIdx As Long
hWnd = GetActiveWindow
lngWinIdx = GetWindowLong(hWnd, GWL_EXSTYLE)
SetWindowLong hWnd, GWL_EXSTYLE, lngWinIdx Or WS_EX_LAYERED
SetLayeredWindowAttributes hWnd, 0, ((255) * intLevel) / 100, LWA_ALPHA
Label1.Caption = "Semitransparent level is ..." & (100 - intLevel) & "%"
End Sub

[/VBA]

The code fails on the line

[VBA]
SetLayeredWindowAttributes hWnd, 0, ((255) * intLevel) / 100, LWA_ALPHA
[/VBA]

Help suggests that this is an Overflow (Error 6)

An overflow results when you try to make an assignment that exceeds the limitations of the target of an assignment

• The result of an assignment, calculation, or datatype conversion is too large to be represented within the range of values allowed for that type of variable
• An assignment to a property exceeds the maximum value the property can accept

What do I need to change here?

[Bob Phillips]

Use longs

[vba]

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 Long, ByVal bAlpha As Long, _
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

Private Sub cmdExit_Click()
Unload Me
End Sub

Private Sub ScrollBar1_Change()
Call Semitransparent(Me.ScrollBar1.Value)
End Sub

Private Sub UserForm_Activate()
Me.ScrollBar1.Value = 50
End Sub

Private Sub Semitransparent(ByVal intLevel As Long)
Dim lngWinIdx As Long
hWnd = GetActiveWindow
lngWinIdx = GetWindowLong(hWnd, GWL_EXSTYLE)
SetWindowLong hWnd, GWL_EXSTYLE, lngWinIdx Or WS_EX_LAYERED
SetLayeredWindowAttributes hWnd, 0, ((255) * intLevel) / 100, LWA_ALPHA
Label1.Caption = "Semitransparent level is ..." & (100 - intLevel) & "%"
End Sub
[/vba]

[Aussiebear]

ok, it works. Thanks Bob. If there's an issue here it is that the form can simply dissappear off the screen. The only way I can bring it back to life is to reactivate the form from the VBE.

I've also noticed that as I scroll across the form becomes very neally invisibible but by continuing for just a couple of millimetres more it regains full visibility.

Is there a way of stopping it from dissappearing all together and then only going to full visibility? I've obviousily got to change a value somewhere?

[Bob Phillips]

try this

[vba]

Private Sub UserForm_Activate()
Me.ScrollBar1.Min = 0
Me.ScrollBar1.Max = 100
Me.ScrollBar1.Value = 50
End Sub
[/vba]

[Bob Phillips]

You might also want to add something like

[vba]

Private Sub ScrollBar1_Change()
With Me.ScrollBar1

If .Value < 25 Then .Value = 25
Call Semitransparent(.Value)
End With
End Sub
[/vba]

[Aussiebear]

I went with the bit I received via email notification, and it works well... Now I'll go back with the extra section you have offered. Thanks Bob.

Back again...

I notice that that last bit of code builds in a safety barrier. Very nice indeed.