PDA

View Full Version : Form not changing transparency



Aussiebear
03-23-2008, 04:23 AM
I found the following code at Colo's but it fails to change the transparency.


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



The code fails on the line


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


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 acceptWhat do I need to change here?

Bob Phillips
03-23-2008, 04:52 AM
Use longs



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

Aussiebear
03-23-2008, 05:36 AM
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
03-23-2008, 06:29 AM
try this



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

Bob Phillips
03-23-2008, 06:32 AM
You might also want to add something like



Private Sub ScrollBar1_Change()
With Me.ScrollBar1

If .Value < 25 Then .Value = 25
Call Semitransparent(.Value)
End With
End Sub

Aussiebear
03-23-2008, 06:41 AM
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.