| :: Create Layered Windows in VB |
| API
Declarations |
'Creating Layered windows in VB. I only tested VB6 and not any
previous
'versions with Win 2000 Professional.
'According to MS these are new features to win platform and will only work
'under Win 2000.
'For more Information goto http://msdn.microsoft.com/library/techart/layerwin.htm
Option Explicit
'Requires Windows 2000 (NT
5):
Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hWnd As Long,
ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long,
ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function SetLayeredWindowAttributes Lib "user32.dll" (ByVal hWnd As Long, ByVal crKey As Long,
ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Declare Function UpdateLayeredWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal hdcDst As Long, pptDst As Any,
psize As Any, ByVal hdcSrc As Long, pptSrc As Any, crKey As Long, ByVal pblend As Long,
ByVal dwFlags As Long) As Long
Public Type POINTAPI
x As Long
y As Long
End Type
Public Type SIZE
cx As Long
cy As Long
End Type
Public Type BLENDFUNCTION
BlendOp As Byte
BlendFlags As Byte
SourceConstantAlpha As Byte
AlphaFormat As Byte
End Type
Public Const GWL_STYLE = (-16)
Public Const GWL_EXSTYLE = (-20)
Public Const WS_EX_LAYERED = &H80000
Public Const ULW_COLORKEY = &H1
Public Const ULW_ALPHA = &H2
Public Const ULW_OPAQUE = &H4
Public Const AC_SRC_OVER = &H0
Public Const AC_SRC_ALPHA = &H1
Public Const AC_SRC_NO_PREMULT_ALPHA = &H1
Public Const AC_SRC_NO_ALPHA = &H2
Public Const AC_DST_NO_PREMULT_ALPHA = &H10
Public Const AC_DST_NO_ALPHA = &H20
Public Const LWA_COLORKEY = &H1
Public Const LWA_ALPHA = &H2
'Check Windows Version
Declarations
'For quick implementation I used ready source and slight modifications
'from Andrea VB site @ http://www.andreavb.com/tip020005.html
Public Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
'API Calls:
Public Declare Function GetVersionEx Lib "kernel32.dll" Alias "GetVersionExA"
(lpVersionInformation As OSVERSIONINFO) As Long
'API Constants
Public Const VER_PLATFORM_WIN32_WINDOWS = 1
Public Const VER_PLATFORM_WIN32_NT = 2 |
| Module |
Public Function IsLayeredWindow(ByVal hWnd As Long) As Boolean
Dim WinInfo As Long
WinInfo = GetWindowLong(hWnd, GWL_EXSTYLE)
If (WinInfo And WS_EX_LAYERED) = WS_EX_LAYERED Then
IsLayeredWindow = True
Else
IsLayeredWindow = False
End If
End Function
Public Sub SetLayeredWindow(ByVal hWnd As Long, _
ByVal bIsLayered As Boolean)
Dim WinInfo As Long
WinInfo = GetWindowLong(hWnd, GWL_EXSTYLE)
If bIsLayered = True Then
WinInfo = WinInfo Or WS_EX_LAYERED
Else
WinInfo = WinInfo And Not WS_EX_LAYERED
End If
SetWindowLong hWnd, GWL_EXSTYLE, WinInfo
End Sub
'get a string with the
description of the operating system
Public Function GetWindowsVersion(ByRef IsWin2000 As Boolean) As String
Dim TheOS As OSVERSIONINFO
Dim strCSDVersion As String
TheOS.dwOSVersionInfoSize = Len(TheOS)
GetVersionEx TheOS
Select Case TheOS.dwPlatformId
Case VER_PLATFORM_WIN32_WINDOWS
If TheOS.dwMinorVersion >= 10 Then
GetWindowsVersion =
"Windows 98 version: "
Else
GetWindowsVersion =
"Windows 95 version: "
End If
Case VER_PLATFORM_WIN32_NT
GetWindowsVersion = "Windows NT version:
"
End Select
'Extract the
Additional Version Information from the string with null char terminator
If InStr(TheOS.szCSDVersion, Chr(0)) <> 0 Then
strCSDVersion = ": " &
Left(TheOS.szCSDVersion, InStr(TheOS.szCSDVersion, Chr(0)) - 1)
Else
strCSDVersion = ""
End If
GetWindowsVersion = GetWindowsVersion & TheOS.dwMajorVersion &
"." & _
TheOS.dwMinorVersion & " (Build "
& TheOS.dwBuildNumber & strCSDVersion & ")"
'Set ByRef
Parameter
If TheOS.dwMajorVersion = 5 Then IsWin2000 = True Else IsWin2000 =
False
End Function |
| Usage |
'Create a form with 3 Command Buttons and a Slider
Option Explicit
Private Sub Command3_Click()
MsgBox IsLayeredWindow(Me.hWnd)
End Sub
Private Sub Command2_Click()
SetLayeredWindow Me.hWnd, False
Slider1.Visible = False
End Sub
Private Sub Command1_Click()
SetLayeredWindow Me.hWnd, True
Slider1.Value = 70 'set
the default value
Slider1.Visible = True
End Sub
Private Sub Slider1_Scroll()
SetLayeredWindowAttributes Me.hwnd,0,(255 * Slider1.Value) / 100,
LWA_ALPHA
End Sub
Private Sub Form_Load()
Dim bool As Boolean
GetWindowsVersion bool
If Not bool Then
MsgBox "Requires Windows 2000 or
later:" & vbCrLf & "Application will exit", , "Exiting"
Unload Me
End If
'Little
change t my previous submission Create Layered Windows.
'To see what the presentage of transparency you would like to use
'I added a slider control to the form.
'Here is
the code
'that should be added to the form
'Form_load event
Slider1.Visible = True
Slider1.Min = 25 'anything lower 25 is practically invisible
End Sub |
|
 |
|
|
Home
Form Tips
Previous Tip
Next Tip
