softman
10-19-2010, 02:50 AM
This is a Splash screen with no close button.
I do not know how to share this at the KB but would like to share this here.
Form code:
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 Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Const GWL_STYLE As Long = (-16)
Private wHandle As Long
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub Label1_Click()
End Sub
Private Sub UserForm_Initialize()
Application.OnTime Now + TimeValue("00:00:05"), "KillForm"
Dim frm As Long, frmstyle As Long
If Val(Application.Version) >= 9 Then
wHandle = FindWindow("ThunderDFrame", Me.Caption)
Else
wHandle = FindWindow("ThunderXFrame", Me.Caption)
End If
If wHandle = 0 Then Exit Sub
frm = GetWindowLong(wHandle, GWL_STYLE)
frm = frm Or &HC00000
SetWindowLong wHandle, -16, frmstyle
DrawMenuBar wHandle
End Sub
Private Sub UserForm_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'Code to drag the form
If wHandle = 0 Then Exit Sub
If Button = 1 Then
ReleaseCapture
SendMessage wHandle, &HA1, 2, 0
End If
End Sub
'Private Sub UserForm_Initialize()
' Application.OnTime Now + TimeValue("00:00:05"), "KillForm"
'End Sub
Module 1:
Sub KillForm()
Unload Compass
End Sub
ThisWorkbook code:
Private Sub Workbook_Open()
Compass.Show
End Sub
I do not know how to share this at the KB but would like to share this here.
Form code:
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 Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Const GWL_STYLE As Long = (-16)
Private wHandle As Long
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub Label1_Click()
End Sub
Private Sub UserForm_Initialize()
Application.OnTime Now + TimeValue("00:00:05"), "KillForm"
Dim frm As Long, frmstyle As Long
If Val(Application.Version) >= 9 Then
wHandle = FindWindow("ThunderDFrame", Me.Caption)
Else
wHandle = FindWindow("ThunderXFrame", Me.Caption)
End If
If wHandle = 0 Then Exit Sub
frm = GetWindowLong(wHandle, GWL_STYLE)
frm = frm Or &HC00000
SetWindowLong wHandle, -16, frmstyle
DrawMenuBar wHandle
End Sub
Private Sub UserForm_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'Code to drag the form
If wHandle = 0 Then Exit Sub
If Button = 1 Then
ReleaseCapture
SendMessage wHandle, &HA1, 2, 0
End If
End Sub
'Private Sub UserForm_Initialize()
' Application.OnTime Now + TimeValue("00:00:05"), "KillForm"
'End Sub
Module 1:
Sub KillForm()
Unload Compass
End Sub
ThisWorkbook code:
Private Sub Workbook_Open()
Compass.Show
End Sub