PDA

View Full Version : [SOLVED] Fade a splash screen



Jacko
07-20-2005, 12:33 AM
Hey guys and hello from the first timer ...

I'm looking for a simple, easy for me to understand code to fade out an intro splash screen I'm using in my spreadsheets.

So far I have been directed to a couple of sites (thanks to those people) and picked up the following but way to complicated for me and one of them was very unstable. (made my spreadsheet invisible)

http://www.vbaexpress.com/kb/getarticle.php?kb_id=166

http://www.xcelfiles.com/SplashScrn.html

Can any one help me ...... Thanks

Bob Phillips
07-20-2005, 03:21 AM
Here is a simple example

Killian
07-20-2005, 06:00 AM
Hi Jacko and welcome to VBAX
I've combined a couple of known techniques to make an example (attached - only tested in Excel 2003 so far). IMHO the best solution to your requirement will involve using Windows API functions for the timer and form transparency, so not exactly basic but hardly rocket science either. I've thrown a few comments in but please post back if anything isn't clear.

Code derived from:
Using Windows timers (http://www.cpearson.com/excel/ontime.htm) by Chip Pearson and
Transparent Userform (http://puremis.net/excel/code/040.shtml) at Colo's Excel Junk Room

Bob Phillips
07-20-2005, 06:13 AM
I've combined a couple of known techniques to make an example (attached - only tested in Excel 2003 so far). IMHO the best solution to your requirement will involve using Windows API functions for the timer and form transparency.

Interesting, you interpreted fading literally, I just interpreted it as a splash screen that would time out. :)

Killian
07-20-2005, 07:46 AM
Yeah, I was quite impressed by Colo's transparency sample but I never had the oppotunity to use it for anything... and then I saw the word "fade" ! I'm not a huge fan of code that doesn't actually add functionality but it's a fun script to play with

Jacko
07-20-2005, 03:57 PM
Thanks for your reply ..... really appreciated...

Unfortunately I got the following error message -

Compile error
Syntax error

and the following line highlighted..

TimerID = SetTimer(0&, 0&, TimerSeconds, AddressOf TimerProc)

I'm using XP and MS Office 97, if that may mean anything..

Any clues.....

Jacko
07-20-2005, 04:00 PM
Thanks for the reply - yours is similar to the one I'm currently using. The fade adds a new dimension dont you think...

Jacko
07-20-2005, 04:06 PM
And there's more,

Tried it on MS Office 2003 and it works great can u set it up for 97...

Love your work..

Killian
07-21-2005, 04:25 AM
Glad you like it...
Unfortunately, getting it to work in 97 is going to be a challenge since the AddressOf operator is unsupported.
It's tempting to use Application.OnTime or other easily accessible VBA time related stuff but I'm not sure there's a way of using any of these with fractions of a second (which we need for animating)
I think the best option is write your own equivalent function for AddressOf by using the older VBA Win API functions. This won't run in Office2000+ so if we use the conditional compilation directive we can have one command for 97 and another for 2000+.

So, in your form code:
1. Add the required function declarations


Private Declare Function GetCurrentVbaProject Lib "vba332.dll" _
Alias "EbGetExecutingProj" (hProject As Long) As Long
Private Declare Function GetFuncID Lib "vba332.dll" Alias _
"TipGetFunctionId" (ByVal hProject As Long, ByVal strFunctionName As String, _
ByRef strFunctionId As String) As Long
Private Declare Function GetAddr Lib "vba332.dll" Alias _
"TipGetLpfnOfFunctionId" (ByVal hProject As Long, ByVal strFunctionId As String, _
ByRef lpfn As Long) As Long

2. Add this new function to be used in 97


Private Function AddrOf(strFuncName As String) As Long
' Returns a function pointer of a VBA public function given its name. This function
' gives similar functionality to the VBA6 AddressOf param type.
Dim hProject As Long
Dim lngResult As Long
Dim strID As String
Dim lpfn As Long
Dim strFuncNameUnicode As String
Const NO_ERROR = 0
' The function name must be in Unicode, so convert it.
strFuncNameUnicode = StrConv(strFuncName, vbUnicode)
' Get the current VBA project
Call GetCurrentVbaProject(hProject)
' Make sure we got a project handle
If hProject <> 0 Then
' Get the VBA function ID (whatever that is!)
lngResult = GetFuncID(hProject, strFuncNameUnicode, strID)
' We have to check this because we GPF if we try to get a function pointer
' of a non-existent function.
If lngResult = NO_ERROR Then
' Get the function pointer.
lngResult = GetAddr(hProject, strID, lpfn)
If lngResult = NO_ERROR Then
AddrOf = lpfn
End If
End If
End If
End Function

3. Change the StartTimer routine to conditionally compile the correct statement for the version of VBA being used[VBA]Sub StartTimer()


TimerSeconds = 250 'timer interval (in milliseconds)
#If VBA6 Then 'compiled in only Excel 2000 and the later version
TimerID = SetTimer(0&, 0&, TimerSeconds, AddressOf TimerProc)
#Else 'compiled in Excel 97
TimerID = SetTimer(0&, 0&, TimerSeconds, AddrOf("TimerProc"))
#End If
End Sub

That should do it... it seems to work fine for me but I would recommend some extensive testing (both versions) to be sure you trap any errors - particularly unexpected return values from the API functions since they can be somewhat unpredictable.

Enjoy...

Sir Babydum GBE
07-21-2005, 09:14 AM
Now that's what I call sexy! Nice code Killian, think I'll use it myself!

Jacko
07-21-2005, 11:57 PM
Love your work ..... but way above my head....

Is it possible for you to amend the original code u sent to run under Excel 97...

Many thanks from down under...

Killian
07-22-2005, 02:40 AM
Many thanks from down under...
... happy to help. Now if you could just arrange for Glenn McGrath to retire now he's got his 500 (preferably before play resumes) I'd be grateful : pray2: : pray2: : pray2:

Here's a file with the new code added that works with all Office versions. :)

Bob Phillips
07-22-2005, 02:54 AM
Love your work ..... but way above my head....

Is it possible for you to amend the original code u sent to run under Excel 97...

Many thanks from down under...

johnske
07-22-2005, 04:16 AM
... Now if you could just arrange for Glenn McGrath to retire now he's got his 500 (preferably before play resumes) I'd be grateful : pray2: : pray2: : pray2: ...:rofl: You wish!... :rotlaugh: :devil:

Bob Phillips
07-22-2005, 05:05 AM
:rofl: You wish!... :rotlaugh: :devil:

Don't worry, that natural born Englishman, Kevin Pietersen, and our home grown Geraint Jones will wear him out before the end of the series, and that will retire him :bug: (and, yes I do ...).

Jacko
07-28-2005, 07:20 PM
Thanks for your help...

The fading is working perfectly on all systems inc. 2003, 2000 and 97..

As mentioned - love your work..