Hiding Access/Splash Screens/Timing

D

Dymondjack

Hello again and thanks in advance.

I am trying to get my application to open showing only a splash screen
(frmSplash) with a progress message for what it is doing (ex. "Testing Server
Connections..."). I have put a 1x1 pixel bitmap in the folder (to replace
the default access splash), and set my startup form to frmSplash.

In the code for my startup form, I have two event procedures. The first,
OnOpen, hides the access window (fSetAccessWindow(SW_HIDE, True)). (See code
below for the optional boolean argument) An OnTimer event, which I have set
anywhere from 1000 to 5000 interval, is code to run an AutoExec function
(tests for server connections, set global db info, ect, ect.). This autoexec
function also updates the message on the splash screen, and when done opens
frmMain and closes frmSplash.

When I open the application, I get the custom splash screen, with the access
window behind it. The access window does not hide until after my autoexec
runs though, so I see the window and the splash at the same time. I have
tried running autoexec directly after i = fSetAccessWindow(SW_HIDE), but it
produces the same result (this is how I ended up on the OnTimer procedure).

What I'm looking for at this point is not funcionality but a professional
appearance. If anyone has any ideas on how I can get this access window to
hide itself before my splash closes, it would be greatly appreciated. Here's
my code:

'**** CODE START(frmSplash module)****
Option Compare Database
Option Explicit

Private Sub Form_Open(Cancel As Integer)
Dim x As Long
x = fSetAccessWindow(SW_HIDE, True)
End Sub

Private Sub Form_Timer()
Me.TimerInterval = 0
Dim x As Integer
x = AutoExec
DoCmd.OpenForm "frmMain"
DoCmd.Close acForm, "Splash", acSaveNo
End Sub

'***** AutoExec() in modSyste
'=============================================================================
'==============================================================================
Public Function AutoExec() As Byte
On Error GoTo Error_AutoExec
'=========================
Dim blnServerCon As Boolean
Dim strServerPath As String
'=========================
'Check the server Connection
strServerPath = ELookup("Value", "tblSys", "Variable = 'ServerPath'")
blnServerCon = at_CheckNet%(strServerPath)
If blnServerCon = False Then
MsgBox "A Connection to the required Server has not been established" &
vbCrLf _
& "Please connect to the Server and re-launch the application",
vbOKOnly _
, "No Server Connection"
Application.Quit (acQuitSaveNone)
End If

ClearSystemTables

' Set Form Cooridination globals
pbl_Bln = False
pbl_Dbl = 0
pbl_Lng = 0
pbl_Int = 0
pbl_Byt = 0
pbl_Str = ""

'=========================
Exit_AutoExec:
Exit Function
Error_AutoExec:
pbl_Lng = fSetAccessWindow(SW_SHOWNORMAL)
pbl_Lng = 0
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure " _
& "AutoExec of Module modSystem"
Resume Exit_AutoExec
Resume
End Function

'*****fSetAccessWindow() in modSyste
'==============================================================================
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged
'==============================================================================
Function fSetAccessWindow(nCmdShow As Long, Optional Startup As Boolean)
' Added optional argument Startup for usage with Splash form
' First attempt resulted in Dev's NoActiveForm error
' frmSplash is the only form that uses the optional argument
'Usage Examples
'Maximize window:
' ?fSetAccessWindow(SW_SHOWMAXIMIZED)
'Minimize window:
' ?fSetAccessWindow(SW_SHOWMINIMIZED)
'Hide window:
' ?fSetAccessWindow(SW_HIDE)
'Normal window:
' ?fSetAccessWindow(SW_SHOWNORMAL)
'
If IsMissing(Startup) Then 'Added
Startup = False 'Added
End If 'Added
Dim loX As Long
Dim loForm As Form
On Error Resume Next
Set loForm = Screen.ActiveForm
If (Err <> 0) And (Startup = False) Then 'no Activeform (added And
Startup=F)
If nCmdShow = SW_HIDE Then
MsgBox "Cannot hide Access unless " _
& "a form is on screen"
Else
loX = apiShowWindow(hWndAccessApp, nCmdShow)
Err.Clear
End If
Else
If nCmdShow = SW_SHOWMINIMIZED And loForm.Modal = True Then
MsgBox "Cannot minimize Access with " _
& (loForm.Caption + " ") _
& "form on screen"
ElseIf nCmdShow = SW_HIDE And loForm.PopUp <> True Then
MsgBox "Cannot hide Access with " _
& (loForm.Caption + " ") _
& "form on screen"
Else
loX = apiShowWindow(hWndAccessApp, nCmdShow)
End If
End If
fSetAccessWindow = (loX <> 0)
End Function
 
J

John Spencer

I would try adding DoEvents to your code so that the OS can refresh the
screen

Private Sub Form_Open(Cancel As Integer)
Dim x As Long
x = fSetAccessWindow(SW_HIDE, True)
DoEvents
End Sub

--
John Spencer
Access MVP 2002-2005, 2007
Center for Health Program Development and Management
University of Maryland Baltimore County
..
 
D

Dirk Goldgar

Dymondjack said:
Hello again and thanks in advance.

I am trying to get my application to open showing only a splash screen
(frmSplash) with a progress message for what it is doing (ex. "Testing
Server
Connections..."). I have put a 1x1 pixel bitmap in the folder (to replace
the default access splash), and set my startup form to frmSplash.

In the code for my startup form, I have two event procedures. The first,
OnOpen, hides the access window (fSetAccessWindow(SW_HIDE, True)). (See
code
below for the optional boolean argument) An OnTimer event, which I have
set
anywhere from 1000 to 5000 interval, is code to run an AutoExec function
(tests for server connections, set global db info, ect, ect.). This
autoexec
function also updates the message on the splash screen, and when done
opens
frmMain and closes frmSplash.

When I open the application, I get the custom splash screen, with the
access
window behind it. The access window does not hide until after my autoexec
runs though, so I see the window and the splash at the same time. I have
tried running autoexec directly after i = fSetAccessWindow(SW_HIDE), but
it
produces the same result (this is how I ended up on the OnTimer
procedure).

What I'm looking for at this point is not funcionality but a professional
appearance. If anyone has any ideas on how I can get this access window
to
hide itself before my splash closes, it would be greatly appreciated.
Here's
my code:

'**** CODE START(frmSplash module)****
Option Compare Database
Option Explicit

Private Sub Form_Open(Cancel As Integer)
Dim x As Long
x = fSetAccessWindow(SW_HIDE, True)
End Sub

Private Sub Form_Timer()
Me.TimerInterval = 0
Dim x As Integer
x = AutoExec
DoCmd.OpenForm "frmMain"
DoCmd.Close acForm, "Splash", acSaveNo
End Sub

'***** AutoExec() in modSystem
'==============================================================================
'==============================================================================
Public Function AutoExec() As Byte
On Error GoTo Error_AutoExec
'=========================
Dim blnServerCon As Boolean
Dim strServerPath As String
'=========================
'Check the server Connection
strServerPath = ELookup("Value", "tblSys", "Variable = 'ServerPath'")
blnServerCon = at_CheckNet%(strServerPath)
If blnServerCon = False Then
MsgBox "A Connection to the required Server has not been established" &
vbCrLf _
& "Please connect to the Server and re-launch the application",
vbOKOnly _
, "No Server Connection"
Application.Quit (acQuitSaveNone)
End If

ClearSystemTables

' Set Form Cooridination globals
pbl_Bln = False
pbl_Dbl = 0
pbl_Lng = 0
pbl_Int = 0
pbl_Byt = 0
pbl_Str = ""

'=========================
Exit_AutoExec:
Exit Function
Error_AutoExec:
pbl_Lng = fSetAccessWindow(SW_SHOWNORMAL)
pbl_Lng = 0
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure "
_
& "AutoExec of Module modSystem"
Resume Exit_AutoExec
Resume
End Function

'*****fSetAccessWindow() in modSystem
'==============================================================================
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'==============================================================================
Function fSetAccessWindow(nCmdShow As Long, Optional Startup As Boolean)
' Added optional argument Startup for usage with Splash form
' First attempt resulted in Dev's NoActiveForm error
' frmSplash is the only form that uses the optional argument
'Usage Examples
'Maximize window:
' ?fSetAccessWindow(SW_SHOWMAXIMIZED)
'Minimize window:
' ?fSetAccessWindow(SW_SHOWMINIMIZED)
'Hide window:
' ?fSetAccessWindow(SW_HIDE)
'Normal window:
' ?fSetAccessWindow(SW_SHOWNORMAL)
'
If IsMissing(Startup) Then 'Added
Startup = False 'Added
End If 'Added
Dim loX As Long
Dim loForm As Form
On Error Resume Next
Set loForm = Screen.ActiveForm
If (Err <> 0) And (Startup = False) Then 'no Activeform (added And
Startup=F)
If nCmdShow = SW_HIDE Then
MsgBox "Cannot hide Access unless " _
& "a form is on screen"
Else
loX = apiShowWindow(hWndAccessApp, nCmdShow)
Err.Clear
End If
Else
If nCmdShow = SW_SHOWMINIMIZED And loForm.Modal = True Then
MsgBox "Cannot minimize Access with " _
& (loForm.Caption + " ") _
& "form on screen"
ElseIf nCmdShow = SW_HIDE And loForm.PopUp <> True Then
MsgBox "Cannot hide Access with " _
& (loForm.Caption + " ") _
& "form on screen"
Else
loX = apiShowWindow(hWndAccessApp, nCmdShow)
End If
End If
fSetAccessWindow = (loX <> 0)
End Function


Make sure your splash form is both PopUp and Modal, and then in its Open
event make sure it's visible before trying to hide the Access Window:

Private Sub Form_Open(Cancel As Integer)
Me.Visible = True
DoEvents
fSetAccessWindow SW_HIDE, True
End Sub
 
K

Klatuu

If you want a professional appearance, why not just hide the database window
using the startup options?
You can always turn it back on for yourself.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads


Top